From 720fbf3909fee05eb0ce22c6d323a211c02c6679 Mon Sep 17 00:00:00 2001 From: Steve Youngs Date: Sun, 12 Jun 2016 20:15:49 +1000 Subject: [PATCH] Remove Gnus, making way for new subtree Gnus pkg Signed-off-by: Steve Youngs --- xemacs-packages/gnus/COPYING | 674 - xemacs-packages/gnus/ChangeLog | 743 - xemacs-packages/gnus/ChangeLog.upstream | 675 - xemacs-packages/gnus/Makefile | 58 - xemacs-packages/gnus/README.readmes | 26 - xemacs-packages/gnus/README.xemacs-packaging | 69 - xemacs-packages/gnus/etc/ChangeLog.upstream | 54 - xemacs-packages/gnus/etc/gnus-tut.txt | 319 - xemacs-packages/gnus/etc/gnus/GNUS-README | 101 - xemacs-packages/gnus/etc/gnus/README | 72 - xemacs-packages/gnus/etc/gnus/README2 | 37 - xemacs-packages/gnus/etc/gnus/README3 | 35 - xemacs-packages/gnus/etc/gnus/attach.xpm | 126 - xemacs-packages/gnus/etc/gnus/bar.xbm | 7 - xemacs-packages/gnus/etc/gnus/bar.xpm | 54 - xemacs-packages/gnus/etc/gnus/cancel.xpm | 35 - xemacs-packages/gnus/etc/gnus/catchup.pbm | Bin 81 -> 0 bytes xemacs-packages/gnus/etc/gnus/catchup.xpm | 33 - xemacs-packages/gnus/etc/gnus/close.xpm | 29 - xemacs-packages/gnus/etc/gnus/compose.xpm | 225 - xemacs-packages/gnus/etc/gnus/connect.xpm | 85 - xemacs-packages/gnus/etc/gnus/contact.pbm | Bin 81 -> 0 bytes xemacs-packages/gnus/etc/gnus/contact.xpm | 129 - xemacs-packages/gnus/etc/gnus/copy.xpm | 104 - xemacs-packages/gnus/etc/gnus/cu-exit.pbm | Bin 81 -> 0 bytes xemacs-packages/gnus/etc/gnus/cu-exit.xpm | 31 - xemacs-packages/gnus/etc/gnus/cut.xpm | 67 - xemacs-packages/gnus/etc/gnus/delete.pbm | Bin 81 -> 0 bytes xemacs-packages/gnus/etc/gnus/delete.xpm | 270 - .../gnus/etc/gnus/describe-group.pbm | Bin 81 -> 0 bytes .../gnus/etc/gnus/describe-group.xpm | 32 - xemacs-packages/gnus/etc/gnus/describe.xpm | 95 - xemacs-packages/gnus/etc/gnus/diropen.xpm | 44 - xemacs-packages/gnus/etc/gnus/disconnect.xpm | 69 - xemacs-packages/gnus/etc/gnus/exit-gnus.pbm | Bin 81 -> 0 bytes xemacs-packages/gnus/etc/gnus/exit-gnus.xpm | 33 - xemacs-packages/gnus/etc/gnus/exit-summ.pbm | Bin 81 -> 0 bytes xemacs-packages/gnus/etc/gnus/exit-summ.xpm | 30 - xemacs-packages/gnus/etc/gnus/exit.xpm | 167 - xemacs-packages/gnus/etc/gnus/followup.pbm | Bin 81 -> 0 bytes xemacs-packages/gnus/etc/gnus/followup.xpm | 31 - xemacs-packages/gnus/etc/gnus/forward.xpm | 92 - xemacs-packages/gnus/etc/gnus/fuwo.pbm | Bin 81 -> 0 bytes xemacs-packages/gnus/etc/gnus/fuwo.xpm | 31 - xemacs-packages/gnus/etc/gnus/get-news.pbm | Bin 81 -> 0 bytes xemacs-packages/gnus/etc/gnus/get-news.xpm | 31 - xemacs-packages/gnus/etc/gnus/gnntg.pbm | Bin 81 -> 0 bytes xemacs-packages/gnus/etc/gnus/gnntg.xpm | 31 - .../gnus/gnus-group-catchup-current-up.xbm | 12 - .../gnus/gnus-group-catchup-current-up.xpm | 39 - .../etc/gnus/gnus-group-catchup-current.xbm | 12 - .../etc/gnus/gnus-group-catchup-current.xpm | 39 - .../etc/gnus/gnus-group-describe-group-up.xbm | 12 - .../etc/gnus/gnus-group-describe-group-up.xpm | 39 - .../gnus/etc/gnus/gnus-group-exit-up.xbm | 12 - .../gnus/etc/gnus/gnus-group-exit-up.xpm | 39 - .../gnus-group-get-new-news-this-group-up.xbm | 12 - .../gnus-group-get-new-news-this-group-up.xpm | 39 - .../etc/gnus/gnus-group-get-new-news-up.xbm | 12 - .../etc/gnus/gnus-group-get-new-news-up.xpm | 39 - .../etc/gnus/gnus-group-kill-group-up.xbm | 12 - .../etc/gnus/gnus-group-kill-group-up.xpm | 38 - .../gnus/etc/gnus/gnus-group-subscribe-up.xbm | 12 - .../gnus/etc/gnus/gnus-group-subscribe-up.xpm | 38 - .../etc/gnus/gnus-group-unsubscribe-up.xbm | 12 - .../etc/gnus/gnus-group-unsubscribe-up.xpm | 38 - .../gnus/etc/gnus/gnus-pointer.xbm | 6 - .../gnus/etc/gnus/gnus-pointer.xpm | 22 - .../gnus/gnus-summary-caesar-message-up.xbm | 12 - .../gnus/gnus-summary-caesar-message-up.xpm | 38 - .../gnus/gnus-summary-cancel-article-up.xbm | 12 - .../gnus/gnus-summary-cancel-article-up.xpm | 39 - .../gnus/gnus-summary-catchup-and-exit-up.xbm | 12 - .../gnus/gnus-summary-catchup-and-exit-up.xpm | 39 - .../gnus/etc/gnus/gnus-summary-catchup-up.xbm | 12 - .../gnus/etc/gnus/gnus-summary-catchup-up.xpm | 37 - .../gnus/etc/gnus/gnus-summary-exit-up.xbm | 12 - .../gnus/etc/gnus/gnus-summary-exit-up.xpm | 37 - .../etc/gnus/gnus-summary-followup-up.xbm | 12 - .../etc/gnus/gnus-summary-followup-up.xpm | 38 - ...gnus-summary-followup-with-original-up.xbm | 12 - ...gnus-summary-followup-with-original-up.xpm | 38 - .../etc/gnus/gnus-summary-mail-copy-up.xbm | 12 - .../etc/gnus/gnus-summary-mail-copy-up.xpm | 38 - .../etc/gnus/gnus-summary-mail-delete-up.xbm | 12 - .../etc/gnus/gnus-summary-mail-delete-up.xpm | 39 - .../etc/gnus/gnus-summary-mail-forward-up.xbm | 12 - .../etc/gnus/gnus-summary-mail-forward-up.xpm | 38 - .../etc/gnus/gnus-summary-mail-get-up.xbm | 12 - .../etc/gnus/gnus-summary-mail-get-up.xpm | 38 - .../gnus/gnus-summary-mail-originate-up.xbm | 12 - .../gnus/gnus-summary-mail-originate-up.xpm | 38 - .../etc/gnus/gnus-summary-mail-reply-up.xbm | 12 - .../etc/gnus/gnus-summary-mail-reply-up.xpm | 38 - .../etc/gnus/gnus-summary-mail-save-up.xbm | 12 - .../etc/gnus/gnus-summary-mail-save-up.xpm | 41 - .../etc/gnus/gnus-summary-next-unread-up.xbm | 12 - .../etc/gnus/gnus-summary-next-unread-up.xpm | 39 - .../etc/gnus/gnus-summary-post-news-up.xbm | 12 - .../etc/gnus/gnus-summary-post-news-up.xpm | 38 - .../etc/gnus/gnus-summary-prev-unread-up.xbm | 12 - .../etc/gnus/gnus-summary-prev-unread-up.xpm | 39 - .../gnus/etc/gnus/gnus-summary-reply-up.xbm | 12 - .../gnus/etc/gnus/gnus-summary-reply-up.xpm | 39 - .../gnus-summary-reply-with-original-up.xbm | 12 - .../gnus-summary-reply-with-original-up.xpm | 39 - .../gnus-summary-save-article-file-up.xbm | 12 - .../gnus-summary-save-article-file-up.xpm | 41 - .../etc/gnus/gnus-summary-save-article-up.xbm | 12 - .../etc/gnus/gnus-summary-save-article-up.xpm | 41 - .../gnus/etc/gnus/gnus-uu-decode-uu-up.xbm | 12 - .../gnus/etc/gnus/gnus-uu-decode-uu-up.xpm | 39 - .../gnus/etc/gnus/gnus-uu-post-news-up.xbm | 12 - .../gnus/etc/gnus/gnus-uu-post-news-up.xpm | 39 - xemacs-packages/gnus/etc/gnus/gnus.xbm | 622 - xemacs-packages/gnus/etc/gnus/gnus.xpm | 284 - xemacs-packages/gnus/etc/gnus/help.xpm | 271 - xemacs-packages/gnus/etc/gnus/home.xpm | 128 - xemacs-packages/gnus/etc/gnus/important.xpm | 32 - xemacs-packages/gnus/etc/gnus/inbox.pbm | Bin 81 -> 0 bytes xemacs-packages/gnus/etc/gnus/inbox.xpm | 103 - xemacs-packages/gnus/etc/gnus/index.xpm | 201 - xemacs-packages/gnus/etc/gnus/jump-to.xpm | 171 - xemacs-packages/gnus/etc/gnus/kill-group.pbm | Bin 81 -> 0 bytes xemacs-packages/gnus/etc/gnus/kill-group.xpm | 30 - xemacs-packages/gnus/etc/gnus/left-arrow.xpm | 70 - xemacs-packages/gnus/etc/gnus/lock-broken.xpm | 231 - xemacs-packages/gnus/etc/gnus/lock-ok.xpm | 215 - xemacs-packages/gnus/etc/gnus/lock.xpm | 227 - xemacs-packages/gnus/etc/gnus/mail-reply.pbm | Bin 81 -> 0 bytes xemacs-packages/gnus/etc/gnus/mail-reply.xpm | 32 - xemacs-packages/gnus/etc/gnus/mail-send.xpm | 39 - .../gnus/etc/gnus/message-help-up.xbm | 12 - .../gnus/etc/gnus/message-help-up.xpm | 38 - .../gnus/etc/gnus/message-spell-up.xbm | 12 - .../gnus/etc/gnus/message-spell-up.xpm | 38 - xemacs-packages/gnus/etc/gnus/move.pbm | Bin 81 -> 0 bytes xemacs-packages/gnus/etc/gnus/move.xpm | 103 - xemacs-packages/gnus/etc/gnus/new.xpm | 154 - xemacs-packages/gnus/etc/gnus/next-node.xpm | 45 - xemacs-packages/gnus/etc/gnus/next-page.pbm | Bin 81 -> 0 bytes xemacs-packages/gnus/etc/gnus/next-page.xpm | 119 - xemacs-packages/gnus/etc/gnus/next-ur.pbm | Bin 81 -> 0 bytes xemacs-packages/gnus/etc/gnus/next-ur.xpm | 35 - xemacs-packages/gnus/etc/gnus/not-spam.xpm | 149 - xemacs-packages/gnus/etc/gnus/oort.xface | 3 - xemacs-packages/gnus/etc/gnus/open.xpm | 200 - xemacs-packages/gnus/etc/gnus/outbox.xpm | 96 - xemacs-packages/gnus/etc/gnus/paste.xpm | 116 - xemacs-packages/gnus/etc/gnus/post.pbm | Bin 81 -> 0 bytes xemacs-packages/gnus/etc/gnus/post.xpm | 35 - xemacs-packages/gnus/etc/gnus/preferences.xpm | 114 - xemacs-packages/gnus/etc/gnus/prev-node.xpm | 44 - xemacs-packages/gnus/etc/gnus/prev-ur.pbm | Bin 81 -> 0 bytes xemacs-packages/gnus/etc/gnus/prev-ur.xpm | 35 - xemacs-packages/gnus/etc/gnus/preview.xbm | 10 - xemacs-packages/gnus/etc/gnus/preview.xpm | 178 - xemacs-packages/gnus/etc/gnus/print.xpm | 202 - xemacs-packages/gnus/etc/gnus/receipt.xpm | 32 - xemacs-packages/gnus/etc/gnus/redo.xpm | 69 - xemacs-packages/gnus/etc/gnus/refresh.xpm | 153 - xemacs-packages/gnus/etc/gnus/reply-all.xpm | 176 - xemacs-packages/gnus/etc/gnus/reply-wo.pbm | Bin 81 -> 0 bytes xemacs-packages/gnus/etc/gnus/reply-wo.xpm | 31 - xemacs-packages/gnus/etc/gnus/reply.pbm | Bin 81 -> 0 bytes xemacs-packages/gnus/etc/gnus/reply.xpm | 94 - .../gnus/etc/gnus/reverse-smile.xpm | 20 - xemacs-packages/gnus/etc/gnus/right-arrow.xpm | 68 - xemacs-packages/gnus/etc/gnus/rot13.pbm | Bin 81 -> 0 bytes xemacs-packages/gnus/etc/gnus/rot13.xpm | 128 - xemacs-packages/gnus/etc/gnus/save-aif.pbm | Bin 81 -> 0 bytes xemacs-packages/gnus/etc/gnus/save-aif.xpm | 33 - xemacs-packages/gnus/etc/gnus/save-art.pbm | Bin 81 -> 0 bytes xemacs-packages/gnus/etc/gnus/save-art.xpm | 32 - xemacs-packages/gnus/etc/gnus/save-draft.xpm | 99 - xemacs-packages/gnus/etc/gnus/save.xpm | 291 - xemacs-packages/gnus/etc/gnus/saveas.xpm | 289 - xemacs-packages/gnus/etc/gnus/search.xpm | 234 - xemacs-packages/gnus/etc/gnus/send.xpm | 85 - xemacs-packages/gnus/etc/gnus/separator.xpm | 30 - .../gnus/etc/gnus/sort-ascending.xpm | 61 - .../gnus/etc/gnus/sort-column-ascending.xpm | 29 - .../gnus/etc/gnus/sort-criteria.xpm | 55 - .../gnus/etc/gnus/sort-descending.xpm | 62 - .../gnus/etc/gnus/sort-row-ascending.xpm | 22 - xemacs-packages/gnus/etc/gnus/spam.xpm | 217 - xemacs-packages/gnus/etc/gnus/spell.xpm | 64 - xemacs-packages/gnus/etc/gnus/subscribe.pbm | Bin 81 -> 0 bytes xemacs-packages/gnus/etc/gnus/subscribe.xpm | 32 - .../gnus/etc/gnus/toggle-subscription.xpm | 58 - xemacs-packages/gnus/etc/gnus/unimportant.xpm | 32 - xemacs-packages/gnus/etc/gnus/unsubscribe.pbm | Bin 81 -> 0 bytes xemacs-packages/gnus/etc/gnus/unsubscribe.xpm | 32 - xemacs-packages/gnus/etc/gnus/uu-decode.pbm | Bin 81 -> 0 bytes xemacs-packages/gnus/etc/gnus/uu-decode.xpm | 36 - xemacs-packages/gnus/etc/gnus/uu-post.pbm | Bin 81 -> 0 bytes xemacs-packages/gnus/etc/gnus/uu-post.xpm | 35 - xemacs-packages/gnus/etc/gnus/x-splash | Bin 4621 -> 0 bytes .../gnus/etc/smilies/FaceAngry.xpm | 20 - .../gnus/etc/smilies/FaceDevilish.xpm | 20 - .../gnus/etc/smilies/FaceGoofy.xpm | 20 - .../gnus/etc/smilies/FaceGrinning.xpm | 20 - .../gnus/etc/smilies/FaceHappy.xpm | 20 - .../gnus/etc/smilies/FaceIronic.xpm | 20 - xemacs-packages/gnus/etc/smilies/FaceKOed.xpm | 20 - xemacs-packages/gnus/etc/smilies/FaceNyah.xpm | 20 - xemacs-packages/gnus/etc/smilies/FaceSad.xpm | 20 - .../gnus/etc/smilies/FaceStartled.xpm | 20 - .../gnus/etc/smilies/FaceStraight.xpm | 20 - .../gnus/etc/smilies/FaceTalking.xpm | 20 - .../gnus/etc/smilies/FaceTasty.xpm | 20 - .../gnus/etc/smilies/FaceWinking.xpm | 20 - xemacs-packages/gnus/etc/smilies/FaceWry.xpm | 20 - .../gnus/etc/smilies/FaceYukky.xpm | 20 - xemacs-packages/gnus/etc/smilies/README | 8 - .../gnus/etc/smilies/WideFaceAse1.xbm | 19 - .../gnus/etc/smilies/WideFaceAse2.xbm | 19 - .../gnus/etc/smilies/WideFaceAse3.xbm | 20 - .../gnus/etc/smilies/WideFaceSmile.xbm | 19 - .../gnus/etc/smilies/WideFaceWeep.xbm | 20 - xemacs-packages/gnus/etc/smilies/blink.pbm | Bin 37 -> 0 bytes xemacs-packages/gnus/etc/smilies/blink.xpm | 20 - .../gnus/etc/smilies/braindamaged.xpm | 20 - xemacs-packages/gnus/etc/smilies/cry.xpm | 20 - xemacs-packages/gnus/etc/smilies/dead.xpm | 20 - xemacs-packages/gnus/etc/smilies/evil.xpm | 20 - xemacs-packages/gnus/etc/smilies/forced.xpm | 20 - xemacs-packages/gnus/etc/smilies/frown.pbm | Bin 37 -> 0 bytes xemacs-packages/gnus/etc/smilies/frown.xpm | 20 - xemacs-packages/gnus/etc/smilies/grin.xpm | 21 - .../gnus/etc/smilies/indifferent.xpm | 20 - .../gnus/etc/smilies/reverse-smile.xpm | 20 - xemacs-packages/gnus/etc/smilies/sad.pbm | Bin 37 -> 0 bytes xemacs-packages/gnus/etc/smilies/sad.xpm | 20 - xemacs-packages/gnus/etc/smilies/smile.pbm | Bin 37 -> 0 bytes xemacs-packages/gnus/etc/smilies/smile.xpm | 20 - xemacs-packages/gnus/etc/smilies/wry.pbm | Bin 37 -> 0 bytes xemacs-packages/gnus/etc/smilies/wry.xpm | 20 - xemacs-packages/gnus/etc/sounds/Boring.au | Bin 7494 -> 0 bytes xemacs-packages/gnus/etc/sounds/Evil_Laugh.au | Bin 20235 -> 0 bytes xemacs-packages/gnus/etc/sounds/Puke.au | Bin 11973 -> 0 bytes xemacs-packages/gnus/etc/sounds/Snicker.au | Bin 7349 -> 0 bytes .../gnus/etc/sounds/Tuxedomoon.Jingle4.au | Bin 84777 -> 0 bytes xemacs-packages/gnus/etc/sounds/catmeow.wav | Bin 41468 -> 0 bytes xemacs-packages/gnus/etc/sounds/cry.wav | Bin 96194 -> 0 bytes xemacs-packages/gnus/etc/sounds/drumroll.au | Bin 6074 -> 0 bytes xemacs-packages/gnus/etc/sounds/explosion.au | Bin 22400 -> 0 bytes xemacs-packages/gnus/etc/sounds/flush.au | Bin 44182 -> 0 bytes xemacs-packages/gnus/etc/sounds/kiss.wav | Bin 18934 -> 0 bytes xemacs-packages/gnus/etc/sounds/laugh.au | Bin 10827 -> 0 bytes xemacs-packages/gnus/etc/sounds/shotgun.wav | Bin 13996 -> 0 bytes xemacs-packages/gnus/etc/sounds/snore.wav | Bin 51326 -> 0 bytes xemacs-packages/gnus/etc/sounds/whistle.au | Bin 12622 -> 0 bytes xemacs-packages/gnus/etc/sounds/witch.au | Bin 30107 -> 0 bytes xemacs-packages/gnus/etc/sounds/yell2.au | Bin 20792 -> 0 bytes xemacs-packages/gnus/etc/todo.upstream | 1523 - .../gnus/lisp/ChangeLog.1.upstream | 10108 ------ .../gnus/lisp/ChangeLog.2.upstream | 18884 ---------- .../gnus/lisp/ChangeLog.contrib.upstream | 338 - xemacs-packages/gnus/lisp/ChangeLog.upstream | 5617 --- xemacs-packages/gnus/lisp/GNUS-NEWS | 549 - xemacs-packages/gnus/lisp/binhex.el | 331 - xemacs-packages/gnus/lisp/canlock.el | 251 - xemacs-packages/gnus/lisp/compface.el | 63 - xemacs-packages/gnus/lisp/deuglify.el | 480 - xemacs-packages/gnus/lisp/dgnushack-xemacs.el | 68 - xemacs-packages/gnus/lisp/dgnushack.el | 515 - xemacs-packages/gnus/lisp/earcon.el | 235 - xemacs-packages/gnus/lisp/flow-fill.el | 237 - xemacs-packages/gnus/lisp/format-spec.el | 82 - xemacs-packages/gnus/lisp/gmm-utils.el | 422 - xemacs-packages/gnus/lisp/gnus-agent.el | 4002 --- xemacs-packages/gnus/lisp/gnus-art.el | 7659 ---- xemacs-packages/gnus/lisp/gnus-async.el | 383 - xemacs-packages/gnus/lisp/gnus-audio.el | 152 - xemacs-packages/gnus/lisp/gnus-bcklg.el | 165 - xemacs-packages/gnus/lisp/gnus-cache.el | 781 - xemacs-packages/gnus/lisp/gnus-cite.el | 1113 - xemacs-packages/gnus/lisp/gnus-cus.el | 1126 - xemacs-packages/gnus/lisp/gnus-delay.el | 198 - xemacs-packages/gnus/lisp/gnus-demon.el | 329 - xemacs-packages/gnus/lisp/gnus-diary.el | 411 - xemacs-packages/gnus/lisp/gnus-dired.el | 207 - xemacs-packages/gnus/lisp/gnus-draft.el | 324 - xemacs-packages/gnus/lisp/gnus-dup.el | 167 - xemacs-packages/gnus/lisp/gnus-eform.el | 135 - xemacs-packages/gnus/lisp/gnus-ems.el | 305 - xemacs-packages/gnus/lisp/gnus-fun.el | 262 - xemacs-packages/gnus/lisp/gnus-gl.el | 860 - xemacs-packages/gnus/lisp/gnus-group.el | 4472 --- xemacs-packages/gnus/lisp/gnus-int.el | 698 - xemacs-packages/gnus/lisp/gnus-kill.el | 722 - xemacs-packages/gnus/lisp/gnus-load.el | 9 - xemacs-packages/gnus/lisp/gnus-logic.el | 232 - xemacs-packages/gnus/lisp/gnus-mh.el | 116 - xemacs-packages/gnus/lisp/gnus-ml.el | 184 - xemacs-packages/gnus/lisp/gnus-mlspl.el | 233 - xemacs-packages/gnus/lisp/gnus-move.el | 187 - xemacs-packages/gnus/lisp/gnus-msg.el | 1971 - xemacs-packages/gnus/lisp/gnus-nocem.el | 405 - xemacs-packages/gnus/lisp/gnus-picon.el | 288 - xemacs-packages/gnus/lisp/gnus-range.el | 660 - xemacs-packages/gnus/lisp/gnus-registry.el | 695 - xemacs-packages/gnus/lisp/gnus-salt.el | 1055 - xemacs-packages/gnus/lisp/gnus-score.el | 3074 -- xemacs-packages/gnus/lisp/gnus-setup.el | 196 - xemacs-packages/gnus/lisp/gnus-sieve.el | 241 - xemacs-packages/gnus/lisp/gnus-soup.el | 614 - xemacs-packages/gnus/lisp/gnus-spec.el | 765 - xemacs-packages/gnus/lisp/gnus-srvr.el | 980 - xemacs-packages/gnus/lisp/gnus-start.el | 3126 -- xemacs-packages/gnus/lisp/gnus-sum.el | 12032 ------- xemacs-packages/gnus/lisp/gnus-topic.el | 1776 - xemacs-packages/gnus/lisp/gnus-undo.el | 196 - xemacs-packages/gnus/lisp/gnus-util.el | 1677 - xemacs-packages/gnus/lisp/gnus-uu.el | 2120 -- xemacs-packages/gnus/lisp/gnus-vm.el | 109 - xemacs-packages/gnus/lisp/gnus-win.el | 587 - xemacs-packages/gnus/lisp/gnus-xmas.el | 982 - xemacs-packages/gnus/lisp/gnus.el | 4306 --- xemacs-packages/gnus/lisp/gpg-ring.el | 482 - xemacs-packages/gnus/lisp/gpg.el | 1340 - xemacs-packages/gnus/lisp/hashcash.el | 220 - xemacs-packages/gnus/lisp/html2text.el | 481 - xemacs-packages/gnus/lisp/ietf-drums.el | 280 - xemacs-packages/gnus/lisp/imap.el | 2840 -- .../gnus/lisp/legacy-gnus-agent.el | 259 - xemacs-packages/gnus/lisp/lpath.el | 92 - xemacs-packages/gnus/lisp/mail-parse.el | 79 - xemacs-packages/gnus/lisp/mail-prsvr.el | 47 - xemacs-packages/gnus/lisp/mail-source.el | 1082 - xemacs-packages/gnus/lisp/mailcap.el | 995 - xemacs-packages/gnus/lisp/message.el | 7258 ---- xemacs-packages/gnus/lisp/messagexmas.el | 183 - xemacs-packages/gnus/lisp/messcompat.el | 95 - xemacs-packages/gnus/lisp/mm-bodies.el | 310 - xemacs-packages/gnus/lisp/mm-decode.el | 1590 - xemacs-packages/gnus/lisp/mm-encode.el | 210 - xemacs-packages/gnus/lisp/mm-extern.el | 169 - xemacs-packages/gnus/lisp/mm-partial.el | 157 - xemacs-packages/gnus/lisp/mm-url.el | 469 - xemacs-packages/gnus/lisp/mm-util.el | 1330 - xemacs-packages/gnus/lisp/mm-uu.el | 627 - xemacs-packages/gnus/lisp/mm-view.el | 658 - xemacs-packages/gnus/lisp/mml-sec.el | 350 - xemacs-packages/gnus/lisp/mml-smime.el | 212 - xemacs-packages/gnus/lisp/mml.el | 1343 - xemacs-packages/gnus/lisp/mml1991.el | 314 - xemacs-packages/gnus/lisp/mml2015.el | 938 - xemacs-packages/gnus/lisp/nnagent.el | 256 - xemacs-packages/gnus/lisp/nnbabyl.el | 672 - xemacs-packages/gnus/lisp/nndb.el | 320 - xemacs-packages/gnus/lisp/nndiary.el | 1595 - xemacs-packages/gnus/lisp/nndir.el | 102 - xemacs-packages/gnus/lisp/nndoc.el | 1028 - xemacs-packages/gnus/lisp/nndraft.el | 314 - xemacs-packages/gnus/lisp/nneething.el | 432 - xemacs-packages/gnus/lisp/nnfolder.el | 1278 - xemacs-packages/gnus/lisp/nngateway.el | 95 - xemacs-packages/gnus/lisp/nnheader.el | 1057 - xemacs-packages/gnus/lisp/nnheaderxm.el | 100 - xemacs-packages/gnus/lisp/nnimap.el | 1716 - xemacs-packages/gnus/lisp/nnir.el | 1559 - xemacs-packages/gnus/lisp/nnkiboze.el | 397 - xemacs-packages/gnus/lisp/nnlistserv.el | 154 - xemacs-packages/gnus/lisp/nnmail.el | 2040 -- xemacs-packages/gnus/lisp/nnmaildir.el | 1628 - xemacs-packages/gnus/lisp/nnmbox.el | 719 - xemacs-packages/gnus/lisp/nnmh.el | 590 - xemacs-packages/gnus/lisp/nnml.el | 1023 - xemacs-packages/gnus/lisp/nnnil.el | 83 - xemacs-packages/gnus/lisp/nnoo.el | 328 - xemacs-packages/gnus/lisp/nnrss.el | 1104 - xemacs-packages/gnus/lisp/nnslashdot.el | 509 - xemacs-packages/gnus/lisp/nnsoup.el | 820 - xemacs-packages/gnus/lisp/nnspool.el | 471 - xemacs-packages/gnus/lisp/nntp.el | 1936 - xemacs-packages/gnus/lisp/nnultimate.el | 482 - xemacs-packages/gnus/lisp/nnvirtual.el | 823 - xemacs-packages/gnus/lisp/nnwarchive.el | 729 - xemacs-packages/gnus/lisp/nnweb.el | 612 - xemacs-packages/gnus/lisp/nnwfm.el | 434 - xemacs-packages/gnus/lisp/parse-time.el | 224 - xemacs-packages/gnus/lisp/qp.el | 168 - xemacs-packages/gnus/lisp/rfc1843.el | 190 - xemacs-packages/gnus/lisp/rfc2045.el | 45 - xemacs-packages/gnus/lisp/rfc2047.el | 1139 - xemacs-packages/gnus/lisp/rfc2231.el | 316 - xemacs-packages/gnus/lisp/score-mode.el | 119 - xemacs-packages/gnus/lisp/smiley.el | 443 - xemacs-packages/gnus/lisp/smiley.el.upstream | 191 - xemacs-packages/gnus/lisp/smime.el | 654 - xemacs-packages/gnus/lisp/spam-report.el | 269 - xemacs-packages/gnus/lisp/spam-stat.el | 605 - xemacs-packages/gnus/lisp/spam.el | 1858 - xemacs-packages/gnus/lisp/time-date.el | 260 - xemacs-packages/gnus/lisp/utf7.el | 230 - xemacs-packages/gnus/lisp/uudecode.el | 239 - xemacs-packages/gnus/lisp/vcard.el | 309 - xemacs-packages/gnus/lisp/webmail.el | 1155 - xemacs-packages/gnus/lisp/yenc.el | 122 - xemacs-packages/gnus/package-info.in | 19 - xemacs-packages/gnus/texi/ChangeLog.upstream | 5105 --- xemacs-packages/gnus/texi/doclicense.texi | 416 - xemacs-packages/gnus/texi/emacs-mime.texi | 1832 - xemacs-packages/gnus/texi/etc/bar.xpm | 54 - .../etc/gnus-group-catchup-current-up.xpm | 39 - .../texi/etc/gnus-group-catchup-current.xpm | 39 - .../texi/etc/gnus-group-describe-group-up.xpm | 39 - .../gnus/texi/etc/gnus-group-exit-up.xpm | 39 - .../gnus-group-get-new-news-this-group-up.xpm | 39 - .../texi/etc/gnus-group-get-new-news-up.xpm | 39 - .../texi/etc/gnus-group-kill-group-up.xpm | 38 - .../gnus/texi/etc/gnus-group-subscribe-up.xpm | 38 - .../texi/etc/gnus-group-unsubscribe-up.xpm | 38 - .../etc/gnus-summary-caesar-message-up.xpm | 38 - .../etc/gnus-summary-cancel-article-up.xpm | 39 - .../etc/gnus-summary-catchup-and-exit-up.xpm | 39 - .../gnus/texi/etc/gnus-summary-catchup-up.xpm | 37 - .../gnus/texi/etc/gnus-summary-exit-up.xpm | 37 - .../texi/etc/gnus-summary-followup-up.xpm | 38 - ...gnus-summary-followup-with-original-up.xpm | 38 - .../texi/etc/gnus-summary-mail-copy-up.xpm | 38 - .../texi/etc/gnus-summary-mail-delete-up.xpm | 39 - .../texi/etc/gnus-summary-mail-forward-up.xpm | 38 - .../texi/etc/gnus-summary-mail-get-up.xpm | 38 - .../etc/gnus-summary-mail-originate-up.xpm | 38 - .../texi/etc/gnus-summary-mail-reply-up.xpm | 38 - .../texi/etc/gnus-summary-mail-save-up.xpm | 41 - .../texi/etc/gnus-summary-next-unread-up.xpm | 39 - .../texi/etc/gnus-summary-post-news-up.xpm | 38 - .../texi/etc/gnus-summary-prev-unread-up.xpm | 39 - .../gnus/texi/etc/gnus-summary-reply-up.xpm | 39 - .../gnus-summary-reply-with-original-up.xpm | 39 - .../etc/gnus-summary-save-article-file-up.xpm | 41 - .../texi/etc/gnus-summary-save-article-up.xpm | 41 - .../gnus/texi/etc/gnus-uu-decode-uu-up.xpm | 39 - .../gnus/texi/etc/gnus-uu-post-news-up.xpm | 39 - xemacs-packages/gnus/texi/etc/gnus.xpm | 283 - xemacs-packages/gnus/texi/gnus-faq.texi | 2306 -- xemacs-packages/gnus/texi/gnus-logo.eps | 1077 - xemacs-packages/gnus/texi/gnus-refcard.tex | 1424 - xemacs-packages/gnus/texi/gnus.texi | 29581 ---------------- xemacs-packages/gnus/texi/gnusconfig.tex.in | 11 - xemacs-packages/gnus/texi/herds/convol11.pnm | 14 - xemacs-packages/gnus/texi/herds/convol5.pnm | 8 - .../gnus/texi/herds/gnus-herd-bw.png | Bin 3672 -> 0 bytes .../gnus/texi/herds/gnus-herd-new.png | Bin 9036 -> 0 bytes .../gnus/texi/herds/new-herd-1.png | Bin 249 -> 0 bytes .../gnus/texi/herds/new-herd-2.png | Bin 420 -> 0 bytes .../gnus/texi/herds/new-herd-3.png | Bin 631 -> 0 bytes .../gnus/texi/herds/new-herd-4.png | Bin 893 -> 0 bytes .../gnus/texi/herds/new-herd-5.png | Bin 1245 -> 0 bytes .../gnus/texi/herds/new-herd-6.png | Bin 2067 -> 0 bytes .../gnus/texi/herds/new-herd-7.png | Bin 2622 -> 0 bytes .../gnus/texi/herds/new-herd-8.png | Bin 3244 -> 0 bytes .../gnus/texi/herds/new-herd-9.png | Bin 3391 -> 0 bytes .../gnus/texi/herds/new-herd-section.png | Bin 3204 -> 0 bytes xemacs-packages/gnus/texi/herds/new-herd.png | Bin 8199 -> 0 bytes xemacs-packages/gnus/texi/herds/new-herd2.png | Bin 3430 -> 0 bytes xemacs-packages/gnus/texi/infohack.el | 122 - xemacs-packages/gnus/texi/message.texi | 2362 -- xemacs-packages/gnus/texi/misc/ered.tif | Bin 27984 -> 0 bytes xemacs-packages/gnus/texi/misc/eseptember.tif | Bin 3822 -> 0 bytes xemacs-packages/gnus/texi/misc/fred.tif | Bin 10770 -> 0 bytes xemacs-packages/gnus/texi/misc/fseptember.tif | Bin 24798 -> 0 bytes xemacs-packages/gnus/texi/misc/larsi.png | Bin 10768 -> 0 bytes xemacs-packages/gnus/texi/misc/red.png | Bin 3678 -> 0 bytes xemacs-packages/gnus/texi/misc/september.png | Bin 2650 -> 0 bytes xemacs-packages/gnus/texi/pagestyle.sty | 84 - xemacs-packages/gnus/texi/picons/att.png | Bin 267 -> 0 bytes xemacs-packages/gnus/texi/picons/berkeley.png | Bin 487 -> 0 bytes xemacs-packages/gnus/texi/picons/caltech.png | Bin 812 -> 0 bytes xemacs-packages/gnus/texi/picons/canada.png | Bin 280 -> 0 bytes xemacs-packages/gnus/texi/picons/cr.png | Bin 287 -> 0 bytes xemacs-packages/gnus/texi/picons/cygnus.xbm | 27 - xemacs-packages/gnus/texi/picons/gnu.xbm | 27 - xemacs-packages/gnus/texi/picons/gov.xbm | 27 - xemacs-packages/gnus/texi/picons/laurie.png | Bin 1002 -> 0 bytes xemacs-packages/gnus/texi/picons/mit.png | Bin 388 -> 0 bytes xemacs-packages/gnus/texi/picons/nasa.png | Bin 512 -> 0 bytes xemacs-packages/gnus/texi/picons/qmw.xbm | 27 - xemacs-packages/gnus/texi/picons/rms.png | Bin 834 -> 0 bytes xemacs-packages/gnus/texi/picons/ruu.xbm | 27 - xemacs-packages/gnus/texi/picons/seuu.xbm | 27 - xemacs-packages/gnus/texi/picons/stanford.png | Bin 422 -> 0 bytes xemacs-packages/gnus/texi/picons/sun.png | Bin 334 -> 0 bytes xemacs-packages/gnus/texi/picons/ubc.xbm | 27 - xemacs-packages/gnus/texi/picons/ufl.png | Bin 1016 -> 0 bytes xemacs-packages/gnus/texi/picons/uio.png | Bin 759 -> 0 bytes xemacs-packages/gnus/texi/picons/unit.png | Bin 488 -> 0 bytes xemacs-packages/gnus/texi/picons/upenn.xbm | 27 - xemacs-packages/gnus/texi/picons/wesleyan.xbm | 27 - xemacs-packages/gnus/texi/picons/yale.xbm | 27 - xemacs-packages/gnus/texi/pixidx.sty | 231 - xemacs-packages/gnus/texi/postamble.tex | 52 - .../gnus/texi/ps/gnus-big-logo.eps | 212 - xemacs-packages/gnus/texi/ps/gnus-head.eps | 149 - .../gnus/texi/screen/group-topic.png | Bin 7356 -> 0 bytes xemacs-packages/gnus/texi/screen/group.png | Bin 5986 -> 0 bytes xemacs-packages/gnus/texi/screen/server.png | Bin 6084 -> 0 bytes .../gnus/texi/screen/summary-adopt.png | Bin 9275 -> 0 bytes .../gnus/texi/screen/summary-article-c-ug.png | Bin 13045 -> 0 bytes .../gnus/texi/screen/summary-article.png | Bin 12148 -> 0 bytes .../gnus/texi/screen/summary-dummy.png | Bin 9036 -> 0 bytes .../gnus/texi/screen/summary-empty.png | Bin 9126 -> 0 bytes .../gnus/texi/screen/summary-none.png | Bin 9668 -> 0 bytes .../gnus/texi/screen/summary-unthreaded.png | Bin 15380 -> 0 bytes xemacs-packages/gnus/texi/screen/summary.png | Bin 9803 -> 0 bytes xemacs-packages/gnus/texi/smilies/BigFace.tif | Bin 130064 -> 0 bytes .../gnus/texi/smilies/FaceAngry.xpm | 20 - .../gnus/texi/smilies/FaceDevilish.xpm | 20 - .../gnus/texi/smilies/FaceGoofy.xpm | 20 - .../gnus/texi/smilies/FaceGrinning.xpm | 20 - .../gnus/texi/smilies/FaceHappy.xpm | 20 - .../gnus/texi/smilies/FaceIronic.xpm | 20 - .../gnus/texi/smilies/FaceKOed.xpm | 20 - .../gnus/texi/smilies/FaceNyah.xpm | 20 - xemacs-packages/gnus/texi/smilies/FaceSad.xpm | 20 - .../gnus/texi/smilies/FaceStartled.xpm | 20 - .../gnus/texi/smilies/FaceStraight.xpm | 20 - .../gnus/texi/smilies/FaceTalking.xpm | 20 - .../gnus/texi/smilies/FaceTasty.xpm | 20 - .../gnus/texi/smilies/FaceWinking.xpm | 20 - xemacs-packages/gnus/texi/smilies/FaceWry.xpm | 20 - .../gnus/texi/smilies/FaceYukky.xpm | 20 - .../gnus/texi/smilies/WideFaceAse1.xbm | 19 - .../gnus/texi/smilies/WideFaceAse2.xbm | 19 - .../gnus/texi/smilies/WideFaceAse3.xbm | 20 - .../gnus/texi/smilies/WideFaceSmile.xbm | 19 - .../gnus/texi/smilies/WideFaceWeep.xbm | 20 - xemacs-packages/gnus/texi/splitindex | 8 - xemacs-packages/gnus/texi/texi2latex.el | 420 - .../gnus/texi/xface/abrahamsen.png | Bin 341 -> 0 bytes xemacs-packages/gnus/texi/xface/aichner.png | Bin 333 -> 0 bytes xemacs-packages/gnus/texi/xface/blanks.png | Bin 408 -> 0 bytes xemacs-packages/gnus/texi/xface/cosgriff.png | Bin 311 -> 0 bytes xemacs-packages/gnus/texi/xface/drazen.png | Bin 366 -> 0 bytes .../gnus/texi/xface/gertzfield.png | Bin 374 -> 0 bytes xemacs-packages/gnus/texi/xface/goldberg.png | Bin 364 -> 0 bytes xemacs-packages/gnus/texi/xface/graf.png | Bin 387 -> 0 bytes xemacs-packages/gnus/texi/xface/hardaker.png | Bin 336 -> 0 bytes xemacs-packages/gnus/texi/xface/hedbor.png | Bin 419 -> 0 bytes xemacs-packages/gnus/texi/xface/ingrand.png | Bin 425 -> 0 bytes xemacs-packages/gnus/texi/xface/kaplan.png | Bin 348 -> 0 bytes xemacs-packages/gnus/texi/xface/karlheg.png | Bin 326 -> 0 bytes .../gnus/texi/xface/kleinpaste.png | Bin 286 -> 0 bytes xemacs-packages/gnus/texi/xface/kyle.png | Bin 259 -> 0 bytes xemacs-packages/gnus/texi/xface/love.png | Bin 351 -> 0 bytes xemacs-packages/gnus/texi/xface/moll.png | Bin 244 -> 0 bytes xemacs-packages/gnus/texi/xface/niksic.png | Bin 349 -> 0 bytes xemacs-packages/gnus/texi/xface/olsen.png | Bin 316 -> 0 bytes xemacs-packages/gnus/texi/xface/patch.png | Bin 378 -> 0 bytes xemacs-packages/gnus/texi/xface/petersen.png | Bin 400 -> 0 bytes xemacs-packages/gnus/texi/xface/pjf.png | Bin 253 -> 0 bytes xemacs-packages/gnus/texi/xface/riocreux.png | Bin 419 -> 0 bytes xemacs-packages/gnus/texi/xface/schauer.png | Bin 322 -> 0 bytes xemacs-packages/gnus/texi/xface/simmonmt.png | Bin 285 -> 0 bytes xemacs-packages/gnus/texi/xface/simmons.png | Bin 254 -> 0 bytes xemacs-packages/gnus/texi/xface/siu.png | Bin 378 -> 0 bytes xemacs-packages/gnus/texi/xface/smb.png | Bin 278 -> 0 bytes xemacs-packages/gnus/texi/xface/sobek.png | Bin 358 -> 0 bytes xemacs-packages/gnus/texi/xface/thomas.png | Bin 312 -> 0 bytes xemacs-packages/gnus/texi/xface/valdis.png | Bin 336 -> 0 bytes xemacs-packages/gnus/texi/xface/verna1.png | Bin 310 -> 0 bytes xemacs-packages/gnus/texi/xface/verna2.png | Bin 328 -> 0 bytes xemacs-packages/gnus/texi/xface/yamaoka.png | Bin 320 -> 0 bytes xemacs-packages/gnus/texi/xml2texi.scm | 437 - xemacs-packages/gnus/texi/xml2texi.sh | 78 - 569 files changed, 223625 deletions(-) delete mode 100644 xemacs-packages/gnus/COPYING delete mode 100644 xemacs-packages/gnus/ChangeLog delete mode 100644 xemacs-packages/gnus/ChangeLog.upstream delete mode 100644 xemacs-packages/gnus/Makefile delete mode 100644 xemacs-packages/gnus/README.readmes delete mode 100644 xemacs-packages/gnus/README.xemacs-packaging delete mode 100644 xemacs-packages/gnus/etc/ChangeLog.upstream delete mode 100644 xemacs-packages/gnus/etc/gnus-tut.txt delete mode 100644 xemacs-packages/gnus/etc/gnus/GNUS-README delete mode 100644 xemacs-packages/gnus/etc/gnus/README delete mode 100644 xemacs-packages/gnus/etc/gnus/README2 delete mode 100644 xemacs-packages/gnus/etc/gnus/README3 delete mode 100644 xemacs-packages/gnus/etc/gnus/attach.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/bar.xbm delete mode 100644 xemacs-packages/gnus/etc/gnus/bar.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/cancel.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/catchup.pbm delete mode 100644 xemacs-packages/gnus/etc/gnus/catchup.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/close.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/compose.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/connect.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/contact.pbm delete mode 100644 xemacs-packages/gnus/etc/gnus/contact.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/copy.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/cu-exit.pbm delete mode 100644 xemacs-packages/gnus/etc/gnus/cu-exit.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/cut.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/delete.pbm delete mode 100644 xemacs-packages/gnus/etc/gnus/delete.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/describe-group.pbm delete mode 100644 xemacs-packages/gnus/etc/gnus/describe-group.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/describe.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/diropen.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/disconnect.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/exit-gnus.pbm delete mode 100644 xemacs-packages/gnus/etc/gnus/exit-gnus.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/exit-summ.pbm delete mode 100644 xemacs-packages/gnus/etc/gnus/exit-summ.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/exit.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/followup.pbm delete mode 100644 xemacs-packages/gnus/etc/gnus/followup.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/forward.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/fuwo.pbm delete mode 100644 xemacs-packages/gnus/etc/gnus/fuwo.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/get-news.pbm delete mode 100644 xemacs-packages/gnus/etc/gnus/get-news.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnntg.pbm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnntg.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-group-catchup-current-up.xbm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-group-catchup-current-up.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-group-catchup-current.xbm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-group-catchup-current.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-group-describe-group-up.xbm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-group-describe-group-up.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-group-exit-up.xbm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-group-exit-up.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-group-get-new-news-this-group-up.xbm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-group-get-new-news-this-group-up.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-group-get-new-news-up.xbm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-group-get-new-news-up.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-group-kill-group-up.xbm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-group-kill-group-up.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-group-subscribe-up.xbm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-group-subscribe-up.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-group-unsubscribe-up.xbm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-group-unsubscribe-up.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-pointer.xbm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-pointer.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-summary-caesar-message-up.xbm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-summary-caesar-message-up.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-summary-cancel-article-up.xbm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-summary-cancel-article-up.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-summary-catchup-and-exit-up.xbm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-summary-catchup-and-exit-up.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-summary-catchup-up.xbm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-summary-catchup-up.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-summary-exit-up.xbm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-summary-exit-up.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-summary-followup-up.xbm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-summary-followup-up.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-summary-followup-with-original-up.xbm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-summary-followup-with-original-up.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-summary-mail-copy-up.xbm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-summary-mail-copy-up.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-summary-mail-delete-up.xbm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-summary-mail-delete-up.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-summary-mail-forward-up.xbm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-summary-mail-forward-up.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-summary-mail-get-up.xbm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-summary-mail-get-up.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-summary-mail-originate-up.xbm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-summary-mail-originate-up.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-summary-mail-reply-up.xbm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-summary-mail-reply-up.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-summary-mail-save-up.xbm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-summary-mail-save-up.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-summary-next-unread-up.xbm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-summary-next-unread-up.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-summary-post-news-up.xbm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-summary-post-news-up.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-summary-prev-unread-up.xbm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-summary-prev-unread-up.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-summary-reply-up.xbm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-summary-reply-up.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-summary-reply-with-original-up.xbm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-summary-reply-with-original-up.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-summary-save-article-file-up.xbm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-summary-save-article-file-up.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-summary-save-article-up.xbm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-summary-save-article-up.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-uu-decode-uu-up.xbm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-uu-decode-uu-up.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-uu-post-news-up.xbm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus-uu-post-news-up.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus.xbm delete mode 100644 xemacs-packages/gnus/etc/gnus/gnus.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/help.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/home.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/important.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/inbox.pbm delete mode 100644 xemacs-packages/gnus/etc/gnus/inbox.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/index.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/jump-to.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/kill-group.pbm delete mode 100644 xemacs-packages/gnus/etc/gnus/kill-group.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/left-arrow.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/lock-broken.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/lock-ok.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/lock.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/mail-reply.pbm delete mode 100644 xemacs-packages/gnus/etc/gnus/mail-reply.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/mail-send.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/message-help-up.xbm delete mode 100644 xemacs-packages/gnus/etc/gnus/message-help-up.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/message-spell-up.xbm delete mode 100644 xemacs-packages/gnus/etc/gnus/message-spell-up.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/move.pbm delete mode 100644 xemacs-packages/gnus/etc/gnus/move.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/new.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/next-node.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/next-page.pbm delete mode 100644 xemacs-packages/gnus/etc/gnus/next-page.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/next-ur.pbm delete mode 100644 xemacs-packages/gnus/etc/gnus/next-ur.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/not-spam.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/oort.xface delete mode 100644 xemacs-packages/gnus/etc/gnus/open.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/outbox.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/paste.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/post.pbm delete mode 100644 xemacs-packages/gnus/etc/gnus/post.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/preferences.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/prev-node.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/prev-ur.pbm delete mode 100644 xemacs-packages/gnus/etc/gnus/prev-ur.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/preview.xbm delete mode 100644 xemacs-packages/gnus/etc/gnus/preview.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/print.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/receipt.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/redo.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/refresh.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/reply-all.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/reply-wo.pbm delete mode 100644 xemacs-packages/gnus/etc/gnus/reply-wo.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/reply.pbm delete mode 100644 xemacs-packages/gnus/etc/gnus/reply.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/reverse-smile.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/right-arrow.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/rot13.pbm delete mode 100644 xemacs-packages/gnus/etc/gnus/rot13.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/save-aif.pbm delete mode 100644 xemacs-packages/gnus/etc/gnus/save-aif.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/save-art.pbm delete mode 100644 xemacs-packages/gnus/etc/gnus/save-art.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/save-draft.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/save.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/saveas.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/search.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/send.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/separator.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/sort-ascending.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/sort-column-ascending.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/sort-criteria.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/sort-descending.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/sort-row-ascending.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/spam.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/spell.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/subscribe.pbm delete mode 100644 xemacs-packages/gnus/etc/gnus/subscribe.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/toggle-subscription.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/unimportant.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/unsubscribe.pbm delete mode 100644 xemacs-packages/gnus/etc/gnus/unsubscribe.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/uu-decode.pbm delete mode 100644 xemacs-packages/gnus/etc/gnus/uu-decode.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/uu-post.pbm delete mode 100644 xemacs-packages/gnus/etc/gnus/uu-post.xpm delete mode 100644 xemacs-packages/gnus/etc/gnus/x-splash delete mode 100644 xemacs-packages/gnus/etc/smilies/FaceAngry.xpm delete mode 100644 xemacs-packages/gnus/etc/smilies/FaceDevilish.xpm delete mode 100644 xemacs-packages/gnus/etc/smilies/FaceGoofy.xpm delete mode 100644 xemacs-packages/gnus/etc/smilies/FaceGrinning.xpm delete mode 100644 xemacs-packages/gnus/etc/smilies/FaceHappy.xpm delete mode 100644 xemacs-packages/gnus/etc/smilies/FaceIronic.xpm delete mode 100644 xemacs-packages/gnus/etc/smilies/FaceKOed.xpm delete mode 100644 xemacs-packages/gnus/etc/smilies/FaceNyah.xpm delete mode 100644 xemacs-packages/gnus/etc/smilies/FaceSad.xpm delete mode 100644 xemacs-packages/gnus/etc/smilies/FaceStartled.xpm delete mode 100644 xemacs-packages/gnus/etc/smilies/FaceStraight.xpm delete mode 100644 xemacs-packages/gnus/etc/smilies/FaceTalking.xpm delete mode 100644 xemacs-packages/gnus/etc/smilies/FaceTasty.xpm delete mode 100644 xemacs-packages/gnus/etc/smilies/FaceWinking.xpm delete mode 100644 xemacs-packages/gnus/etc/smilies/FaceWry.xpm delete mode 100644 xemacs-packages/gnus/etc/smilies/FaceYukky.xpm delete mode 100644 xemacs-packages/gnus/etc/smilies/README delete mode 100644 xemacs-packages/gnus/etc/smilies/WideFaceAse1.xbm delete mode 100644 xemacs-packages/gnus/etc/smilies/WideFaceAse2.xbm delete mode 100644 xemacs-packages/gnus/etc/smilies/WideFaceAse3.xbm delete mode 100644 xemacs-packages/gnus/etc/smilies/WideFaceSmile.xbm delete mode 100644 xemacs-packages/gnus/etc/smilies/WideFaceWeep.xbm delete mode 100644 xemacs-packages/gnus/etc/smilies/blink.pbm delete mode 100644 xemacs-packages/gnus/etc/smilies/blink.xpm delete mode 100644 xemacs-packages/gnus/etc/smilies/braindamaged.xpm delete mode 100644 xemacs-packages/gnus/etc/smilies/cry.xpm delete mode 100644 xemacs-packages/gnus/etc/smilies/dead.xpm delete mode 100644 xemacs-packages/gnus/etc/smilies/evil.xpm delete mode 100644 xemacs-packages/gnus/etc/smilies/forced.xpm delete mode 100644 xemacs-packages/gnus/etc/smilies/frown.pbm delete mode 100644 xemacs-packages/gnus/etc/smilies/frown.xpm delete mode 100644 xemacs-packages/gnus/etc/smilies/grin.xpm delete mode 100644 xemacs-packages/gnus/etc/smilies/indifferent.xpm delete mode 100644 xemacs-packages/gnus/etc/smilies/reverse-smile.xpm delete mode 100644 xemacs-packages/gnus/etc/smilies/sad.pbm delete mode 100644 xemacs-packages/gnus/etc/smilies/sad.xpm delete mode 100644 xemacs-packages/gnus/etc/smilies/smile.pbm delete mode 100644 xemacs-packages/gnus/etc/smilies/smile.xpm delete mode 100644 xemacs-packages/gnus/etc/smilies/wry.pbm delete mode 100644 xemacs-packages/gnus/etc/smilies/wry.xpm delete mode 100644 xemacs-packages/gnus/etc/sounds/Boring.au delete mode 100644 xemacs-packages/gnus/etc/sounds/Evil_Laugh.au delete mode 100644 xemacs-packages/gnus/etc/sounds/Puke.au delete mode 100644 xemacs-packages/gnus/etc/sounds/Snicker.au delete mode 100644 xemacs-packages/gnus/etc/sounds/Tuxedomoon.Jingle4.au delete mode 100644 xemacs-packages/gnus/etc/sounds/catmeow.wav delete mode 100644 xemacs-packages/gnus/etc/sounds/cry.wav delete mode 100644 xemacs-packages/gnus/etc/sounds/drumroll.au delete mode 100644 xemacs-packages/gnus/etc/sounds/explosion.au delete mode 100644 xemacs-packages/gnus/etc/sounds/flush.au delete mode 100644 xemacs-packages/gnus/etc/sounds/kiss.wav delete mode 100644 xemacs-packages/gnus/etc/sounds/laugh.au delete mode 100644 xemacs-packages/gnus/etc/sounds/shotgun.wav delete mode 100644 xemacs-packages/gnus/etc/sounds/snore.wav delete mode 100644 xemacs-packages/gnus/etc/sounds/whistle.au delete mode 100644 xemacs-packages/gnus/etc/sounds/witch.au delete mode 100644 xemacs-packages/gnus/etc/sounds/yell2.au delete mode 100644 xemacs-packages/gnus/etc/todo.upstream delete mode 100644 xemacs-packages/gnus/lisp/ChangeLog.1.upstream delete mode 100644 xemacs-packages/gnus/lisp/ChangeLog.2.upstream delete mode 100644 xemacs-packages/gnus/lisp/ChangeLog.contrib.upstream delete mode 100644 xemacs-packages/gnus/lisp/ChangeLog.upstream delete mode 100644 xemacs-packages/gnus/lisp/GNUS-NEWS delete mode 100644 xemacs-packages/gnus/lisp/binhex.el delete mode 100644 xemacs-packages/gnus/lisp/canlock.el delete mode 100644 xemacs-packages/gnus/lisp/compface.el delete mode 100644 xemacs-packages/gnus/lisp/deuglify.el delete mode 100644 xemacs-packages/gnus/lisp/dgnushack-xemacs.el delete mode 100644 xemacs-packages/gnus/lisp/dgnushack.el delete mode 100644 xemacs-packages/gnus/lisp/earcon.el delete mode 100644 xemacs-packages/gnus/lisp/flow-fill.el delete mode 100644 xemacs-packages/gnus/lisp/format-spec.el delete mode 100644 xemacs-packages/gnus/lisp/gmm-utils.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-agent.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-art.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-async.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-audio.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-bcklg.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-cache.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-cite.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-cus.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-delay.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-demon.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-diary.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-dired.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-draft.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-dup.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-eform.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-ems.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-fun.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-gl.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-group.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-int.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-kill.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-load.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-logic.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-mh.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-ml.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-mlspl.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-move.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-msg.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-nocem.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-picon.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-range.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-registry.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-salt.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-score.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-setup.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-sieve.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-soup.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-spec.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-srvr.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-start.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-sum.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-topic.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-undo.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-util.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-uu.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-vm.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-win.el delete mode 100644 xemacs-packages/gnus/lisp/gnus-xmas.el delete mode 100644 xemacs-packages/gnus/lisp/gnus.el delete mode 100644 xemacs-packages/gnus/lisp/gpg-ring.el delete mode 100644 xemacs-packages/gnus/lisp/gpg.el delete mode 100644 xemacs-packages/gnus/lisp/hashcash.el delete mode 100644 xemacs-packages/gnus/lisp/html2text.el delete mode 100644 xemacs-packages/gnus/lisp/ietf-drums.el delete mode 100644 xemacs-packages/gnus/lisp/imap.el delete mode 100644 xemacs-packages/gnus/lisp/legacy-gnus-agent.el delete mode 100644 xemacs-packages/gnus/lisp/lpath.el delete mode 100644 xemacs-packages/gnus/lisp/mail-parse.el delete mode 100644 xemacs-packages/gnus/lisp/mail-prsvr.el delete mode 100644 xemacs-packages/gnus/lisp/mail-source.el delete mode 100644 xemacs-packages/gnus/lisp/mailcap.el delete mode 100644 xemacs-packages/gnus/lisp/message.el delete mode 100644 xemacs-packages/gnus/lisp/messagexmas.el delete mode 100644 xemacs-packages/gnus/lisp/messcompat.el delete mode 100644 xemacs-packages/gnus/lisp/mm-bodies.el delete mode 100644 xemacs-packages/gnus/lisp/mm-decode.el delete mode 100644 xemacs-packages/gnus/lisp/mm-encode.el delete mode 100644 xemacs-packages/gnus/lisp/mm-extern.el delete mode 100644 xemacs-packages/gnus/lisp/mm-partial.el delete mode 100644 xemacs-packages/gnus/lisp/mm-url.el delete mode 100644 xemacs-packages/gnus/lisp/mm-util.el delete mode 100644 xemacs-packages/gnus/lisp/mm-uu.el delete mode 100644 xemacs-packages/gnus/lisp/mm-view.el delete mode 100644 xemacs-packages/gnus/lisp/mml-sec.el delete mode 100644 xemacs-packages/gnus/lisp/mml-smime.el delete mode 100644 xemacs-packages/gnus/lisp/mml.el delete mode 100644 xemacs-packages/gnus/lisp/mml1991.el delete mode 100644 xemacs-packages/gnus/lisp/mml2015.el delete mode 100644 xemacs-packages/gnus/lisp/nnagent.el delete mode 100644 xemacs-packages/gnus/lisp/nnbabyl.el delete mode 100644 xemacs-packages/gnus/lisp/nndb.el delete mode 100644 xemacs-packages/gnus/lisp/nndiary.el delete mode 100644 xemacs-packages/gnus/lisp/nndir.el delete mode 100644 xemacs-packages/gnus/lisp/nndoc.el delete mode 100644 xemacs-packages/gnus/lisp/nndraft.el delete mode 100644 xemacs-packages/gnus/lisp/nneething.el delete mode 100644 xemacs-packages/gnus/lisp/nnfolder.el delete mode 100644 xemacs-packages/gnus/lisp/nngateway.el delete mode 100644 xemacs-packages/gnus/lisp/nnheader.el delete mode 100644 xemacs-packages/gnus/lisp/nnheaderxm.el delete mode 100644 xemacs-packages/gnus/lisp/nnimap.el delete mode 100644 xemacs-packages/gnus/lisp/nnir.el delete mode 100644 xemacs-packages/gnus/lisp/nnkiboze.el delete mode 100644 xemacs-packages/gnus/lisp/nnlistserv.el delete mode 100644 xemacs-packages/gnus/lisp/nnmail.el delete mode 100644 xemacs-packages/gnus/lisp/nnmaildir.el delete mode 100644 xemacs-packages/gnus/lisp/nnmbox.el delete mode 100644 xemacs-packages/gnus/lisp/nnmh.el delete mode 100644 xemacs-packages/gnus/lisp/nnml.el delete mode 100644 xemacs-packages/gnus/lisp/nnnil.el delete mode 100644 xemacs-packages/gnus/lisp/nnoo.el delete mode 100644 xemacs-packages/gnus/lisp/nnrss.el delete mode 100644 xemacs-packages/gnus/lisp/nnslashdot.el delete mode 100644 xemacs-packages/gnus/lisp/nnsoup.el delete mode 100644 xemacs-packages/gnus/lisp/nnspool.el delete mode 100644 xemacs-packages/gnus/lisp/nntp.el delete mode 100644 xemacs-packages/gnus/lisp/nnultimate.el delete mode 100644 xemacs-packages/gnus/lisp/nnvirtual.el delete mode 100644 xemacs-packages/gnus/lisp/nnwarchive.el delete mode 100644 xemacs-packages/gnus/lisp/nnweb.el delete mode 100644 xemacs-packages/gnus/lisp/nnwfm.el delete mode 100644 xemacs-packages/gnus/lisp/parse-time.el delete mode 100644 xemacs-packages/gnus/lisp/qp.el delete mode 100644 xemacs-packages/gnus/lisp/rfc1843.el delete mode 100644 xemacs-packages/gnus/lisp/rfc2045.el delete mode 100644 xemacs-packages/gnus/lisp/rfc2047.el delete mode 100644 xemacs-packages/gnus/lisp/rfc2231.el delete mode 100644 xemacs-packages/gnus/lisp/score-mode.el delete mode 100644 xemacs-packages/gnus/lisp/smiley.el delete mode 100644 xemacs-packages/gnus/lisp/smiley.el.upstream delete mode 100644 xemacs-packages/gnus/lisp/smime.el delete mode 100644 xemacs-packages/gnus/lisp/spam-report.el delete mode 100644 xemacs-packages/gnus/lisp/spam-stat.el delete mode 100644 xemacs-packages/gnus/lisp/spam.el delete mode 100644 xemacs-packages/gnus/lisp/time-date.el delete mode 100644 xemacs-packages/gnus/lisp/utf7.el delete mode 100644 xemacs-packages/gnus/lisp/uudecode.el delete mode 100644 xemacs-packages/gnus/lisp/vcard.el delete mode 100644 xemacs-packages/gnus/lisp/webmail.el delete mode 100644 xemacs-packages/gnus/lisp/yenc.el delete mode 100644 xemacs-packages/gnus/package-info.in delete mode 100644 xemacs-packages/gnus/texi/ChangeLog.upstream delete mode 100644 xemacs-packages/gnus/texi/doclicense.texi delete mode 100644 xemacs-packages/gnus/texi/emacs-mime.texi delete mode 100644 xemacs-packages/gnus/texi/etc/bar.xpm delete mode 100644 xemacs-packages/gnus/texi/etc/gnus-group-catchup-current-up.xpm delete mode 100644 xemacs-packages/gnus/texi/etc/gnus-group-catchup-current.xpm delete mode 100644 xemacs-packages/gnus/texi/etc/gnus-group-describe-group-up.xpm delete mode 100644 xemacs-packages/gnus/texi/etc/gnus-group-exit-up.xpm delete mode 100644 xemacs-packages/gnus/texi/etc/gnus-group-get-new-news-this-group-up.xpm delete mode 100644 xemacs-packages/gnus/texi/etc/gnus-group-get-new-news-up.xpm delete mode 100644 xemacs-packages/gnus/texi/etc/gnus-group-kill-group-up.xpm delete mode 100644 xemacs-packages/gnus/texi/etc/gnus-group-subscribe-up.xpm delete mode 100644 xemacs-packages/gnus/texi/etc/gnus-group-unsubscribe-up.xpm delete mode 100644 xemacs-packages/gnus/texi/etc/gnus-summary-caesar-message-up.xpm delete mode 100644 xemacs-packages/gnus/texi/etc/gnus-summary-cancel-article-up.xpm delete mode 100644 xemacs-packages/gnus/texi/etc/gnus-summary-catchup-and-exit-up.xpm delete mode 100644 xemacs-packages/gnus/texi/etc/gnus-summary-catchup-up.xpm delete mode 100644 xemacs-packages/gnus/texi/etc/gnus-summary-exit-up.xpm delete mode 100644 xemacs-packages/gnus/texi/etc/gnus-summary-followup-up.xpm delete mode 100644 xemacs-packages/gnus/texi/etc/gnus-summary-followup-with-original-up.xpm delete mode 100644 xemacs-packages/gnus/texi/etc/gnus-summary-mail-copy-up.xpm delete mode 100644 xemacs-packages/gnus/texi/etc/gnus-summary-mail-delete-up.xpm delete mode 100644 xemacs-packages/gnus/texi/etc/gnus-summary-mail-forward-up.xpm delete mode 100644 xemacs-packages/gnus/texi/etc/gnus-summary-mail-get-up.xpm delete mode 100644 xemacs-packages/gnus/texi/etc/gnus-summary-mail-originate-up.xpm delete mode 100644 xemacs-packages/gnus/texi/etc/gnus-summary-mail-reply-up.xpm delete mode 100644 xemacs-packages/gnus/texi/etc/gnus-summary-mail-save-up.xpm delete mode 100644 xemacs-packages/gnus/texi/etc/gnus-summary-next-unread-up.xpm delete mode 100644 xemacs-packages/gnus/texi/etc/gnus-summary-post-news-up.xpm delete mode 100644 xemacs-packages/gnus/texi/etc/gnus-summary-prev-unread-up.xpm delete mode 100644 xemacs-packages/gnus/texi/etc/gnus-summary-reply-up.xpm delete mode 100644 xemacs-packages/gnus/texi/etc/gnus-summary-reply-with-original-up.xpm delete mode 100644 xemacs-packages/gnus/texi/etc/gnus-summary-save-article-file-up.xpm delete mode 100644 xemacs-packages/gnus/texi/etc/gnus-summary-save-article-up.xpm delete mode 100644 xemacs-packages/gnus/texi/etc/gnus-uu-decode-uu-up.xpm delete mode 100644 xemacs-packages/gnus/texi/etc/gnus-uu-post-news-up.xpm delete mode 100644 xemacs-packages/gnus/texi/etc/gnus.xpm delete mode 100644 xemacs-packages/gnus/texi/gnus-faq.texi delete mode 100644 xemacs-packages/gnus/texi/gnus-logo.eps delete mode 100644 xemacs-packages/gnus/texi/gnus-refcard.tex delete mode 100644 xemacs-packages/gnus/texi/gnus.texi delete mode 100644 xemacs-packages/gnus/texi/gnusconfig.tex.in delete mode 100644 xemacs-packages/gnus/texi/herds/convol11.pnm delete mode 100644 xemacs-packages/gnus/texi/herds/convol5.pnm delete mode 100644 xemacs-packages/gnus/texi/herds/gnus-herd-bw.png delete mode 100644 xemacs-packages/gnus/texi/herds/gnus-herd-new.png delete mode 100644 xemacs-packages/gnus/texi/herds/new-herd-1.png delete mode 100644 xemacs-packages/gnus/texi/herds/new-herd-2.png delete mode 100644 xemacs-packages/gnus/texi/herds/new-herd-3.png delete mode 100644 xemacs-packages/gnus/texi/herds/new-herd-4.png delete mode 100644 xemacs-packages/gnus/texi/herds/new-herd-5.png delete mode 100644 xemacs-packages/gnus/texi/herds/new-herd-6.png delete mode 100644 xemacs-packages/gnus/texi/herds/new-herd-7.png delete mode 100644 xemacs-packages/gnus/texi/herds/new-herd-8.png delete mode 100644 xemacs-packages/gnus/texi/herds/new-herd-9.png delete mode 100644 xemacs-packages/gnus/texi/herds/new-herd-section.png delete mode 100644 xemacs-packages/gnus/texi/herds/new-herd.png delete mode 100644 xemacs-packages/gnus/texi/herds/new-herd2.png delete mode 100644 xemacs-packages/gnus/texi/infohack.el delete mode 100644 xemacs-packages/gnus/texi/message.texi delete mode 100644 xemacs-packages/gnus/texi/misc/ered.tif delete mode 100644 xemacs-packages/gnus/texi/misc/eseptember.tif delete mode 100644 xemacs-packages/gnus/texi/misc/fred.tif delete mode 100644 xemacs-packages/gnus/texi/misc/fseptember.tif delete mode 100644 xemacs-packages/gnus/texi/misc/larsi.png delete mode 100644 xemacs-packages/gnus/texi/misc/red.png delete mode 100644 xemacs-packages/gnus/texi/misc/september.png delete mode 100644 xemacs-packages/gnus/texi/pagestyle.sty delete mode 100644 xemacs-packages/gnus/texi/picons/att.png delete mode 100644 xemacs-packages/gnus/texi/picons/berkeley.png delete mode 100644 xemacs-packages/gnus/texi/picons/caltech.png delete mode 100644 xemacs-packages/gnus/texi/picons/canada.png delete mode 100644 xemacs-packages/gnus/texi/picons/cr.png delete mode 100644 xemacs-packages/gnus/texi/picons/cygnus.xbm delete mode 100644 xemacs-packages/gnus/texi/picons/gnu.xbm delete mode 100644 xemacs-packages/gnus/texi/picons/gov.xbm delete mode 100644 xemacs-packages/gnus/texi/picons/laurie.png delete mode 100644 xemacs-packages/gnus/texi/picons/mit.png delete mode 100644 xemacs-packages/gnus/texi/picons/nasa.png delete mode 100644 xemacs-packages/gnus/texi/picons/qmw.xbm delete mode 100644 xemacs-packages/gnus/texi/picons/rms.png delete mode 100644 xemacs-packages/gnus/texi/picons/ruu.xbm delete mode 100644 xemacs-packages/gnus/texi/picons/seuu.xbm delete mode 100644 xemacs-packages/gnus/texi/picons/stanford.png delete mode 100644 xemacs-packages/gnus/texi/picons/sun.png delete mode 100644 xemacs-packages/gnus/texi/picons/ubc.xbm delete mode 100644 xemacs-packages/gnus/texi/picons/ufl.png delete mode 100644 xemacs-packages/gnus/texi/picons/uio.png delete mode 100644 xemacs-packages/gnus/texi/picons/unit.png delete mode 100644 xemacs-packages/gnus/texi/picons/upenn.xbm delete mode 100644 xemacs-packages/gnus/texi/picons/wesleyan.xbm delete mode 100644 xemacs-packages/gnus/texi/picons/yale.xbm delete mode 100644 xemacs-packages/gnus/texi/pixidx.sty delete mode 100644 xemacs-packages/gnus/texi/postamble.tex delete mode 100644 xemacs-packages/gnus/texi/ps/gnus-big-logo.eps delete mode 100644 xemacs-packages/gnus/texi/ps/gnus-head.eps delete mode 100644 xemacs-packages/gnus/texi/screen/group-topic.png delete mode 100644 xemacs-packages/gnus/texi/screen/group.png delete mode 100644 xemacs-packages/gnus/texi/screen/server.png delete mode 100644 xemacs-packages/gnus/texi/screen/summary-adopt.png delete mode 100644 xemacs-packages/gnus/texi/screen/summary-article-c-ug.png delete mode 100644 xemacs-packages/gnus/texi/screen/summary-article.png delete mode 100644 xemacs-packages/gnus/texi/screen/summary-dummy.png delete mode 100644 xemacs-packages/gnus/texi/screen/summary-empty.png delete mode 100644 xemacs-packages/gnus/texi/screen/summary-none.png delete mode 100644 xemacs-packages/gnus/texi/screen/summary-unthreaded.png delete mode 100644 xemacs-packages/gnus/texi/screen/summary.png delete mode 100644 xemacs-packages/gnus/texi/smilies/BigFace.tif delete mode 100644 xemacs-packages/gnus/texi/smilies/FaceAngry.xpm delete mode 100644 xemacs-packages/gnus/texi/smilies/FaceDevilish.xpm delete mode 100644 xemacs-packages/gnus/texi/smilies/FaceGoofy.xpm delete mode 100644 xemacs-packages/gnus/texi/smilies/FaceGrinning.xpm delete mode 100644 xemacs-packages/gnus/texi/smilies/FaceHappy.xpm delete mode 100644 xemacs-packages/gnus/texi/smilies/FaceIronic.xpm delete mode 100644 xemacs-packages/gnus/texi/smilies/FaceKOed.xpm delete mode 100644 xemacs-packages/gnus/texi/smilies/FaceNyah.xpm delete mode 100644 xemacs-packages/gnus/texi/smilies/FaceSad.xpm delete mode 100644 xemacs-packages/gnus/texi/smilies/FaceStartled.xpm delete mode 100644 xemacs-packages/gnus/texi/smilies/FaceStraight.xpm delete mode 100644 xemacs-packages/gnus/texi/smilies/FaceTalking.xpm delete mode 100644 xemacs-packages/gnus/texi/smilies/FaceTasty.xpm delete mode 100644 xemacs-packages/gnus/texi/smilies/FaceWinking.xpm delete mode 100644 xemacs-packages/gnus/texi/smilies/FaceWry.xpm delete mode 100644 xemacs-packages/gnus/texi/smilies/FaceYukky.xpm delete mode 100644 xemacs-packages/gnus/texi/smilies/WideFaceAse1.xbm delete mode 100644 xemacs-packages/gnus/texi/smilies/WideFaceAse2.xbm delete mode 100644 xemacs-packages/gnus/texi/smilies/WideFaceAse3.xbm delete mode 100644 xemacs-packages/gnus/texi/smilies/WideFaceSmile.xbm delete mode 100644 xemacs-packages/gnus/texi/smilies/WideFaceWeep.xbm delete mode 100755 xemacs-packages/gnus/texi/splitindex delete mode 100644 xemacs-packages/gnus/texi/texi2latex.el delete mode 100644 xemacs-packages/gnus/texi/xface/abrahamsen.png delete mode 100644 xemacs-packages/gnus/texi/xface/aichner.png delete mode 100644 xemacs-packages/gnus/texi/xface/blanks.png delete mode 100644 xemacs-packages/gnus/texi/xface/cosgriff.png delete mode 100644 xemacs-packages/gnus/texi/xface/drazen.png delete mode 100644 xemacs-packages/gnus/texi/xface/gertzfield.png delete mode 100644 xemacs-packages/gnus/texi/xface/goldberg.png delete mode 100644 xemacs-packages/gnus/texi/xface/graf.png delete mode 100644 xemacs-packages/gnus/texi/xface/hardaker.png delete mode 100644 xemacs-packages/gnus/texi/xface/hedbor.png delete mode 100644 xemacs-packages/gnus/texi/xface/ingrand.png delete mode 100644 xemacs-packages/gnus/texi/xface/kaplan.png delete mode 100644 xemacs-packages/gnus/texi/xface/karlheg.png delete mode 100644 xemacs-packages/gnus/texi/xface/kleinpaste.png delete mode 100644 xemacs-packages/gnus/texi/xface/kyle.png delete mode 100644 xemacs-packages/gnus/texi/xface/love.png delete mode 100644 xemacs-packages/gnus/texi/xface/moll.png delete mode 100644 xemacs-packages/gnus/texi/xface/niksic.png delete mode 100644 xemacs-packages/gnus/texi/xface/olsen.png delete mode 100644 xemacs-packages/gnus/texi/xface/patch.png delete mode 100644 xemacs-packages/gnus/texi/xface/petersen.png delete mode 100644 xemacs-packages/gnus/texi/xface/pjf.png delete mode 100644 xemacs-packages/gnus/texi/xface/riocreux.png delete mode 100644 xemacs-packages/gnus/texi/xface/schauer.png delete mode 100644 xemacs-packages/gnus/texi/xface/simmonmt.png delete mode 100644 xemacs-packages/gnus/texi/xface/simmons.png delete mode 100644 xemacs-packages/gnus/texi/xface/siu.png delete mode 100644 xemacs-packages/gnus/texi/xface/smb.png delete mode 100644 xemacs-packages/gnus/texi/xface/sobek.png delete mode 100644 xemacs-packages/gnus/texi/xface/thomas.png delete mode 100644 xemacs-packages/gnus/texi/xface/valdis.png delete mode 100644 xemacs-packages/gnus/texi/xface/verna1.png delete mode 100644 xemacs-packages/gnus/texi/xface/verna2.png delete mode 100644 xemacs-packages/gnus/texi/xface/yamaoka.png delete mode 100644 xemacs-packages/gnus/texi/xml2texi.scm delete mode 100755 xemacs-packages/gnus/texi/xml2texi.sh diff --git a/xemacs-packages/gnus/COPYING b/xemacs-packages/gnus/COPYING deleted file mode 100644 index 94a9ed02..00000000 --- a/xemacs-packages/gnus/COPYING +++ /dev/null @@ -1,674 +0,0 @@ - GNU GENERAL PUBLIC LICENSE - Version 3, 29 June 2007 - - Copyright (C) 2007 Free Software Foundation, Inc. - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. - - Preamble - - The GNU General Public License is a free, copyleft license for -software and other kinds of works. - - The licenses for most software and other practical works are designed -to take away your freedom to share and change the works. By contrast, -the GNU General Public License is intended to guarantee your freedom to -share and change all versions of a program--to make sure it remains free -software for all its users. We, the Free Software Foundation, use the -GNU General Public License for most of our software; it applies also to -any other work released this way by its authors. You can apply it to -your programs, too. - - When we speak of free software, we are referring to freedom, not -price. Our General Public Licenses are designed to make sure that you -have the freedom to distribute copies of free software (and charge for -them if you wish), that you receive source code or can get it if you -want it, that you can change the software or use pieces of it in new -free programs, and that you know you can do these things. - - To protect your rights, we need to prevent others from denying you -these rights or asking you to surrender the rights. Therefore, you have -certain responsibilities if you distribute copies of the software, or if -you modify it: responsibilities to respect the freedom of others. - - For example, if you distribute copies of such a program, whether -gratis or for a fee, you must pass on to the recipients the same -freedoms that you received. You must make sure that they, too, receive -or can get the source code. And you must show them these terms so they -know their rights. - - Developers that use the GNU GPL protect your rights with two steps: -(1) assert copyright on the software, and (2) offer you this License -giving you legal permission to copy, distribute and/or modify it. - - For the developers' and authors' protection, the GPL clearly explains -that there is no warranty for this free software. For both users' and -authors' sake, the GPL requires that modified versions be marked as -changed, so that their problems will not be attributed erroneously to -authors of previous versions. - - Some devices are designed to deny users access to install or run -modified versions of the software inside them, although the manufacturer -can do so. This is fundamentally incompatible with the aim of -protecting users' freedom to change the software. The systematic -pattern of such abuse occurs in the area of products for individuals to -use, which is precisely where it is most unacceptable. Therefore, we -have designed this version of the GPL to prohibit the practice for those -products. If such problems arise substantially in other domains, we -stand ready to extend this provision to those domains in future versions -of the GPL, as needed to protect the freedom of users. - - Finally, every program is threatened constantly by software patents. -States should not allow patents to restrict development and use of -software on general-purpose computers, but in those that do, we wish to -avoid the special danger that patents applied to a free program could -make it effectively proprietary. To prevent this, the GPL assures that -patents cannot be used to render the program non-free. - - The precise terms and conditions for copying, distribution and -modification follow. - - TERMS AND CONDITIONS - - 0. Definitions. - - "This License" refers to version 3 of the GNU General Public License. - - "Copyright" also means copyright-like laws that apply to other kinds of -works, such as semiconductor masks. - - "The Program" refers to any copyrightable work licensed under this -License. Each licensee is addressed as "you". "Licensees" and -"recipients" may be individuals or organizations. - - To "modify" a work means to copy from or adapt all or part of the work -in a fashion requiring copyright permission, other than the making of an -exact copy. The resulting work is called a "modified version" of the -earlier work or a work "based on" the earlier work. - - A "covered work" means either the unmodified Program or a work based -on the Program. - - To "propagate" a work means to do anything with it that, without -permission, would make you directly or secondarily liable for -infringement under applicable copyright law, except executing it on a -computer or modifying a private copy. Propagation includes copying, -distribution (with or without modification), making available to the -public, and in some countries other activities as well. - - To "convey" a work means any kind of propagation that enables other -parties to make or receive copies. Mere interaction with a user through -a computer network, with no transfer of a copy, is not conveying. - - An interactive user interface displays "Appropriate Legal Notices" -to the extent that it includes a convenient and prominently visible -feature that (1) displays an appropriate copyright notice, and (2) -tells the user that there is no warranty for the work (except to the -extent that warranties are provided), that licensees may convey the -work under this License, and how to view a copy of this License. If -the interface presents a list of user commands or options, such as a -menu, a prominent item in the list meets this criterion. - - 1. Source Code. - - The "source code" for a work means the preferred form of the work -for making modifications to it. "Object code" means any non-source -form of a work. - - A "Standard Interface" means an interface that either is an official -standard defined by a recognized standards body, or, in the case of -interfaces specified for a particular programming language, one that -is widely used among developers working in that language. - - The "System Libraries" of an executable work include anything, other -than the work as a whole, that (a) is included in the normal form of -packaging a Major Component, but which is not part of that Major -Component, and (b) serves only to enable use of the work with that -Major Component, or to implement a Standard Interface for which an -implementation is available to the public in source code form. A -"Major Component", in this context, means a major essential component -(kernel, window system, and so on) of the specific operating system -(if any) on which the executable work runs, or a compiler used to -produce the work, or an object code interpreter used to run it. - - The "Corresponding Source" for a work in object code form means all -the source code needed to generate, install, and (for an executable -work) run the object code and to modify the work, including scripts to -control those activities. However, it does not include the work's -System Libraries, or general-purpose tools or generally available free -programs which are used unmodified in performing those activities but -which are not part of the work. For example, Corresponding Source -includes interface definition files associated with source files for -the work, and the source code for shared libraries and dynamically -linked subprograms that the work is specifically designed to require, -such as by intimate data communication or control flow between those -subprograms and other parts of the work. - - The Corresponding Source need not include anything that users -can regenerate automatically from other parts of the Corresponding -Source. - - The Corresponding Source for a work in source code form is that -same work. - - 2. Basic Permissions. - - All rights granted under this License are granted for the term of -copyright on the Program, and are irrevocable provided the stated -conditions are met. This License explicitly affirms your unlimited -permission to run the unmodified Program. The output from running a -covered work is covered by this License only if the output, given its -content, constitutes a covered work. This License acknowledges your -rights of fair use or other equivalent, as provided by copyright law. - - You may make, run and propagate covered works that you do not -convey, without conditions so long as your license otherwise remains -in force. You may convey covered works to others for the sole purpose -of having them make modifications exclusively for you, or provide you -with facilities for running those works, provided that you comply with -the terms of this License in conveying all material for which you do -not control copyright. Those thus making or running the covered works -for you must do so exclusively on your behalf, under your direction -and control, on terms that prohibit them from making any copies of -your copyrighted material outside their relationship with you. - - Conveying under any other circumstances is permitted solely under -the conditions stated below. Sublicensing is not allowed; section 10 -makes it unnecessary. - - 3. Protecting Users' Legal Rights From Anti-Circumvention Law. - - No covered work shall be deemed part of an effective technological -measure under any applicable law fulfilling obligations under article -11 of the WIPO copyright treaty adopted on 20 December 1996, or -similar laws prohibiting or restricting circumvention of such -measures. - - When you convey a covered work, you waive any legal power to forbid -circumvention of technological measures to the extent such circumvention -is effected by exercising rights under this License with respect to -the covered work, and you disclaim any intention to limit operation or -modification of the work as a means of enforcing, against the work's -users, your or third parties' legal rights to forbid circumvention of -technological measures. - - 4. Conveying Verbatim Copies. - - You may convey verbatim copies of the Program's source code as you -receive it, in any medium, provided that you conspicuously and -appropriately publish on each copy an appropriate copyright notice; -keep intact all notices stating that this License and any -non-permissive terms added in accord with section 7 apply to the code; -keep intact all notices of the absence of any warranty; and give all -recipients a copy of this License along with the Program. - - You may charge any price or no price for each copy that you convey, -and you may offer support or warranty protection for a fee. - - 5. Conveying Modified Source Versions. - - You may convey a work based on the Program, or the modifications to -produce it from the Program, in the form of source code under the -terms of section 4, provided that you also meet all of these conditions: - - a) The work must carry prominent notices stating that you modified - it, and giving a relevant date. - - b) The work must carry prominent notices stating that it is - released under this License and any conditions added under section - 7. This requirement modifies the requirement in section 4 to - "keep intact all notices". - - c) You must license the entire work, as a whole, under this - License to anyone who comes into possession of a copy. This - License will therefore apply, along with any applicable section 7 - additional terms, to the whole of the work, and all its parts, - regardless of how they are packaged. This License gives no - permission to license the work in any other way, but it does not - invalidate such permission if you have separately received it. - - d) If the work has interactive user interfaces, each must display - Appropriate Legal Notices; however, if the Program has interactive - interfaces that do not display Appropriate Legal Notices, your - work need not make them do so. - - A compilation of a covered work with other separate and independent -works, which are not by their nature extensions of the covered work, -and which are not combined with it such as to form a larger program, -in or on a volume of a storage or distribution medium, is called an -"aggregate" if the compilation and its resulting copyright are not -used to limit the access or legal rights of the compilation's users -beyond what the individual works permit. Inclusion of a covered work -in an aggregate does not cause this License to apply to the other -parts of the aggregate. - - 6. Conveying Non-Source Forms. - - You may convey a covered work in object code form under the terms -of sections 4 and 5, provided that you also convey the -machine-readable Corresponding Source under the terms of this License, -in one of these ways: - - a) Convey the object code in, or embodied in, a physical product - (including a physical distribution medium), accompanied by the - Corresponding Source fixed on a durable physical medium - customarily used for software interchange. - - b) Convey the object code in, or embodied in, a physical product - (including a physical distribution medium), accompanied by a - written offer, valid for at least three years and valid for as - long as you offer spare parts or customer support for that product - model, to give anyone who possesses the object code either (1) a - copy of the Corresponding Source for all the software in the - product that is covered by this License, on a durable physical - medium customarily used for software interchange, for a price no - more than your reasonable cost of physically performing this - conveying of source, or (2) access to copy the - Corresponding Source from a network server at no charge. - - c) Convey individual copies of the object code with a copy of the - written offer to provide the Corresponding Source. This - alternative is allowed only occasionally and noncommercially, and - only if you received the object code with such an offer, in accord - with subsection 6b. - - d) Convey the object code by offering access from a designated - place (gratis or for a charge), and offer equivalent access to the - Corresponding Source in the same way through the same place at no - further charge. You need not require recipients to copy the - Corresponding Source along with the object code. If the place to - copy the object code is a network server, the Corresponding Source - may be on a different server (operated by you or a third party) - that supports equivalent copying facilities, provided you maintain - clear directions next to the object code saying where to find the - Corresponding Source. Regardless of what server hosts the - Corresponding Source, you remain obligated to ensure that it is - available for as long as needed to satisfy these requirements. - - e) Convey the object code using peer-to-peer transmission, provided - you inform other peers where the object code and Corresponding - Source of the work are being offered to the general public at no - charge under subsection 6d. - - A separable portion of the object code, whose source code is excluded -from the Corresponding Source as a System Library, need not be -included in conveying the object code work. - - A "User Product" is either (1) a "consumer product", which means any -tangible personal property which is normally used for personal, family, -or household purposes, or (2) anything designed or sold for incorporation -into a dwelling. In determining whether a product is a consumer product, -doubtful cases shall be resolved in favor of coverage. For a particular -product received by a particular user, "normally used" refers to a -typical or common use of that class of product, regardless of the status -of the particular user or of the way in which the particular user -actually uses, or expects or is expected to use, the product. A product -is a consumer product regardless of whether the product has substantial -commercial, industrial or non-consumer uses, unless such uses represent -the only significant mode of use of the product. - - "Installation Information" for a User Product means any methods, -procedures, authorization keys, or other information required to install -and execute modified versions of a covered work in that User Product from -a modified version of its Corresponding Source. The information must -suffice to ensure that the continued functioning of the modified object -code is in no case prevented or interfered with solely because -modification has been made. - - If you convey an object code work under this section in, or with, or -specifically for use in, a User Product, and the conveying occurs as -part of a transaction in which the right of possession and use of the -User Product is transferred to the recipient in perpetuity or for a -fixed term (regardless of how the transaction is characterized), the -Corresponding Source conveyed under this section must be accompanied -by the Installation Information. But this requirement does not apply -if neither you nor any third party retains the ability to install -modified object code on the User Product (for example, the work has -been installed in ROM). - - The requirement to provide Installation Information does not include a -requirement to continue to provide support service, warranty, or updates -for a work that has been modified or installed by the recipient, or for -the User Product in which it has been modified or installed. Access to a -network may be denied when the modification itself materially and -adversely affects the operation of the network or violates the rules and -protocols for communication across the network. - - Corresponding Source conveyed, and Installation Information provided, -in accord with this section must be in a format that is publicly -documented (and with an implementation available to the public in -source code form), and must require no special password or key for -unpacking, reading or copying. - - 7. Additional Terms. - - "Additional permissions" are terms that supplement the terms of this -License by making exceptions from one or more of its conditions. -Additional permissions that are applicable to the entire Program shall -be treated as though they were included in this License, to the extent -that they are valid under applicable law. If additional permissions -apply only to part of the Program, that part may be used separately -under those permissions, but the entire Program remains governed by -this License without regard to the additional permissions. - - When you convey a copy of a covered work, you may at your option -remove any additional permissions from that copy, or from any part of -it. (Additional permissions may be written to require their own -removal in certain cases when you modify the work.) You may place -additional permissions on material, added by you to a covered work, -for which you have or can give appropriate copyright permission. - - Notwithstanding any other provision of this License, for material you -add to a covered work, you may (if authorized by the copyright holders of -that material) supplement the terms of this License with terms: - - a) Disclaiming warranty or limiting liability differently from the - terms of sections 15 and 16 of this License; or - - b) Requiring preservation of specified reasonable legal notices or - author attributions in that material or in the Appropriate Legal - Notices displayed by works containing it; or - - c) Prohibiting misrepresentation of the origin of that material, or - requiring that modified versions of such material be marked in - reasonable ways as different from the original version; or - - d) Limiting the use for publicity purposes of names of licensors or - authors of the material; or - - e) Declining to grant rights under trademark law for use of some - trade names, trademarks, or service marks; or - - f) Requiring indemnification of licensors and authors of that - material by anyone who conveys the material (or modified versions of - it) with contractual assumptions of liability to the recipient, for - any liability that these contractual assumptions directly impose on - those licensors and authors. - - All other non-permissive additional terms are considered "further -restrictions" within the meaning of section 10. If the Program as you -received it, or any part of it, contains a notice stating that it is -governed by this License along with a term that is a further -restriction, you may remove that term. If a license document contains -a further restriction but permits relicensing or conveying under this -License, you may add to a covered work material governed by the terms -of that license document, provided that the further restriction does -not survive such relicensing or conveying. - - If you add terms to a covered work in accord with this section, you -must place, in the relevant source files, a statement of the -additional terms that apply to those files, or a notice indicating -where to find the applicable terms. - - Additional terms, permissive or non-permissive, may be stated in the -form of a separately written license, or stated as exceptions; -the above requirements apply either way. - - 8. Termination. - - You may not propagate or modify a covered work except as expressly -provided under this License. Any attempt otherwise to propagate or -modify it is void, and will automatically terminate your rights under -this License (including any patent licenses granted under the third -paragraph of section 11). - - However, if you cease all violation of this License, then your -license from a particular copyright holder is reinstated (a) -provisionally, unless and until the copyright holder explicitly and -finally terminates your license, and (b) permanently, if the copyright -holder fails to notify you of the violation by some reasonable means -prior to 60 days after the cessation. - - Moreover, your license from a particular copyright holder is -reinstated permanently if the copyright holder notifies you of the -violation by some reasonable means, this is the first time you have -received notice of violation of this License (for any work) from that -copyright holder, and you cure the violation prior to 30 days after -your receipt of the notice. - - Termination of your rights under this section does not terminate the -licenses of parties who have received copies or rights from you under -this License. If your rights have been terminated and not permanently -reinstated, you do not qualify to receive new licenses for the same -material under section 10. - - 9. Acceptance Not Required for Having Copies. - - You are not required to accept this License in order to receive or -run a copy of the Program. Ancillary propagation of a covered work -occurring solely as a consequence of using peer-to-peer transmission -to receive a copy likewise does not require acceptance. However, -nothing other than this License grants you permission to propagate or -modify any covered work. These actions infringe copyright if you do -not accept this License. Therefore, by modifying or propagating a -covered work, you indicate your acceptance of this License to do so. - - 10. Automatic Licensing of Downstream Recipients. - - Each time you convey a covered work, the recipient automatically -receives a license from the original licensors, to run, modify and -propagate that work, subject to this License. You are not responsible -for enforcing compliance by third parties with this License. - - An "entity transaction" is a transaction transferring control of an -organization, or substantially all assets of one, or subdividing an -organization, or merging organizations. If propagation of a covered -work results from an entity transaction, each party to that -transaction who receives a copy of the work also receives whatever -licenses to the work the party's predecessor in interest had or could -give under the previous paragraph, plus a right to possession of the -Corresponding Source of the work from the predecessor in interest, if -the predecessor has it or can get it with reasonable efforts. - - You may not impose any further restrictions on the exercise of the -rights granted or affirmed under this License. For example, you may -not impose a license fee, royalty, or other charge for exercise of -rights granted under this License, and you may not initiate litigation -(including a cross-claim or counterclaim in a lawsuit) alleging that -any patent claim is infringed by making, using, selling, offering for -sale, or importing the Program or any portion of it. - - 11. Patents. - - A "contributor" is a copyright holder who authorizes use under this -License of the Program or a work on which the Program is based. The -work thus licensed is called the contributor's "contributor version". - - A contributor's "essential patent claims" are all patent claims -owned or controlled by the contributor, whether already acquired or -hereafter acquired, that would be infringed by some manner, permitted -by this License, of making, using, or selling its contributor version, -but do not include claims that would be infringed only as a -consequence of further modification of the contributor version. For -purposes of this definition, "control" includes the right to grant -patent sublicenses in a manner consistent with the requirements of -this License. - - Each contributor grants you a non-exclusive, worldwide, royalty-free -patent license under the contributor's essential patent claims, to -make, use, sell, offer for sale, import and otherwise run, modify and -propagate the contents of its contributor version. - - In the following three paragraphs, a "patent license" is any express -agreement or commitment, however denominated, not to enforce a patent -(such as an express permission to practice a patent or covenant not to -sue for patent infringement). To "grant" such a patent license to a -party means to make such an agreement or commitment not to enforce a -patent against the party. - - If you convey a covered work, knowingly relying on a patent license, -and the Corresponding Source of the work is not available for anyone -to copy, free of charge and under the terms of this License, through a -publicly available network server or other readily accessible means, -then you must either (1) cause the Corresponding Source to be so -available, or (2) arrange to deprive yourself of the benefit of the -patent license for this particular work, or (3) arrange, in a manner -consistent with the requirements of this License, to extend the patent -license to downstream recipients. "Knowingly relying" means you have -actual knowledge that, but for the patent license, your conveying the -covered work in a country, or your recipient's use of the covered work -in a country, would infringe one or more identifiable patents in that -country that you have reason to believe are valid. - - If, pursuant to or in connection with a single transaction or -arrangement, you convey, or propagate by procuring conveyance of, a -covered work, and grant a patent license to some of the parties -receiving the covered work authorizing them to use, propagate, modify -or convey a specific copy of the covered work, then the patent license -you grant is automatically extended to all recipients of the covered -work and works based on it. - - A patent license is "discriminatory" if it does not include within -the scope of its coverage, prohibits the exercise of, or is -conditioned on the non-exercise of one or more of the rights that are -specifically granted under this License. You may not convey a covered -work if you are a party to an arrangement with a third party that is -in the business of distributing software, under which you make payment -to the third party based on the extent of your activity of conveying -the work, and under which the third party grants, to any of the -parties who would receive the covered work from you, a discriminatory -patent license (a) in connection with copies of the covered work -conveyed by you (or copies made from those copies), or (b) primarily -for and in connection with specific products or compilations that -contain the covered work, unless you entered into that arrangement, -or that patent license was granted, prior to 28 March 2007. - - Nothing in this License shall be construed as excluding or limiting -any implied license or other defenses to infringement that may -otherwise be available to you under applicable patent law. - - 12. No Surrender of Others' Freedom. - - If conditions are imposed on you (whether by court order, agreement or -otherwise) that contradict the conditions of this License, they do not -excuse you from the conditions of this License. If you cannot convey a -covered work so as to satisfy simultaneously your obligations under this -License and any other pertinent obligations, then as a consequence you may -not convey it at all. For example, if you agree to terms that obligate you -to collect a royalty for further conveying from those to whom you convey -the Program, the only way you could satisfy both those terms and this -License would be to refrain entirely from conveying the Program. - - 13. Use with the GNU Affero General Public License. - - Notwithstanding any other provision of this License, you have -permission to link or combine any covered work with a work licensed -under version 3 of the GNU Affero General Public License into a single -combined work, and to convey the resulting work. The terms of this -License will continue to apply to the part which is the covered work, -but the special requirements of the GNU Affero General Public License, -section 13, concerning interaction through a network will apply to the -combination as such. - - 14. Revised Versions of this License. - - The Free Software Foundation may publish revised and/or new versions of -the GNU General Public License from time to time. Such new versions will -be similar in spirit to the present version, but may differ in detail to -address new problems or concerns. - - Each version is given a distinguishing version number. If the -Program specifies that a certain numbered version of the GNU General -Public License "or any later version" applies to it, you have the -option of following the terms and conditions either of that numbered -version or of any later version published by the Free Software -Foundation. If the Program does not specify a version number of the -GNU General Public License, you may choose any version ever published -by the Free Software Foundation. - - If the Program specifies that a proxy can decide which future -versions of the GNU General Public License can be used, that proxy's -public statement of acceptance of a version permanently authorizes you -to choose that version for the Program. - - Later license versions may give you additional or different -permissions. However, no additional obligations are imposed on any -author or copyright holder as a result of your choosing to follow a -later version. - - 15. Disclaimer of Warranty. - - THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY -APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT -HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY -OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, -THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM -IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF -ALL NECESSARY SERVICING, REPAIR OR CORRECTION. - - 16. Limitation of Liability. - - IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING -WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS -THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY -GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE -USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF -DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD -PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), -EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF -SUCH DAMAGES. - - 17. Interpretation of Sections 15 and 16. - - If the disclaimer of warranty and limitation of liability provided -above cannot be given local legal effect according to their terms, -reviewing courts shall apply local law that most closely approximates -an absolute waiver of all civil liability in connection with the -Program, unless a warranty or assumption of liability accompanies a -copy of the Program in return for a fee. - - END OF TERMS AND CONDITIONS - - How to Apply These Terms to Your New Programs - - If you develop a new program, and you want it to be of the greatest -possible use to the public, the best way to achieve this is to make it -free software which everyone can redistribute and change under these terms. - - To do so, attach the following notices to the program. It is safest -to attach them to the start of each source file to most effectively -state the exclusion of warranty; and each file should have at least -the "copyright" line and a pointer to where the full notice is found. - - - Copyright (C) - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . - -Also add information on how to contact you by electronic and paper mail. - - If the program does terminal interaction, make it output a short -notice like this when it starts in an interactive mode: - - Copyright (C) - This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. - This is free software, and you are welcome to redistribute it - under certain conditions; type `show c' for details. - -The hypothetical commands `show w' and `show c' should show the appropriate -parts of the General Public License. Of course, your program's commands -might be different; for a GUI interface, you would use an "about box". - - You should also get your employer (if you work as a programmer) or school, -if any, to sign a "copyright disclaimer" for the program, if necessary. -For more information on this, and how to apply and follow the GNU GPL, see -. - - The GNU General Public License does not permit incorporating your program -into proprietary programs. If your program is a subroutine library, you -may consider it more useful to permit linking proprietary applications with -the library. If this is what you want to do, use the GNU Lesser General -Public License instead of this License. But first, please read -. diff --git a/xemacs-packages/gnus/ChangeLog b/xemacs-packages/gnus/ChangeLog deleted file mode 100644 index effb472c..00000000 --- a/xemacs-packages/gnus/ChangeLog +++ /dev/null @@ -1,743 +0,0 @@ -2015-10-02 Norbert Koch - - * Makefile (VERSION): XEmacs package 2.03 released. - -2015-10-01 Henry S. Thompson - - * Makefile (MAINTAINER): change from Mike Kupfer to me - -2015-09-18 Norbert Koch - - * Makefile (VERSION): XEmacs package 2.02 released. - -2015-06-25 Michael Sperber - - * lisp/parse-time.el (fboundp): Conditionalize this on the - existence of `digit-char-p'. - -2015-02-28 Norbert Koch - - * Makefile (VERSION): XEmacs package 2.01 released. - -2015-02-26 Mike Kupfer - - * README.xemacs-packaging: New file: notes on packaging Gnus for - XEmacs. - -2014-09-08 Norbert Koch - - * Makefile (VERSION): XEmacs package 2.00 released. - -2014-08-20 Mats Lidell - - * lisp/message.el (message-use-idna): Use nil as default since - calculated value will not byte-compile. - * lisp/gnus-art.el (gnus-use-idna): Ditto. - -2014-06-22 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.99 released. - -2014-05-22 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.98 released. - -2014-05-18 Mats Lidell - - * gnus-fun.el (gnus-grab-cam-face): Upstream security issue. Do - not use predictable temp-file name. - (http://bugs.debian.org/747100) Patch by Glenn Morris. - -2014-05-15 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.97 released. - -2014-05-15 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.96 released. - -2014-05-13 Jerry James - - * .cvsignore: Remove. - * texi/.cvsignore: Remove. - * texi/ps/.cvsignore: Remove. - * .hgignore: New file. - -2012-06-26 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.95 released. - -2012-06-18 Mike Kupfer - - * gnus/lisp/custom-load.el: Deleted (possibly an artifact from the - conversion from CVS). - - * etc/gnus/dead.xpm: Deleted in favor of the copy in etc/smilies. - - * lisp/smiley.el (smiley-nosey-regexp-alist): - (smiley-deformed-regexp-alist): Add entry for "dead", from - upstream smiley.el. - - * README.readmes: New file describing the upstream READMEs and - what was done with them. - - * Makefile (DATA_2_FILES, DATA_1_FILES): Add the READMEs to the - list of files to package. - (EXTRA_SOURCES): Add COPYING (package it, too). - - * Makefile (AUTHOR_VERSION): Change to 5.10.10. - - Sync with upstream stable branch. - Please see the ChangeLog.upstream files for details. - -2010-01-10 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.94 released. - -2008-04-03 Stefan Monnier - - * gnus-win.el (gnus-configure-frame, gnus-all-windows-visible-p): - Fix last change in case the element is not even a symbol. - -2008-03-20 Stefan Monnier - - * gnus-win.el (gnus-configure-frame, gnus-all-windows-visible-p): - Prefer fboundp to functionp so it works with macros as well. - -2008-04-07 Stefan Monnier - - * mail-source.el (mail-source-value): - Prefer fboundp to functionp so it works with macros as well. - -2008-03-25 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.93 released. - -2008-03-12 Ville Skyttä - - * lisp/mm-decode.el (mm-display-external): Use `itimer-list' if - `timer-list' is not available. - -2008-01-02 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.92 released. - -2007-12-24 Aidan Kehoe - - * lisp/gnus-sum.el: - * lisp/gnus-sum.el (put-display-table): New. - * lisp/gnus-sum.el (get-display-table): New. - Provide with #'defun-when-void, so as to not override the 21.5 - implementation. - * lisp/gnus-sum.el (gnus-summary-set-display-table): - * lisp/gnus-xmas.el (gnus-xmas-summary-set-display-table): - Use #'put-display-table, not #'aref, to deal with the case where - the display table is a char table and not a vector. - -2007-03-06 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.91 released. - -2007-03-05 Mike Kupfer - - * lisp/gnus-spec.el (gnus-parse-simple-format): Add required 2nd - argument to (setq dontinsert), using the fix from the HEAD - branch at gnus.org. - - * Makefile (AUTHOR_VERSION): Change to 5.10.8. - (MAINTAINER): Change from Steve Youngs to me. - - * Sync with upstream stable branch. - Please see the ChangeLog.upstream files for details. - -2006-03-16 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.90 released. - -2006-03-16 Steve Youngs - - * Sync with upstream stable branch. - Please see the ChangeLog.upstream files for details. - -2006-01-04 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.89 released. - -2006-01-04 Steve Youngs - - * Sync with upstream stable branch. - Please see the ChangeLog.upstream files for details. - -2005-12-19 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.88 released. - -2005-12-19 Steve Youngs - - * Sync with upstream stable branch. - Please see the ChangeLog.upstream files for details. - -2005-11-15 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.87 released. - -2005-11-15 Steve Youngs - - * Sync with upstream stable branch. - Please see the ChangeLog.upstream files for details. - -2005-10-12 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.86 released. - -2005-04-03 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.85 released. - -2005-04-03 Steve Youngs - - * lisp/gnus-sum.el (gnus-summary-make-menu-bar): Fix an - "unrecognised menu descriptor" error. - From Katsumi Yamaoka - -2005-03-20 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.84 released. - -2005-03-19 Aidan Kehoe - - * lisp/mm-util.el (mm-xemacs-find-mime-charset): Only call - mm-xemacs-find-mime-charset-1 if we have the mule feature - available at runtime. - -2005-03-14 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.83 released. - -2005-03-14 Aidan Kehoe - - * lisp/mm-util.el (mm-coding-system-priorities): Healthier default - with non-Japanese language environments. - -2005-03-13 Steve Youngs - - * lisp/gnus-util.el (gnus-emacs-version): Support SXEmacs in - `gnus-extended-version'. - -2005-03-13 Steve Youngs - - * lisp/gnus.el: Don't try and mark `gnus-agent-save-groups' as an - autoloaded function. - From: Andrey Slusar . - -2005-03-13 Steve Youngs - - * Sync to upstream 5.10 branch. - See ChangeLog.upstream files for details. - - * Makefile (AUTHOR_VERSION): Bump to 5.10.7 - -2004-10-01 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.82 released. - -2004-09-29 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.81 released. - -2004-09-28 Steve Youngs - - * Sync to upstream 5.10 branch. - See ChangeLog.upstream files for details. - -2004-06-07 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.80 released. - -2004-06-07 Steve Youngs - - * Makefile (MAINTAINER): Update my email address. - - * Sync to upstream 5.10 branch. - Upstream Gnus has branched off a 5.10 series (there is talk of a - 5.10.7 release some time). This syncs our package to that. See - the ChangeLog.upstream files for details. - - * lisp/gnus-idna.el: Removed. - Unfortunately there is no mention of this in the upstream - ChangeLogs. - -2004-01-27 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.79 released. - -2004-01-26 Jerry James - - * lisp/gnus-spec.el (gnus-parse-simple-format): Fix setq value - omission. - -2004-01-17 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.78 released. - -2004-01-16 Steve Youngs - - * lisp/gnus.el: Autoload `message-y-or-n-p' - -2004-01-12 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.77 released. - -2004-01-12 Steve Youngs - - * Makefile (DONTCOMPILE): Add _pkg.el, auto-autoloads.el, and - custom-load.el to prevent circular dependencies and double files - in the tarballs. - -2004-01-05 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.76 released. - -2004-01-05 Steve Youngs - - * Makefile (AUTHOR_VERSION): Gnus 5.10.6 is released. - See the ChangeLog.upstream files for details. - -2003-12-08 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.75 released. - -2003-12-08 Steve Youngs - - * lisp/lpath.el: Maybe bind `with-timeout'. - - * lisp/dgnushack-xemacs.el: Defalias `match-string-no-properties' - to `match-string'. - - * Makefile (DONTCOMPILE): Add gpg*.el. - (REQUIRES): Remove rmail, tm, and apel. - -2003-12-08 Katsumi Yamaoka - - * lisp/gnus-util.el: Revert 2003-11-29 change, instead, provide the - compiler macro for rmail-select-summary if rmail is not available. - -2003-12-04 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.74 released. - -2003-12-03 Steve Youngs - - * Makefile (REQUIRES): Remove fsf-compat, add ps-print. - (LISPFILES): Removed. - (DONTCOMPILE): New. For any lisp that shouldn't be compiled. - (ELCS): Use it. - (PRELOADS): New. Preload lisp/dgnushack-xemacs.el & lisp/lpath.el - - * lisp/dgnushack.el: New. We don't do anything with this file, - it's only here because it exists in the upstream tree. - - * lisp/dgnushack-xemacs.el: New. XEmacs package version of - above. - - * lisp/lpath.el: New. From upstream tree. - -2003-11-29 Jerry James - - * lisp/gnus-util.el: Get rmail definitions when compiling. - * lisp/gnus-xmas.el: Add autoloads for macros defined in gnus.el. - -2003-12-01 Steve Youngs - - * lisp/mm-url.el: Require itimer when building with XEmacs. - - * lisp/gpg.el: Ditto. - -2003-10-13 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.73 released. - -2003-10-12 Adrian Aichner - - * texi/gnus.texi: General typo and whitespace fixes from gnus CVS, - carefully avoiding syncing documentation of new features. - * texi/gnus.texi (Mail Source Specifiers): uref fixes. - -2003-10-10 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.72 released. - -2003-10-09 Steve Youngs - - * Makefile (MAINTAINER): Update my email address. - -2003-05-18 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.71 released. - -2003-05-18 Vin Shelton - - * Makefile (REQUIRES): Add sasl. - -2003-05-14 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.70 released. - -2003-05-14 Steve Youngs - - * Sync to upstream version 5.10.2 - See the ChangeLog.upstream files for details. - - * Makefile (AUTHOR_VERSION): Bump. - -2003-05-02 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.69 released. - -2003-05-02 Steve Youngs - - * Sync to upstream version 5.10.1. - See the ChangeLog.upstream files for details of changes. - - * Makefile (AUTHOR_VERSION): Bump to 5.10.1. - (REQUIRES): Add pgg, net-utils, os-utils, dired, sieve. - (EXTRA_SOURCES): Add the upstream ChangeLogs. - (DATA_2_FILES): Add the .pbm files. - (DATA_4_FILES): Removed. - (DATA_4_DEST): Removed. - (DATA_5_FILES): Removed. - (DATA_5_DEST): Removed. - (EXTRA_TEXI_FILES): Remove 'gnusmail.texi', add - 'doclicense.texi'. - - * package-info.in (provides): Update to include all provides. - -2003-03-27 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.68 released. - -2003-03-27 Steve Youngs - - * Makefile (MAINTAINER): Put my name there. - (LISPFILES): The directory is now 'lisp/' not gnus/lisp/'. - (EXTRA_SOURCES): Ditto. - (DATA_5_FILES): Ditto. - (EXPLICIT_DOCS): Ditto. - (EXTRA_TEXI_FILES): Ditto. - (AUTOLOAD_PATH): Ditto. - (DATA_4_DEST): Put these files into etc/gnus/gnusrefcard/. - (DATA_5_DEST): Put these files into etc/gnus/. - (EXTRA_SOURCES): Add lisp/GNUS-NEWS. - -2003-03-09 Ben Wing - - * Makefile: - Delete explicit compile:: and binkit: rules. - Don't add custom-load.elc to the list of generated elc's. - Use EXPLICIT_DOCS instead of explicitly giving the targets - and dependencies. Specify EXTRA_TEXI_FILES. - -2003-03-02 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.67 released. - - * Makefile (VERSION): XEmacs package 1.66 released. - -2003-01-03 Rendhalver [Peter Brown] - - * Makefile (VERSION): XEmacs package 1.65 released. - -2002-12-17 Jerry James - - * Makefile (REQUIRES): Add tm and apel to satisfy transitive - dependencies from rmail. - -2002-11-29 Ben Wing - - * .cvsignore: Remove files now handled automatically by CVS. - * Makefile: Use `compile' instead of hard-coded `all'. - -2002-10-15 Ville Skyttä - - * Makefile (srckit): Remove. - (.PHONY): Remove srckit. - -2002-10-14 Ville Skyttä - - * Makefile (MANUALS): Removed (unused). - -2002-09-26 Rendhalver [Peter Brown] - - * Makefile (VERSION): XEmacs package 1.64 released. - -2002-09-25 Rendhalver [Peter Brown] - - * Makefile (VERSION): XEmacs package 1.63 released. - -2002-09-17 Ville Skyttä - - * Makefile (REQUIRES): Add ecrypto, we'll use md5 from there. - (EXTRA_SOURCES): New, add gnus/lisp/md5.el.upstream. - * package-info.in (provides): Remove md5. - -2002-06-27 Steve Youngs - - * Makefile (VERSION): XEmacs package 1.62 released. - -2002-06-08 Steve Youngs - - * Makefile (VERSION): XEmacs package 1.61 released. - -2002-05-10 Steve Youngs - - * Makefile (VERSION): XEmacs package 1.60 released. - -2002-05-07 Jerry James - - * etc/gnusrefcard/Makefile: Synch with last maintainer version. - * etc/gnusrefcard/README: Ditto. - * etc/gnusrefcard/gnusref.tex: Ditto. - -2002-03-25 Steve Youngs - - * Makefile (VERSION): 1.59 released. - -2002-03-17 Adrian Aichner - - * gnus/texi/Makefile: New file. - * gnus/texi/Makefile: include .../XEmacs.rules for generic HTML - rules. - * gnus/texi/Makefile (HTML_FILES): Moved here from ../../Makefile. - * gnus/texi/Makefile (HTML_DEP): Ditto. - -2002-03-17 Adrian Aichner - - * Makefile: Add html rule to invoke gnus/texi/Makefile. - -2002-01-13 Steve Youngs - - * package-info.in (provides): Update to include all provides. - -2002-01-07 Adrian Aichner - - * Makefile (HTML_FILES): New. - * Makefile (HTML_DEP): New. - -2001-08-29 Don Pellegrino - - * ./gnus/lisp/gnus-msg.el (gnus-inews-do-gcc): Don't use - 'gnus-alive-p". - -2001-06-06 Mark Thomas - - * nnmail.el (nnmail-fix-eudora-headers): Change the In-Reply-To - fix so it works with older versions of XEmacs. - -2001-02-14 Steve Youngs - - * gnus-win.el: (gnus-configure-windows). Use 'switch-to-buffer' instead - of 'set-buffer' if featurep 'xemacs. - (gnus-remove-some-windows): Ditto. - -2001-02-08 Steve Youngs - - * Sync with author version 5.8.8. - -2000-11-08 Steve Youngs - - * ./gnus/lisp/custom-load.el: Removed - generated file. - - * ./gnus/lisp/rfc2104.el: Moved to mail-lib package. - -2000-11-07 Martin Buchholz - - * ./gnus/texi/gnus.texi: Doc fix. - -2000-10-05 Martin Buchholz - - * *: Mega typo fix. - -2000-09-25 Steve Youngs - - * Makefile: Bring into line with author version 5.8.7 - (LISPFILES): New variable. - (ELCS): Use LISPFILES. - (DATA_FILES): Use wildcards. - -2000-08-22 Steve Youngs - - * Makefile: Remove target 'clean' because it's covered in XEmacs.rules - (REQUIRES): Add fsf-compat - -2000-07-10 Andreas Jaeger - - * Imported version 5.8.7. - - * Makefile (ELCS): Added new files. - (TEXI_FILES): Added new files. - (REQUIRES): Remove apel and tm since those are not needed - anymore. - (MANUALS): Added emacs-mime. - (INFO_FILES): Added emacs-mime. - (AUTHOR_VERSION): Updated. - -2000-02-13 Gunnar Evermann - - * Makefile (DATA_2_FILES): Install etc/smilies/*.x?m instead of - only *.xpm. - From Yoshiaki Kasahara - -2000-01-07 Andreas Jaeger - - * Makefile: Removed mailheader.el. - - * gnus/gnus/lisp/mailheader.el: Moved to package mail-lib in - for Gnus 5.8.x usage. - -1999-12-05 Andreas Jaeger - - * Makefile (REQUIRES): Add eterm. - Patch by Jan Vroonhof . - -1999-03-12 Charles G Waldman - - * Makefile: install gnus-tut.txt - -1999-02-17 SL Baur - - * Gnus' version of pop3.el is no longer used by XEmacs. - -1998-09-25 SL Baur - - * Synch with Gnus-5.6.44. - -1998-09-05 SL Baur - - * Synch with Gnus-5.6.43. - -1998-08-28 SL Baur - - * Synch with Gnus-5.6.42. - -1998-08-27 SL Baur - - * Synch with Gnus-5.6.41. - * Synch with Gnus-5.6.40. - -1998-08-22 SL Baur - - * Synch with Gnus-5.6.39. - -1998-08-19 SL Baur - - * Synch with Gnus-5.6.38. - -1998-08-14 SL Baur - - * Synch with Gnus-5.6.36. - * Synch with Gnus-5.6.35. - -1998-08-13 SL Baur - - * Synch with Gnus-5.6.34. - -1998-08-11 SL Baur - - * Synch with Gnus-5.6.33. - -1998-08-09 SL Baur - - * Synch with Gnus-5.6.31. - -1998-08-06 SL Baur - - * Synch with Gnus-5.6.29. - -1998-07-26 SL Baur - - * Synch with Gnus-5.6.27. - -1998-07-24 SL Baur - - * Synch with Gnus-5.6.25. - -1998-07-06 SL Baur - - * Synch with Gnus-5.6.23. - -1998-06-29 SL Baur - - * Synch with Gnus-5.6.22. - -1998-06-27 SL Baur - - * Synch with Gnus-5.6.20+gnus.texi patch. - -1998-06-26 SL Baur - - * Synch with Gnus-5.6.16+Karl Kleinpaste patch. - -1998-06-24 SL Baur - - * Synch with Gnus-5.6.13. - -1998-06-01 SL Baur - - * Synch with Gnus-5.6.10. - -1998-04-06 SL Baur - - * Makefile (binkit): Use TAR/EXCLUDES variables from XEmacs.rules. - -1998-03-31 SL Baur - - * Synch with gnus-5.6.4. - -1998-03-19 SL Baur - - * Synch with gnus-5.6.3. - -1998-03-08 SL Baur - - * Synch with gnus-5.6.2. - -1998-03-07 SL Baur - - * Synch with gnus-5.6.1. - -1998-02-28 SL Baur - - * Synch with qgnus-0.34. - -1998-02-23 SL Baur - - * Synch with qgnus-0.32. - -1998-02-16 SL Baur - - * Synch with qgnus-0.28. - -1998-02-15 SL Baur - - * Synch with qgnus-0.27. - -1998-02-14 SL Baur - - * Synch with qgnus-0.26. - -1998-02-13 SL Baur - - * Synch with qgnus-0.25. - -1998-02-11 SL Baur - - * Synch with qgnus-0.24. - -1998-01-25 SL Baur - - * gnus/lisp/auto-autoloads.el: Restore. - -1998-01-24 SL Baur - - * Makefile (VERSION): Update to package standard 1.0. - * package-info.in: Ditto. diff --git a/xemacs-packages/gnus/ChangeLog.upstream b/xemacs-packages/gnus/ChangeLog.upstream deleted file mode 100644 index 7bb0fa52..00000000 --- a/xemacs-packages/gnus/ChangeLog.upstream +++ /dev/null @@ -1,675 +0,0 @@ -2008-04-10 Reiner Steib - - * README: Gnus v5.10.10 is released. - -2008-03-31 Katsumi Yamaoka - - * GNUS-NEWS (Installation changes): Mention that spaces and tabs are - allowed in the installation directory name. - - * Makefile.in (datarootdir): Define. - - * aclocal.m4 (AC_PATH_LISPDIR): Quote directory name that might contain - whitespace. - - * configure: Regenerate. - - * mkinstalldirs: Replace it with the 2006-05-11.19 version. - -2008-03-22 Reiner Steib - - * GNUS-NEWS (incoming mail files): Add version. - -2008-03-08 Reiner Steib - - * GNUS-NEWS: Update for change of `mail-source-delete-incoming'. - -2008-03-01 Reiner Steib - - * Update copyright years. - -2007-11-04 Reiner Steib - - * README: Bump version to 5.10.9. - -2007-11-04 Reiner Steib - - * Makefile.in (RELEASE_COMMIT_FILES): Add etc/ChangeLog. - (release-check-settings): Add release-add-changelog - (release-bump-version): Add check for CODENAME_TO_STABLE. Split off - release-add-changelog. - (release-add-changelog): New target. Separate some commands from - release-bump-version. Add etc/ChangeLog. - (release-diff-commit-files): New target. - (RELEASE_COMMIT_FILES): Reorder files. - -2007-11-03 Reiner Steib - - * COPYING: GPLv3 from Emacs repository. - -2007-10-28 Reiner Steib - - * Makefile.in (SED_I, CODENAME_PATTERN): New. - (OLD_PATTERN): Adjust. - (release-bump-version): Use new variables. Allow going from - development version to release. - -2007-10-27 Alexander Solovyov (tiny change) - - * make.bat: Initial check didn't work if path contained spaces. - -2007-10-27 Reiner Steib - - * Makefile.in (release-bump-version): Adjust version - in (gnus)Troubleshooting. - -2007-10-04 Reiner Steib - - * Relicense "GPLv2 or later" files to "GPLv3 or later". - -2007-07-02 Reiner Steib - - * Makefile.in (COMMIT_STRING): New variable. - (release-bump-version): Use it. - (bump-version, bump-version-commit): New targets. - -2006-07-28 Reiner Steib - - * GNUS-NEWS: Regenerate from Oort Gnus node in texi/gnus.texi using - texi/gnus-news.el of the trunk. - -2006-04-19 Reiner Steib - - * make.bat (:etc): Simplify. - -2006-04-18 Reiner Steib - - * make.bat: Use "echo *" to clarify the output. - (:lisp, :infotest): Avoid "not found" errors - (:etc): Remove etc\gnus. Be more verbose. - -2006-04-11 Reiner Steib - - * README: Gnus v5.10.8 is released. - -2006-04-11 Reiner Steib - - * Makefile.in (release-sign-files): Use rm -f. - (RELEASE_COMMIT_FILES): Add ./ChangeLog. - (release-bump-version): Add README. - (release-check-settings): OLD_TAG, not OLDTAG. - (release-commit): Echo command lines before prompt. - (RELEASE_COMMIT_FILES): Add README. - (release-bump-version): Fix gnusversionname substitution. - (OLD_PATTERN): Add grouping. - -2006-04-10 Reiner Steib - - * Makefile.in (GZIP_PROG): Use gzip -f. - (release-bump-version, RELEASE_COMMIT_FILES): Add README. - (release-sign-files): Remove old *.sig files. - - * README: Let sentences end with double space. - -2006-04-07 Reiner Steib - - * Makefile.in (GZIP_PROG): New variable. - (release-diff): Use it. - (release-sign-files): New sign-only target. Use GPG_AGENT_INFO. - -2006-04-04 Reiner Steib - - * Makefile.in (TAR_BALL_EXTRA, release-make-tar-ball, README): - Remove; README is in CVS now. - (release-files, release-files-signed, release-cvs-export) - (release-make-tar-ball): Use $(VERSION) instead of $(TAG). - (OLD_PATTERN): Catch stable and trunk. - (CIN): New variable. - (release-files, release-files-signed, release-cvs-export) - (release-make-tar-ball, release-diff, release-post-clean): Add - CIN. - (OLD_PATTERN): Remove quotes. - (release-bump-version): Fix typo. - - * etc/images/README: Add more Emacs 22 icons. Add suggestion on - how to use those in Emacs 21. - - * etc/images/close.xpm, etc/images/cut.xpm, etc/images/home.xpm, - etc/images/index.xpm, etc/images/jump-to.xpm, etc/images/new.xpm, - etc/images/next-node.xpm, etc/images/open.xpm, - etc/images/preferences.xpm, etc/images/prev-node.xpm, - etc/images/saveas.xpm, etc/images/spell.xpm: New icons duplicated - from Emacs 22. - - * README: Addition from 5.10.6 tar ball. Clarify "beta". - Simplify Info directory setting. Update required Emacs and XEmacs - version. Use current Gnus version in examples. texi isn't draft - anymore. - -2006-03-31 Reiner Steib - - * Makefile.in (CVS_IGNORE_FILES): Additions. - (release-files-signed): New target. - - * etc/images/README, etc/images/cancel.xpm, etc/images/copy.xpm, - etc/images/diropen.xpm, etc/images/help.xpm, - etc/images/left-arrow.xpm, etc/images/paste.xpm, - etc/images/print.xpm, etc/images/redo.xpm, - etc/images/right-arrow.xpm, etc/images/save.xpm, - etc/images/search.xpm: Update from the trunk. - -2006-03-30 Reiner Steib - - * GNUS-NEWS: Add gnus-group-update-tool-bar. Update version for - mm-fill-flowed. - - * etc/images/separator.xpm: Update from Emacs CVS. - -2006-03-29 Reiner Steib - - * Makefile.in (release-bump-version): Consider named Gnus versions - in replacements. - -2006-03-27 Reiner Steib - - * Makefile.in (release-revert-files): Replace - release-revert-changelog. - (release-diff): Remove garbage. - -2006-03-11 Miles Bader - - * etc/images/mail: New directory. - * etc/images/attach.xpm, etc/images/connect.xpm: - * etc/images/contact.xpm, etc/images/delete.xpm: - * etc/images/describe.xpm, etc/images/disconnect.xpm: - * etc/images/exit.xpm, etc/images/gnus/toggle-subscription.xpm: - * etc/images/lock-broken.xpm, etc/images/lock-ok.xpm: - * etc/images/lock.xpm, etc/images/mail/compose.xpm: - * etc/images/mail/copy.xpm, etc/images/mail/forward.xpm: - * etc/images/mail/inbox.xpm, etc/images/mail/move.xpm: - * etc/images/mail/not-spam.xpm, etc/images/mail/outbox.xpm: - * etc/images/mail/preview.xpm, etc/images/mail/reply-all.xpm: - * etc/images/mail/reply.xpm, etc/images/mail/save-draft.xpm: - * etc/images/mail/save.xpm, etc/images/mail/send.xpm: - * etc/images/mail/spam.xpm, etc/images/next-page.xpm: - * etc/images/refresh.xpm, etc/images/separator.xpm: - * etc/images/sort-ascending.xpm: - * etc/images/sort-column-ascending.xpm: - * etc/images/sort-criteria.xpm, etc/images/sort-descending.xpm: - * etc/images/sort-row-ascending.xpm: - New icons, copied from Gnus trunk (originally from Gnome 2.6). - -2006-03-10 Reiner Steib - - * Makefile.in (release-check-settings): Add status and - suggestions. - (release-files): Remove duplicate release-cvs-export. - (README): New target. - (release-files, release-make-tar-ball, release-diff): List files. - (README, release-make-tar-ball): Fix. - -2006-03-06 Reiner Steib - - * Makefile.in (release-*): New targets. - -2006-03-03 Reiner Steib - - * xemacs.mak: Remove outdated file. Use make.bat instead. - - * GNUS-NEWS: Add `mm-fill-flowed'. - -2006-03-02 Reiner Steib - - * make.bat: Add note about "Out of environment space" on Windows - 98 SE. Avoid `>' in echo. - -2006-02-27 Reiner Steib - - * ChangeLog, texi/ChangeLog, lisp/ChangeLog: Fix "From so-and-so" - and "(tiny change)" entries. - -2006-02-27 Hiroshi Fujishima (tiny change) - - * etc/gnus-tut.txt: `G m' instead of `G V'. (Sync 2004-01-07 - change from the trunk). - -2006-02-27 Kevin Greiner - - * make.bat: Make sure that gnus-load.el and sieve are writable to - avoid breakage. (Sync 2004-03-08 change from the trunk). - -2006-02-27 Michael Schierl (tiny change) - - * make.bat: Fix directory test for Windows 9x/ME. (Sync - 2004-03-01 change from the trunk). - -2006-01-26 Katsumi Yamaoka - - * Makefile.in (clean): Clean all subdirectories; remove *~. - (elclean): Remove lisp/auto-autoloads.el, lisp/custom-load.el, and - lisp/gnus-load.el. - (distclean): Don't use sub-make to run clean; use $(MAKE) instead - of make. - - * etc/Makefile.in (clean): New rule. - (distclean): Use it; remove Makefile. - -2005-10-07 Katsumi Yamaoka - - * aclocal.m4 (AC_PATH_LISPDIR): Default to .../site-lisp/gnus for - Emacs. - (AC_PATH_ETCDIR): Don't change the default value for Emacs. - - * configure: Generated. - - * Makefile.in (list-installed-shadows): New entry. - (remove-installed-shadows): New entry. - - * GNUS-NEWS: Mention that the Lisp files are now installed in - .../site-lisp/gnus/ by default. - -2005-09-28 Simon Josefsson - - * GNUS-NEWS: Fix IDNA notes. - -2005-02-19 Miles Bader - - * etc/Makefile.in (install): Create $(etcdir)/images/gnus dir. - - * etc/Makefile.in (install, uninstall): Fix installed image dirs. - - * etc/Makefile.in (install): Put gnus-tut.txt in the right place. - - * Makefile.in (all): Don't do sub-make in etc. - * etc/Makefile.in (all): Remove target. - - * make.bat: Do image copies properly. - -2005-02-18 Miles Bader - - Move all remaining images from etc/gnus to etc/images/gnus. - -2004-06-18 Reiner Steib - - * Makefile.in (all): Do sub-make in etc. - * etc/Makefile.in (all): Link . to images. - (install, uninstall): Use $(etcdir)/images for images. - * make.bat: Likewise. - -2004-06-16 Reiner Steib - - * make.bat: Fix line endings around arch-tag. - -2004-05-19 Reiner Steib - - * GNUS-NEWS: Mention new behavior of `F' and `R' when the region - is active. - -2004-01-03 Reiner Steib - - * GNUS-NEWS: Update copyright. - - * etc/gnus-tut.txt (Gnus FAQ): Remove text version. Refer to info - documentation and online version instead. - - * GNUS-NEWS: Changed "Dired integration" - -2004-01-02 Reiner Steib - - * GNUS-NEWS: Add `gnus-group-read-ephemeral-group'. - -2003-12-23 Reiner Steib - - * GNUS-NEWS: Mention change of `e' in draft groups. - -2003-05-01 Jesper Harder - - * etc/gnus-tut.txt (http): Update. - -2003-05-01 Simon Josefsson - - * GNUS-NEWS: Add prefix limit feature. - -2003-04-30 Reiner Steib - - * GNUS-NEWS: Added Article Buttons. Added Upgrading (from Simon - Josefsson). Add gnus-mime-delete-part, markup fixes and some - other corrections. Mention Gnus FAQ. - - -2003-04-30 Jesper Harder - - * GNUS-NEWS: Additions. - -2003-04-28 Reiner Steib - - * GNUS-NEWS: Fixed X-Draft-Headers entry. - -2003-04-27 Simon Josefsson - - * GNUS-NEWS: Fix PGP entry. Doc GCC variable change. - -2003-04-22 Reiner Steib - - * make.bat: Flag as binary to ensure DOS line terminators. Delete - trailing whitespace. - -2003-04-21 Reiner Steib - From Frank Schmitt - - * etc/gnus-tut.txt: Update Gnus FAQ, delete trailing whitespace. - -2003-04-17 Kevin Greiner - - * make.bat: Cleaned up end-of-line characters. - -2003-04-17 Steve Youngs - - * Makefile.in (XEMACS): Use @EMACS@. - - * aclocal.m4 (AC_PATH_LISPDIR): Set $datadir to $prefix/lib if - building with XEmacs. - - * aclocal.m4 (AC_SET_BUILD_FLAGS): New. So we can set XEmacs - command line options to '-batch -no-autoloads...' for a cleaner - build environment. - - * configure.in: Use it. - - * configure: Regenerate. - -2003-04-16 Reiner Steib - From Frank Schmitt - - * make.bat: New variable EMACS_ARGS. Changed XEmacs args. - -2003-03-23 Simon Josefsson - - * GNUS-NEWS: Add IDNA. Add TLS. Fix USEFOR reference. - -2003-03-22 Frank Schmitt - - * make.bat: Redone from scratch; supports both Emacs and XEmacs - now; correctly generate gnus-load.el; check for errors; use - makeinfo if available, infohack.el if it isn't; be less verbose - when copying files; copy files from etc/gnus and etc/smilies, too - -2003-03-22 Frank Schmitt - - * make-x.bat: Removed, make.bat does its job now. - -2003-03-22 Frank Schmitt - - * etc/gnus-tut.txt: Include Gnus FAQ from http://my.gnus.org. - -2003-02-19 Reiner Steib - - * GNUS-NEWS: Renamed `gnus-unsightly-citation-regexp' to - `gnus-cite-unsightly-citation-regexp'. - -2003-02-18 Simon Josefsson - - * GNUS-NEWS: Talk about canlock more. - -2003-02-13 Kai Gro,A_(Bjohann - - * GNUS-NEWS: Add user visible changes from Michael Shields from - the past couple of days. Actual text from Michael. - -2003-01-24 Jesper Harder - - * etc/gnus-tut.txt: Update. - -2003-01-15 Simon Josefsson - - * GNUS-NEWS: Add. Fix from Reiner Steib - <4uce.02.r.steib@gmx.net>. - -2003-01-10 Reiner Steib - - * make.bat: Removed "-no-init-file" (it's the same as "-q"). Use - new variables EMACSBATCH and GNUS_INFO_DIR. Install gnus-?, - message-?, sieve and pgg (in texi). Added hint for dir entries. - - * make-x.bat: Ditto. - -2003-01-13 Simon Josefsson - - * GNUS-NEWS: Add smileys, Sender:, message-utils. - Expand anti-spam. Fixes. - -2003-01-09 Simon Josefsson - - * etc/gnus/preview.xpm: Add. - -2003-01-06 Simon Josefsson - - * etc/gnus/receipt.xpm: Add. - -2003-01-10 Jesper Harder - - * etc/gnus/preview.xbm: Add. - -2003-01-05 Katsumi Yamaoka - - * etc/gnus/gnus.xpm (oort): Make the color replaceable. - -2002-12-05 Kai Gro,A_(Bjohann - - * etc/smilies/*.pbm: Made them binary. - -2002-11-13 Kai Gro,A_(Bjohann - - * etc/smilies/blink.xpm: Changed smileys and some new ones from - Alex Schroeder . - -2002-04-26 Steve Youngs - - * aclocal.m4 (AC_PATH_INFODIR): New. Defaults to '$prefix/info' - for Emacs and 'site-packages/info' for XEmacs. - (AC_PATH_ETCDIR): Drop 'gnus' off the end of the default directory - for XEmacs. - - * configure.in: Use 'AC_PATH_INFO_DIR'. - -2002-02-22 Steve Youngs - - * aclocal.m4 (AC_PATH_LISPDIR): Default to - .../site-packages/lisp/gnus for XEmacs. - (AC_PATH_ETCDIR): Default to .../site-packages/etc/gnus for - XEmacs. - -2002-02-01 ShengHuo ZHU - - * etc/gnus/gnus.xpm: Remove some garbages at the end of the file. - -2002-01-05 Lars Magne Ingebrigtsen - - * etc/gnus/oort.xface (X-Face): Oort X-Face from - Raymond Scholz . - -2002-01-02 ShengHuo ZHU - - * etc/gnus/describe-group.xpm: Set pixels of first line to - background color. A bug in Emacs? - -2001-12-18 Josh Huber - - * ChangeLog, todo: (oops) changed buffer-file-coding-system back - to coding. - -2001-12-18 Kai Gro,A_(Bjohann - - * make-x.bat: Ensure nonempty variable value. Reported by Frank - Haun . - -2001-12-18 01:00:00 ShengHuo ZHU - - * ChangeLog, todo: Add `coding'. - -2001-12-17 Josh Huber - - * ChangeLog: changed coding to buffer-file-coding-system - * todo: same - -2001-12-10 Kai Gro,A_(Bjohann - - * make-x.bat: Code cleanup. Fix a bug with "/copy". From Frank - Schmitt . - -2001-11-26 Kai Gro,A_(Bjohann - - * make-x.bat: Use parameter "/copy" rather than "copy" for increased - dwimishness for old-time DOS users. From Frank Schmitt - . - -2001-11-15 Simon Josefsson - - * etc/gnus/unimportant.xpm, etc/gnus/important.xpm: New files. - -2001-11-11 Simon Josefsson - - * make-x.bat: Don't use -nw. Suggested by Frank Haun - . - -2001-11-01 07:00:00 ShengHuo ZHU - - * etc/smilies/blink.xpm: New set of xpm. From Oliver Scholz - . - -2001-10-29 Per Abrahamsen - - * etc/smilies/sad.pbm: New bitmap. - * etc/smilies/blink.pbm: Ditto. - Contributed by Kim F. Storm . - -2001-10-19 Kai Gro,A_(Bjohann - From Frank Schmitt . - - * make-x.bat: Use correct directory structure for XEmacs on Windows. - -2001-10-06 08:00:00 ShengHuo ZHU - - * Makefile.in (uninstall): Add. - - * etc/Makefile.in (uninstall): Add. - -2001-09-27 14:00:00 ShengHuo ZHU - - * aclocal.m4 (GNUS_CHECK_FONTS): Typo. Use /dev/null as latex input. - -2001-09-27 09:00:00 ShengHuo ZHU - - * aclocal.m4, configure.in: Check commercial fonts. - -2001-09-24 19:00:00 ShengHuo ZHU - - * configure.in: Generate texi/ps/Makefile. - -2001-09-21 Kai Gro,A_(Bjohann - - * make.bat: Use parameter "/copy" rather than "copy" for increased - dwimishness for old-time DOS users. - -2001-09-18 22:00:00 ShengHuo ZHU - - * make-x.bat: New. - -2001-07-04 Yair Friedman - - * make.bat: Use infohack.el to create info files. - -2001-05-17 Kai Gro,A_(Bjohann - - * etc/Makefile.in (datadir): Set this variable, like in the other - Makefile.in's. Patch from Gaute B Strokkenes . - -2001-02-11 18:00:00 ShengHuo ZHU - - * GNUS-NEWS: Copyright and others. - -2001-02-09 20:00:00 ShengHuo ZHU - - * aclocal.m4 (AC_CHECK_URL): Add. - - * configure.in: Use it. - -2001-01-15 Jesper Harder - - * make.bat: Fix doc. - -2000-12-22 03:00:00 ShengHuo ZHU - - * configure.in: Add etc/Makefile. - -2000-12-20 Jesper Harder - - * make.bat: set max-lisp-eval-depth. - -2000-10-12 Jesper Harder - - * make.bat: Makes it possible to generate the Info files on - windows again. - -2000-08-24 Jesper Harder - - * make.bat: Use emacs.exe if emacs.bat does not exist. - -2000-05-07 Pavel Janik - - * gnus.texi: direntry added. - - * message.texi: direntry added. - - * emacs-mime.texi: direntry added. - -2000-07-13 10:09:52 Katsumi Yamaoka - - * aclocal.m4 (AC_CHECK_W3): Fix typo. - -2000-07-12 15:47:06 ShengHuo ZHU - - * aclocal.m4: Stolen macros from w3. - * configure.in: Use them. - * configure: Generate it. - -2000-04-22 20:25:20 Lars Magne Ingebrigtsen - - * GNUS-NEWS: Outline. - -2000-01-06 Dave Love - - * aclocal.m4 (AM_PATH_LISPDIR): Check for user's EMACS setting. - -1999-11-13 Adrian Aichner - - * xemacs.mak: New NMAKE file to support build and install on - Windows NT. - - Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, - 2007 2008 Free Software Foundation, Inc. - - This file is part of GNU Emacs. - - GNU Emacs is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3, or (at your option) - any later version. - - GNU Emacs is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with GNU Emacs; see the file COPYING. If not, write to the - Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, - Boston, MA 02110-1301, USA. - -;; Local Variables: -;; coding: iso-2022-7bit -;; fill-column: 79 -;; add-log-time-zone-rule: t -;; End: - -;;; arch-tag: 60301ba8-b152-41b3-8fb2-173bba77f2a8 diff --git a/xemacs-packages/gnus/Makefile b/xemacs-packages/gnus/Makefile deleted file mode 100644 index e5c29d32..00000000 --- a/xemacs-packages/gnus/Makefile +++ /dev/null @@ -1,58 +0,0 @@ -# Makefile for Packaged Gnus code - -# This file is part of XEmacs. - -# XEmacs is free software; you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by the -# Free Software Foundation; either version 2, or (at your option) any -# later version. - -# XEmacs is distributed in the hope that it will be useful, but WITHOUT -# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -# for more details. - -# You should have received a copy of the GNU General Public License -# along with XEmacs; see the file COPYING. If not, write to -# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -# Boston, MA 02111-1307, USA. - -VERSION = 2.03 -AUTHOR_VERSION = 5.10.10 -MAINTAINER = Henry S. Thompson -PACKAGE = gnus -PKG_TYPE = regular -REQUIRES = gnus mail-lib xemacs-base eterm sh-script net-utils os-utils dired \ - mh-e sieve ps-print w3 pgg mailcrypt ecrypto sasl - -CATEGORY = standard - -DONTCOMPILE = lisp/dgnushack-xemacs.el lisp/dgnushack.el lisp/lpath.el \ - lisp/gpg.el lisp/gpg-ring.el lisp/_pkg.el lisp/auto-autoloads.el \ - lisp/custom-load.el - -ELCS = $(patsubst %.el,%.elc,$(filter-out $(DONTCOMPILE),$(wildcard lisp/*.el))) - -EXTRA_SOURCES = COPYING $(wildcard lisp/*.upstream) lisp/GNUS-NEWS \ - $(DONTCOMPILE) - -DATA_FILES = $(wildcard etc/sounds/*.au) $(wildcard etc/sounds/*.wav) -DATA_DEST = sounds -DATA_1_FILES = etc/smilies/README $(wildcard etc/smilies/*.x?m) -DATA_1_DEST = smilies -DATA_2_FILES = etc/gnus/GNUS-README etc/gnus/README etc/gnus/README2 \ - etc/gnus/README3 $(wildcard etc/gnus/*.[px]?m) \ - etc/gnus/x-splash -DATA_2_DEST = $(PACKAGE) -DATA_3_FILES = etc/gnus-tut.txt -DATA_3_DEST = $(PACKAGE) - -EXPLICIT_DOCS = texi/message.texi texi/gnus.texi texi/emacs-mime.texi -EXTRA_TEXI_FILES = texi/gnus-faq.texi texi/doclicense.texi - -AUTOLOAD_PATH = lisp - -PRELOADS = -l dgnushack-xemacs.el -l lpath.el - -include ../../XEmacs.rules - diff --git a/xemacs-packages/gnus/README.readmes b/xemacs-packages/gnus/README.readmes deleted file mode 100644 index c287d077..00000000 --- a/xemacs-packages/gnus/README.readmes +++ /dev/null @@ -1,26 +0,0 @@ -The upstream READMEs have been reorganized as follows: - -upstream package -src path src path notes --------- -------- -------- -README -- build instructions; not needed - -contrib/README -- description of libraries in upstream - contrib directory; not needed - -etc/images/ etc/gnus/ copyright and provenance information; -README README edited to reflect images that we - include. installed as etc/gnus/README - -etc/images/ etc/gnus/ provenance information. -GNUS-README GNUS-README - -etc/images/ etc/gnus/ copyright and provenance information. -gnus/README README2 - -etc/images/ etc/gnus/ copyright and provenance information. -mail/README README3 - -etc/images/ etc/smilies/ copyright information. installed as -smilies/ README etc/smilies/README. -README diff --git a/xemacs-packages/gnus/README.xemacs-packaging b/xemacs-packages/gnus/README.xemacs-packaging deleted file mode 100644 index 3a6ab600..00000000 --- a/xemacs-packages/gnus/README.xemacs-packaging +++ /dev/null @@ -1,69 +0,0 @@ --*- outline -*- - -This file contains notes on packaging new versions of Gnus. - -* What to Merge - -XEmacs distributes the "stable" release of Gnus. For a long time -this was the 5.10 branch. Currently there are at least 3 contenders -for the "stable" release, and no direction has been forthcoming from -the Gnus developers. The 3 contenders are - - - the latest release in the 5.10 branch - - the last release in the previous development branch (e.g., if "Ma" - Gnus is the current development branch, then use the last release - from the "No" Gnus branch) - - the version of Gnus that was included in the most recent release - of GNU Emacs. - -In any event, tarballs are no longer being posted on gnus.org. -Instead, you must download a snapshot from an upstream repo, either -the Git repository on gnus.org or the Git repository for Emacs. - -* How to Merge - -** Files to (Not) Include - -Upstream Gnus releases contain many files that are not included in the -XEmacs Gnus package. The following files from the "lisp" directory -should _NOT_ be included in the XEmacs Gnus package, as they are -delivered in other XEmacs packages: - - dig.el - dns.el - hex-util.el - netrc.el - pgg-def.el - pgg-gpg.el - pgg-parse.el - pgg-pgp.el - pgg-pgp5.el - pgg.el - pop3.el - rfc2104.el - sha1.el - sieve-manage.el - sieve-mode.el - sieve.el - starttls.el - tls.el - -Corresponding files from the texi directory should also be omitted. - -We have not been delivering the current smiley.el, either, because an -earlier maintainer preferred an old version over the one that is -currently included in Gnus releases. - -The XEmacs Gnus package does include the following files from the -"contrib" directory: - - gpg-ring.el - gpg.el - hashcash.el - nnir.el - vcard.el - -It would make more sense for vcard.el to be included in the mail-lib -package, so that it can be more easily used by other MUAs, notably VM. -Getting that fixed will require negotiation with the maintainers for -mail-lib and VM. diff --git a/xemacs-packages/gnus/etc/ChangeLog.upstream b/xemacs-packages/gnus/etc/ChangeLog.upstream deleted file mode 100644 index ce6f5062..00000000 --- a/xemacs-packages/gnus/etc/ChangeLog.upstream +++ /dev/null @@ -1,54 +0,0 @@ -2008-04-10 Reiner Steib - - * ChangeLog: Gnus v5.10.10 is released. - -2008-03-31 Katsumi Yamaoka - - * Makefile.in (datarootdir): Define. - (install, uninstall): Quote directory name that might contain - whitespace. - -2008-03-02 Reiner Steib - - * images/gnus/mail-send.xpm: Add missing legacy image from the trunk. - -2007-11-04 Reiner Steib - - * ChangeLog: Bump version to 5.10.9. - -2007-11-03 Reiner Steib - - * images/GNUS-README: Rename from README. Add some information - about the purpose of the various README files. - - * images/README: New. `emacs/etc/images/README' from Emacs. - - * ChangeLog: New ChangeLog for `./etc'. Should simplify syncing with - Emacs a little bit. - - Copyright (C) 2007, 2008 Free Software Foundation, Inc. - - This file is part of GNU Emacs. - - GNU Emacs is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3, or (at your option) - any later version. - - GNU Emacs is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with GNU Emacs; see the file COPYING. If not, write to the - Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, - Boston, MA 02110-1301, USA. - -;; Local Variables: -;; coding: iso-2022-7bit -;; fill-column: 79 -;; add-log-time-zone-rule: t -;; End: - -;; arch-tag: 192bae9c-78fa-403d-8482-f2fdcd918cad diff --git a/xemacs-packages/gnus/etc/gnus-tut.txt b/xemacs-packages/gnus/etc/gnus-tut.txt deleted file mode 100644 index 37c67c26..00000000 --- a/xemacs-packages/gnus/etc/gnus-tut.txt +++ /dev/null @@ -1,319 +0,0 @@ -From lars Thu Feb 23 23:20:38 1995 -From: larsi@gnus.org (ding) -Date: Fri Feb 24 13:40:45 1995 -Subject: So you want to use the new Gnus -Message-ID: - -Actually, since you are reading this, chances are you are already -using the new Gnus. Congratulations. - -This entire newsgroup you are reading is, in fact, no real newsgroup -at all, in the traditional sense. It is an example of one of the -"foreign" select methods that Gnus may use. - -The text you are now reading is stored in the "etc" directory with the -rest of the Emacs sources. You are using the "nndoc" backend for -accessing it. Scary, isn't it? - -This isn't the real documentation. `M-x info', `m gnus ' to read -that. This "newsgroup" is intended as a kinder, gentler way of getting -people started. - -Gnus is a rewrite of GNUS 4.1, written by Masanobu Umeda. The rewrite -was done by moi, yours truly, your humble servant, Lars Magne -Ingebrigtsen. If you have a WWW browser, you can investigate to your -heart's delight at and -. - -;; Copyright (C) 1995, 2001, 2002, 2003, 2004, 2005, -;; 2006, 2007 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -From lars Thu Feb 23 23:20:38 1995 -From: larsi@gnus.org (ding) -Date: Fri Feb 24 13:40:45 1995 -Subject: Starting up -Message-ID: - -If you are having problems with Gnus not finding your server, you have -to set `gnus-select-method'. A "method" is a way of specifying *how* -the news is to be found, and from *where*. - -Say you want to read news from you local, friendly nntp server -"news.my.local.server". - -(setq gnus-select-method '(nntp "news.my.local.server")) - -Quite easy, huh? - -From the news spool: - -(setq gnus-select-method '(nnspool "")) - -From your mh-e spool: - -(setq gnus-select-method '(nnmh "")) - -There's a whole bunch of other methods for reading mail and news, see -the "Foreign groups" article for that. - - -From lars Thu Feb 23 23:20:38 1995 -From: larsi@gnus.org (ding) -Date: Fri Feb 24 13:40:45 1995 -Subject: Where are all the groups, then? -Message-ID: - -If this is the first time you have used a newsreader, you won't have a -.newsrc file. This means that Gnus will think that all the newsgroups -on the server are "new", and kill them all. - -If you have a .newsrc file, the new groups will be processed with the -function in the `gnus-subscribe-newsgroup-method' variable, which is -`gnus-subscribe-zombies' by default. - -This means that all the groups have been made into "zombies" - not -quite dead, but not exactly alive, either. - -Jump back to the *Group* buffer, and type `A z' to list all the zombie -groups. Look though the list, and subscribe to the groups you want to -read by pressing `u' on the one you think look interesting. - -If all the groups have been killed, type `A k' to list all the killed -groups. Subscribe to them the same way. - -When you are satisfied, press `S z' to kill all the zombie groups. - -Now you should have a nice list of all groups you are interested in. - -(If you later want to subscribe to more groups, press `A k' to -list all the kill groups, and repeat. You can also type `U' and be -prompted for groups to subscribe to.) - - -From lars Thu Feb 23 23:20:38 1995 -From: larsi@gnus.org (ding) -Date: Fri Feb 24 13:40:45 1995 -Subject: I want to read my mail! -Message-ID: - -Yes, Virginia, you can read mail with Gnus. - -First you have to decide which mail backend you want to use. You have -nnml, which is a one-file-one-mail backend, which is quite nice, but -apt to make your systems administrator go crazy and come after you -with a shotgun. - -nnmbox uses a Unix mail box to store mail. Nice, but slow. - -nnmh uses mh-e folders, which is also a one-file-one-mail thingie, but -slower than nnml. (It doesn't support NOV files.) - -So if you want to go with nnmbox, you can simply say: - -(setq gnus-secondary-select-methods '((nnmbox ""))) - -(The same for the other methods, kind of.) - -You should also set `nnmail-split-methods' to something sensible: - -(setq nnmail-split-methods - '(("mail.junk" "From:.*Lars") - ("mail.misc ""))) - -This will put all mail from me in you junk mail group, and the rest in -"mail.misc". - -These groups will be subscribe the same way as the normal groups, so -you will probably find them among the zombie groups after you set -these variables and re-start Gnus. - - -From lars Thu Feb 23 23:20:38 1995 -From: larsi@gnus.org (ding) -Date: Fri Feb 24 13:40:45 1995 -Subject: Foreign newsgroups -Message-ID: - -These are groups that do not come from `gnus-select-method'. - -Say you want to read "alt.furniture.couches" from "news.funet.fi". You -can then either type `B news.funet.fi ' to browse that server and -subscribe to that group, or you can type -`G m alt.furniture.couchesnntpnews.funet.fi', if you -like to type a lot. - -If you want to read a directory as a newsgroup, you can create an -nndir group, much the same way. There's a shorthand for that, -though. If, for instance, you want to read the (ding) list archives, -you could type `G d /ftp '. - -There's lots more to know about foreign groups, but you have to read -the info pages to find out more. - - -From lars Thu Feb 23 23:20:38 1995 -From: larsi@gnus.org (ding) -Date: Fri Feb 24 13:40:45 1995 -Subject: Low level changes in GNUS, or, Wrong type argument: stringp, nil -Message-ID: - -Gnus really isn't GNUS, even though it looks like it. If you scrape -the surface, you'll find that most things have changed. - -This means that old code that relies on GNUS internals will fail. - -In particular, `gnus-newsrc-hashtb', `gnus-newsrc-assoc', -`gnus-killed-list', the `nntp-header-' macros and the display formats -have all changed. If you have some code lying around that depend on -these, or change these, you'll have to re-write your code. - -Old hilit19 code does not work at all. In fact, you should probably -remove all hilit code from all the Gnus hooks -(`gnus-group-prepare-hook', `gnus-summary-prepare-hook' and -`gnus-summary-article-hook'). (Well, at the very least the first -two.) Gnus provides various integrated functions for highlighting, -which are both faster and more accurated. - -There is absolutely no chance, whatsoever, of getting Gnus to work -with Emacs 18. It won't even work on Emacsen older than Emacs -20.7/XEmacs 21.1. Upgrade your Emacs or die. - - -From lars Thu Feb 23 23:20:38 1995 -From: larsi@gnus.org (ding) -Date: Fri Feb 24 13:40:45 1995 -Subject: How do I re-scan my mail groups? -Message-ID: - -Reading the active file from the nntp server is a drag. - -Just press `M-g' on the mail groups, and they will be re-scanned. - -You can also re-scan all the mail groups by putting them on level 1 -(`S l 1'), and saying `1 g' to re-scan all level 1 groups. - - -From lars Thu Feb 23 23:20:38 1995 -From: larsi@gnus.org (ding) -Date: Fri Feb 24 13:40:45 1995 -Subject: How do I set up virtual newsgroups? -Message-ID: - -Virtual newsgroups are collections of other newsgroups. Why people -want this is beyond me, but here goes: - -Create the group by saying - -`G m my.virtual.newsgroupnnvirtual^rec\.aquaria\.*' - -This will create the group "nnvirtual:my.virtual.newsgroup", which -will collect all articles from all the groups in the "rec.aquaria" -hierarchy. - -If you want to edit the regular expression, just type `M-e' on the -group line. - -Note that all the groups that are part of the virtual group have to be -alive. This means that the cannot, absolutely not, be zombie or -killed. They can be unsubscribed; that's no problem. - -You can combine groups from different servers in the same virtual -newsgroup, something that may actually be useful. Say you have the -group "comp.headers" on the server "news.server.no" and the same group -on "news.server.edu". If people have posted articles with Distribution -headers that stop propagation of their articles, combining these two -newsgroups into one virtual newsgroup should give you a better view of -what's going on. - -One caveat, though: The virtual group article numbers from the first -source group (group A) will always be lower than the article numbers -from the second (group B). This means that Gnus will believe that -articles from group A are older than articles from group B. Threading -will lessen these problems, but it might be a good idea to sort the -threads over the date of the articles to get a correct feel for the -flow of the groups: - -(setq gnus-thread-sort-functions '(gnus-thread-sort-by-date)) - -If you only want this in virtual groups, you could say something along -the lines of: - -(setq gnus-select-group-hook - (lambda () - (if (eq 'nnvirtual (car (gnus-find-method-for-group - gnus-newsgroup-name))) - (progn - (make-local-variable 'gnus-thread-sort-functions) - (setq gnus-thread-sort-functions '(gnus-thread-sort-by-date)))))) - - -From lars Thu Feb 23 23:20:38 1995 -From: larsi@gnus.org (ding) -Date: Fri Feb 24 13:40:45 1995 -Subject: Bugs & stuff -Message-ID: - -If you want to report a bug, please type `M-x gnus-bug'. This will -give me a precise overview of your Gnus and Emacs version numbers, -along with a look at all Gnus variables you have changed. - -Du not expect a reply back, but your bug should be fixed in the next -version. If the bug persists, please re-submit your bug report. - -When a bug occurs, I need a recipe for how to trigger the bug. You -have to tell me exactly what you do to uncover the bug, and you should -(setq debug-on-error t) and send me the backtrace along with the bug -report. - -If I am not able to reproduce the bug, I won't be able to fix it. - -I would, of course, prefer that you locate the bug, fix it, and mail -me the patches, but one can't have everything. - -If you have any questions on usage, the "ding@gnus.org" mailing list -is where to post the questions. - - -From fschmitt Sat Mar 22 18:13:00 2003 -From: faq@my.gnus.org (Gnus FAQ team) -Date: Sat Mar 22 18:13:00 2003 -Subject: Gnus FAQ (Frequently Asked Questions) -Message-ID: - -The Gnus FAQ is distributed within the Gnus manual. The home page of -the Gnus FAQ is , where you can find the -most recent version in HTML various other formats. - -To browse the FAQ now, put the cursor at the end of the following line -and press `C-x C-e': - - (info "(gnus)Frequently Asked Questions") - -On older XEmacs version, use: - - (Info-goto-node "(gnus)Frequently Asked Questions") - -Or simply use RET or the middle mouse button, if the above is displayed -as a clickable button. - - diff --git a/xemacs-packages/gnus/etc/gnus/GNUS-README b/xemacs-packages/gnus/etc/gnus/GNUS-README deleted file mode 100644 index fb352fca..00000000 --- a/xemacs-packages/gnus/etc/gnus/GNUS-README +++ /dev/null @@ -1,101 +0,0 @@ -CONTENTS - -COPYRIGHT AND LICENSE INFORMATION FOR IMAGE FILES - -ORIGIN OF THE IMAGE FILES - -The following icons are from GNOME 2.6: - - attach.xpm (stock_attach) - connect.xpm (stock_connect) - contact.xpm (stock_contact) - delete.xpm (stock_delete) - describe.xpm (stock_properties) - disconnect.xpm (stock_disconnect) - exit.xpm (stock_exit) - lock-broken.xpm (stock_lock_broken) - lock-ok.xpm (stock_lock_ok) - lock.xpm (stock_lock) - next-page.xpm (stock_next-page) - refresh.xpm (stock_refresh) - sort-ascending.xpm (stock_sort-ascending) - sort-column-ascending.xpm (stock_sort-column-ascending) - sort-criteria.xpm (stock_sort-criteria) - sort-descending.xpm (stock_sort-descending) - sort-row-ascending.xpm (stock_sort-row-ascending) - - toggle-subscription.xpm (stock_task-recurring) - - compose.xpm (stock_mail-compose) - copy.xpm (stock_mail-copy) - forward.xpm (stock_mail-forward) - inbox.xpm (stock_inbox) - move.xpm (stock_mail-move) - not-spam.xpm (stock_not-spam) - outbox.xpm (stock_outbox) - reply-all.xpm (stock_mail-reply-to-all) - reply.xpm (stock_mail-reply) - save-draft.xpm (stock_mail-handling) - send.xpm (stock_mail-send) - spam.xpm (stock_spam) - - -The following icons were contributed by Adam Sjøgren : - - preview.xpm (combining stock_mail and stock_zoom) - save.xpm (combining stock_mail, stock_save and stock_convert) - - -The folling icon are duplicated from Emacs 22. They are either not present in -Emacs 21 or look different there. - - cancel.xpm - close.xpm - cut.xpm - diropen.xpm - help.xpm - home.xpm - index.xpm - jump-to.xpm - left-arrow.xpm - new.xpm - next-node.xpm - open.xpm - paste.xpm - preferences.xpm - prev-node.xpm - print.xpm - redo.xpm - right-arrow.xpm - saveas.xpm - search.xpm - separator.xpm - spell.xpm - -You might want to use the following code to get Gnome icons in Emacs 21: - - ;; Only for Emacs 21: - (when (and (not (featurep 'xemacs)) - (not (boundp 'image-load-path)) - tool-bar-mode) - (push "/path/to/etc/images/" image-load-path) - (setq tool-bar-map (make-sparse-keymap)) - (clear-image-cache) - (tool-bar-setup)) - - -CONVERSION OF PNG FILES TO XPM - -The GNOME's stock_*.png files were converted to XPM using the following GIMP -script: - -;; -*- scheme -*- -;; Put this file in ~/.gimp-*/scripts/ -;; gimp -i -b '(rs-save-as-xpm "foo.png" "foo.xpm" 127)' '(gimp-quit 0)' -(define (rs-save-as-xpm filename filename2 threshold) - (let* ((image (car (gimp-file-load RUN-NONINTERACTIVE filename filename))) - (drawable (car (gimp-image-get-active-layer image)))) - (file-xpm-save RUN-NONINTERACTIVE image drawable - filename2 filename2 threshold) - (gimp-image-delete image))) -;; end diff --git a/xemacs-packages/gnus/etc/gnus/README b/xemacs-packages/gnus/etc/gnus/README deleted file mode 100644 index 4be90359..00000000 --- a/xemacs-packages/gnus/etc/gnus/README +++ /dev/null @@ -1,72 +0,0 @@ -* The default GTK icons were not overridden by the GNOME theme due to - a bug which was fixed in GNOME 2.15. Once GNOME 2.16 is in wide - circulation, the GTK icons should be replaced with the equivalent - GNOME icons. - -* Recipe for Creating PBM Versions - -1. Edit .xpm image in GIMP. -2. Image > Mode > Indexed. Check Use Black/White Palette and No - Color Dithering. -3. File > Save As file.xbm. -4. Run xbmtopbm < file.xbm > file.pbm. - -Thanks to jan.h.d@swipnet.se for the help. - - -COPYRIGHT AND LICENSE INFORMATION FOR IMAGE FILES - -Files: gnus.pbm - Author: Luis Fernandes - Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007 - Free Software Foundation, Inc. - License: GNU General Public License version 3 or later (see COPYING) - - -* The following icons are from GTK+ 2.x and GNOME 2.x. They are not -part of Emacs, but distributed and used by Emacs. - - Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 - Tuomas Kuosmanen, Rodney Dawes, Jakub Steiner, Alexander Larsson, - Tor Lillqvist, Garrett LeSage, Dennis Cranston, Jody Goldberg, Luca - Ferretti, Mark Finlay, Lapo Calamandrei, Andreas Nilsson and Marco - Pesenti Gritti - License: GNU General Public License version 2 - -* From GTK+ 2.x: - - close.xpm cut.xpm help.xpm home.xpm index.xpm - jump-to.xpm left-arrow.xpm new.xpm open.xpm paste.xpm - preferences.xpm print.xpm refresh.xpm right-arrow.xpm - saveas.xpm search.xpm sort-ascending.xpm sort-descending.xpm - spell.xpm - - diropen.xpm is file-manager.png from Gnome hicolor theme. - -* From GNOME 2.x: - - Emacs images and their source in the GNOME icons stock/ directory: - - attach.xpm document/stock_attach - cancel.xpm slightly modified generic/stock_stop - connect.xpm net/stock_connect - contact.xpm net/stock_contact - delete.xpm generic/stock_delete - describe.xpm generic/stock_properties - disconnect.xpm net/stock_disconnect - exit.xpm generic/stock_exit - lock-broken.xpm data/stock_lock-broken - lock-ok.xpm data/stock_lock-ok - lock.xpm data/stock_lock - redo.xpm generic/stock_redo - next-page.xpm navigation/stock_next-page - refresh.xpm generic/stock_refresh - separator.xpm ? - sort-ascending.xpm slightly modified data/stock_sort-ascending - sort-column-ascending.xpm data/stock_sort-column-ascending - sort-criteria.xpm data/stock_sort-criteria - sort-descending.xpm slightly modified data/stock_sort-descending - sort-row-ascending.xpm data/stock_sort-row-ascending - - next-node.xpm and prev-node.xpm are from gthumb version 2.0 (part of - GNOME 2.x) where they are called next-image-24.png and prev-image-24.png. diff --git a/xemacs-packages/gnus/etc/gnus/README2 b/xemacs-packages/gnus/etc/gnus/README2 deleted file mode 100644 index 26b9d068..00000000 --- a/xemacs-packages/gnus/etc/gnus/README2 +++ /dev/null @@ -1,37 +0,0 @@ -COPYRIGHT AND LICENSE INFORMATION FOR IMAGE FILES - -Files: important.xpm, unimportant.xpm -Author: Simon Josefsson -Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007 - Free Software Foundation, Inc. -License: GNU General Public License version 3 or later (see COPYING) - -Files: catchup.pbm catchup.xpm cu-exit.pbm cu-exit.xpm - describe-group.pbm describe-group.xpm exit-gnus.pbm exit-gnus.xpm - exit-summ.pbm exit-summ.xpm followup.pbm followup.xpm fuwo.pbm - fuwo.xpm get-news.pbm get-news.xpm gnntg.pbm gnntg.xpm gnus.xbm - gnus.xpm gnus-pointer.xbm gnus-pointer.xpm mail-reply.pbm - mail-reply.xpm next-ur.pbm next-ur.xpm post.pbm post.xpm prev-ur.pbm - prev-ur.xpm preview.xbm receipt.xpm reply-wo.pbm - reply-wo.xpm reply.pbm save-aif.pbm save-aif.xpm - save-art.pbm save-art.xpm subscribe.pbm subscribe.xpm - unsubscribe.pbm unsubscribe.xpm uu-decode.pbm uu-decode.xpm - uu-post.pbm uu-post.xpm -Author: Luis Fernandes -Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007 - Free Software Foundation, Inc. -License: GNU General Public License version 3 or later (see COPYING) - -The following icons are from GNOME 2.x. They are not part of Emacs, -but distributed and used by Emacs. - - Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 - Tuomas Kuosmanen, Rodney Dawes, Jakub Steiner, Alexander Larsson, - Tor Lillqvist, Garrett LeSage, Dennis Cranston, Jody Goldberg, Luca - Ferretti, Mark Finlay, Lapo Calamandrei, Andreas Nilsson and Marco - Pesenti Gritti - License: GNU General Public License version 2 - -toggle-subscription.xpm (GNOME stock/document/stock_task-recurring) -kill-group.pbm and kill-group.xpm are converted from close.xpm -rot13.pbm and rot13.xpm are converted from lock.xpm diff --git a/xemacs-packages/gnus/etc/gnus/README3 b/xemacs-packages/gnus/etc/gnus/README3 deleted file mode 100644 index 2b6c6151..00000000 --- a/xemacs-packages/gnus/etc/gnus/README3 +++ /dev/null @@ -1,35 +0,0 @@ -COPYRIGHT AND LICENSE INFORMATION FOR IMAGE FILES - -The following icons are from GNOME 2.x. They are not part of Emacs, -but distributed and used by Emacs. - - Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 - Tuomas Kuosmanen, Rodney Dawes, Jakub Steiner, Alexander Larsson, - Tor Lillqvist, Garrett LeSage, Dennis Cranston, Jody Goldberg, Luca - Ferretti, Mark Finlay, Lapo Calamandrei, Andreas Nilsson and Marco - Pesenti Gritti - License: GNU General Public License version 2 - -Emacs images and their GNOME source (GNOME icons are from stock/net/ -directory unless otherwise stated): - -compose.xpm stock_mail-compose -copy.xpm stock_mail-copy -forward.xpm stock_mail-forward -inbox.xpm stock_inbox -move.xpm stock_mail-move -not-spam.xpm stock_not-spam -outbox.xpm stock_outbox -preview.xpm combines stock_mail and navigation/stock_zoom -reply-all.xpm stock_mail-reply-to-all -reply.xpm stock_mail-reply -save-draft.xpm stock_mail-handling -save.xpm combines stock_mail, io/stock_save and - stock_convert (from gnome-themes) -send.xpm stock_mail-send -spam.xpm stock_spam - -(preview and save were contributed by Adam Sjøgren ) - -The pbm versions (where present) were converted from the xpm versions -via an essentially automatic procedure (see README). diff --git a/xemacs-packages/gnus/etc/gnus/attach.xpm b/xemacs-packages/gnus/etc/gnus/attach.xpm deleted file mode 100644 index e3298c91..00000000 --- a/xemacs-packages/gnus/etc/gnus/attach.xpm +++ /dev/null @@ -1,126 +0,0 @@ -/* XPM */ -static char * stock_attach_xpm[] = { -"24 24 99 2", -" c None", -". c #000000", -"+ c #010101", -"@ c #515151", -"# c #9A9A9A", -"$ c #CFCFCF", -"% c #6F6F6F", -"& c #464646", -"* c #A5A5A5", -"= c #E2E2E2", -"- c #FFFFFF", -"; c #F6F6F6", -"> c #8A8A8A", -", c #393939", -"' c #1C1C1C", -") c #8B8B8B", -"! c #E6E6E6", -"~ c #EEEEEE", -"{ c #E1E1E1", -"] c #F8F8F8", -"^ c #F7F7F7", -"/ c #CCCCCC", -"( c #565656", -"_ c #3E3E3E", -": c #818181", -"< c #D4D4D4", -"[ c #E7E7E7", -"} c #D7D7D7", -"| c #FAFAFA", -"1 c #F9F9F9", -"2 c #C2C2C2", -"3 c #CBCBCB", -"4 c #F5F5F5", -"5 c #D9D9D9", -"6 c #030303", -"7 c #545454", -"8 c #DEDEDE", -"9 c #B3B3B3", -"0 c #797979", -"a c #F4F4F4", -"b c #9D9D9D", -"c c #282828", -"d c #FBFBFB", -"e c #A6A6A6", -"f c #C5C5C5", -"g c #F0F0F0", -"h c #CACACA", -"i c #C7C7C7", -"j c #F2F2F2", -"k c #CECECE", -"l c #C4C4C4", -"m c #D5D5D5", -"n c #DADADA", -"o c #F3F3F3", -"p c #858585", -"q c #BEBEBE", -"r c #D3D3D3", -"s c #DCDCDC", -"t c #9C9C9C", -"u c #484848", -"v c #A7A7A7", -"w c #D6D6D6", -"x c #C8C8C8", -"y c #C6C6C6", -"z c #4C4C4C", -"A c #EAEAEA", -"B c #E5E5E5", -"C c #D8D8D8", -"D c #ADADAD", -"E c #BCBCBC", -"F c #E0E0E0", -"G c #F1F1F1", -"H c #909090", -"I c #686868", -"J c #A2A2A2", -"K c #C0C0C0", -"L c #C1C1C1", -"M c #787878", -"N c #AEAEAE", -"O c #151515", -"P c #D0D0D0", -"Q c #979797", -"R c #727272", -"S c #4A4A4A", -"T c #ECECEC", -"U c #ACACAC", -"V c #BABABA", -"W c #DDDDDD", -"X c #DBDBDB", -"Y c #B1B1B1", -"Z c #232323", -"` c #696969", -" . c #B7B7B7", -".. c #828282", -"+. c #404040", -"@. c #969696", -"#. c #323232", -"$. c #E8E8E8", -"%. c #121212", -" ", -" . . . . . ", -" . . . . ", -" . + @ # $ % . ", -" . . & * = - - ; > , ", -" . ' ) ! ~ { - ] ^ ; / ( ", -" . _ : < ' [ } | 1 ] 2 3 4 5 : . ", -" 6 7 ! - - - . } 8 9 0 . = ; 4 a b c ", -" . ; - - | | d . e f g ] . = 2 h a i ( ", -" . j ] 1 k l f . m 1 ] ] . 9 n a o o 0 . ", -" p - ] q 1 1 . r s 2 2 . = 4 a o j t c ", -" u - ^ ^ ] ] . v w ^ ; . = a l x j y z ", -" . A - ; q 2 . B C ; 4 . D E A F G A H . ", -" I - 4 ; ; J . K L . M w o j G G m N O ", -" , - a 4 4 n # . . 0 w j j G w P Q R S ", -" . T - a U V W o k X T } w Y : ( Z . ", -" ` - o o o o j j } ...+.Z . . ", -" c - o j j } q @.#.Z . ", -" . ! $./ # +.Z . . ", -" , .., %.. ", -" . . ", -" ", -" ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/bar.xbm b/xemacs-packages/gnus/etc/gnus/bar.xbm deleted file mode 100644 index e61300ad..00000000 --- a/xemacs-packages/gnus/etc/gnus/bar.xbm +++ /dev/null @@ -1,7 +0,0 @@ -#define noname_width 6 -#define noname_height 48 -static char noname_bits[] = { - 0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c, - 0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c, - 0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c, - 0x0c,0x0c,0x0c}; diff --git a/xemacs-packages/gnus/etc/gnus/bar.xpm b/xemacs-packages/gnus/etc/gnus/bar.xpm deleted file mode 100644 index 2985065a..00000000 --- a/xemacs-packages/gnus/etc/gnus/bar.xpm +++ /dev/null @@ -1,54 +0,0 @@ -/* XPM */ -static char * picon-bar_xpm[] = { -"6 48 2 1", -" c white s background", -". c black", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. "}; diff --git a/xemacs-packages/gnus/etc/gnus/cancel.xpm b/xemacs-packages/gnus/etc/gnus/cancel.xpm deleted file mode 100644 index 1a9c80ac..00000000 --- a/xemacs-packages/gnus/etc/gnus/cancel.xpm +++ /dev/null @@ -1,35 +0,0 @@ -/* XPM */ -static char *magick[] = { -/* columns rows colors chars-per-pixel */ -"24 24 5 1", -" c #01c601c601c6", -". c Gray40", -"X c #a527a527a527", -"o c #da22da22da22", -"O c None", -/* pixels */ -"OOOOOOOOOOOOOOOOOOOOOOOO", -"OOOOOOOOOOOOOOOOOOOOOOOO", -"OOOOOOOOOOOOOOOOOOOOOOOO", -"OOOOOOOOOOOOOOOOOOOOOOOO", -"OOOOOOOO OOOOOOOOO", -"OOOOOO XXooXX. OOOOOOO", -"OOOOO XooooooooX. OOOOOO", -"OOOOO oooooooooo. OOOOOO", -"OOOO Xooo ooo XoX. OOOOO", -"OOOO Xoo o XXX OOOOO", -"OOOO oooo XoXX OOOOO", -"OOOO Xoooo ooXXX OOOOO", -"OOOO Xooo OXX. OOOOO", -"OOOO Xoo o XX. OOOOO", -"OOOO .Xoo ooX XX.. OOOOO", -"OOOOO XXOoXoXXX.. OOOOOO", -"OOOOO XXXXXXXXX.. OOOOOO", -"OOOOOO XXXX... OOOOOOO", -"OOOOOOOO OOOOOOOOO", -"OOOOOOOOOOOOOOOOOOOOOOOO", -"OOOOOOOOOOOOOOOOOOOOOOOO", -"OOOOOOOOOOOOOOOOOOOOOOOO", -"OOOOOOOOOOOOOOOOOOOOOOOO", -"OOOOOOOOOOOOOOOOOOOOOOOO" -}; diff --git a/xemacs-packages/gnus/etc/gnus/catchup.pbm b/xemacs-packages/gnus/etc/gnus/catchup.pbm deleted file mode 100644 index 3fc571bdf8059402f3059eb7f574678c3d0cbdaa..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 81 zcmWGA;W9E&Ff!p{fC0t>3=9sUObU#lj)4nStqKTrVff`F$l{{J&?Ukc%EYiafKhM; YQ-^D*Lx-XUYY7X}0vQGdd6;en0AX c #FDFDFD", -", c #E6C370", -"' c #F1D387", -") c #D58F0C", -"! c #B2B2B2", -"~ c #C3C3C3", -"{ c #FBFBFB", -"] c #A8A8A8", -"^ c #F6F6F6", -"/ c #B3B3B3", -"( c #FAFAFA", -"_ c #ADADAD", -": c #767676", -"< c #5D5D5D", -"[ c #404040", -"} c #F8F8F8", -"| c #F1D07E", -"1 c #ACACAC", -"2 c #F8F8F6", -"3 c #E2E2E2", -"4 c #858585", -"5 c #4B4B49", -"6 c #161616", -"7 c #FBFBFA", -"8 c #7D7D7D", -"9 c #F2F2F2", -"0 c #F0F0F0", -"a c #EFEFEF", -"b c #D5D5D5", -"c c #F9F9F9", -"d c #F6F6F3", -"e c #F3F3F3", -"f c #878786", -"g c #E5E5E5", -"h c #DFDFDF", -"i c #EBEBEB", -"j c #AEAEAE", -"k c #7B5307", -"l c #EDEDED", -"m c #EBEBE9", -"n c #E9E9E7", -"o c #E0E0DE", -"p c #BFBFBF", -"q c #F0F0ED", -"r c #F1D284", -"s c #CA870B", -"t c #9E9E9C", -"u c #DCDCD9", -"v c #D9D9D9", -"w c #D9D9D6", -"x c #D6D6D4", -"y c #E5E5E4", -"z c #D9D9D7", -"A c #BABABA", -"B c #AAAAAA", -"C c #E7E7E5", -"D c #E4E4E2", -"E c #E2E2E0", -"F c #EEEEEC", -"G c #979796", -"H c #D4D4D1", -"I c #DEDEDC", -"J c #DEDEDB", -"K c #BDBDBC", -"L c #E7E7E7", -"M c #EFEFED", -"N c #A6A6A5", -"O c #BA7C0A", -"P c #7A5B00", -"Q c #DBDBD9", -"R c #D5D5D3", -"S c #BCBCBC", -"T c #E3E3E3", -"U c #F2E6B6", -"V c #7B7B7B", -"W c #704B05", -"X c #676764", -"Y c #CBCBC7", -"Z c #C9C9C7", -"` c #DBDBD7", -" . c #D7D7D5", -".. c #D7D7D3", -"+. c #B4B4B4", -"@. c #E4E4E4", -"#. c #DBD5C1", -"$. c #7E6F57", -"%. c #755800", -"&. c #D9D9D5", -"*. c #D5D5D1", -"=. c #D0D0CE", -"-. c #BABAB8", -";. c #DDDDDB", -">. c #D1D1CF", -",. c #0E0E0E", -"'. c #535353", -"). c #8D8D8B", -"!. c #C4C4C1", -"~. c #C4C4BF", -"{. c #C1C1BC", -"]. c #D3D3D0", -"^. c #D1D1D0", -"/. c #DCDCDB", -"(. c #E0E0DC", -"_. c #898987", -":. c #C9C9C6", -"<. c #CDCDCA", -"[. c #D0D0CD", -"}. c #CECECB", -"|. c #CFCFCC", -"1. c #D0D0CC", -"2. c #B6B6B6", -"3. c #D4D4D0", -"4. c #C3C3C0", -"5. c #5B5B5B", -"6. c #91918D", -"7. c #91918F", -"8. c #9F9F9D", -"9. c #AFAFAC", -"0. c #B9B9B6", -"a. c #BEBEBB", -"b. c #C5C5C2", -"c. c #C8C8C5", -"d. c #CACAC7", -"e. c #CBCBC8", -"f. c #CCCCC9", -"g. c #CCCCC8", -"h. c #D2D2D0", -"i. c #D2D2CF", -"j. c #BFBFBD", -"k. c #9F9F9C", -"l. c #888886", -"m. c #878785", -"n. c #8C8C8A", -"o. c #959593", -"p. c #9C9C9A", -"q. c #A8A8A5", -"r. c #B1B1AE", -"s. c #B5B5B3", -"t. c #BBBBB8", -"u. c #BFBFBC", -"v. c #C2C2BE", -"w. c #D1D1CE", -"x. c #AEAEAB", -"y. c #9D9D9A", -"z. c #979794", -"A. c #949491", -"B. c #9A9A97", -"C. c #A3A3A0", -"D. c #AAAAA7", -"E. c #B0B0AC", -"F. c #B8B8B5", -"G. c #B0B0AE", -"H. c #CFCFCD", -"I. c #BEBEBC", -"J. c #B4B4B0", -"K. c #ACACA8", -"L. c #A4A4A2", -"M. c #A0A09C", -"N. c #A4A4A0", -"O. c #A8A8A6", -"P. c #ABABA7", -"Q. c #B2B2AE", -"R. c #A4A4A4", -"S. c #CECECC", -"T. c #CECECA", -"U. c #C6C6C2", -"V. c #BCBCB9", -"W. c #B3B3AF", -"X. c #ABABA9", -"Y. c #A6A6A3", -"Z. c #A0A09D", -"`. c #ACACA9", -" + c #A1A1A1", -".+ c #B1B1AF", -"++ c #B4B4B3", -"@+ c #B4B4B1", -"#+ c #B3B3B1", -"$+ c #AEAEAA", -"%+ c #A7A7A4", -"&+ c #A2A2A0", -"*+ c #A5A5A1", -"=+ c #999997", -"-+ c #929290", -";+ c #949490", -">+ c #9D9D9B", -",+ c #858583", -" . . . ", -" . . . . . . . . . . . . + @ # . . . ", -" . $ $ $ $ $ $ $ $ $ % & @ # * . = - . ", -" . $ ; $ $ $ $ $ > > . , ' ) . ! ~ { ] . ", -" . $ ^ $ $ $ > > > / & @ # * . ( _ : < [ . ", -" . $ ^ $ { { { { } . , | ) . 1 2 3 4 5 6 . ", -" . $ ; > > { { 7 8 & @ # * . ; 9 0 a b _ . ", -" . $ 9 c ^ ^ d e . , | ) . f g 3 h i 3 - . ", -" . $ 0 } } } 2 j k @ # * . l i m n n o p . ", -" . $ a e 0 q l . , r s . t u v w x y z A . ", -" . $ l ; ; 9 B & @ # * . C y y D o E z A . ", -" . $ i F C g . , r s . G H E o I J I z K . ", -" . $ L M i N O # # P . E o I J u Q Q R S . ", -" . $ g T v . U V W . X Y Z u ` z .z ..+.. ", -" . $ E y @.. #.$.%.. u Q ` &...R *...=.-.. ", -" . $ I ;.>.,.'.. . ).!.~.{.*.*.].^.].=.-.. ", -" . $ /.(.;.. . _.:.<.[.}.[.[.[.[.|.[.1.2.. ", -" . $ Q 3.4.5.6.7.8.9.0.a.4.b.c.d.e.f.g.! . ", -" . $ h.i.|.j.k.l.m.n.o.p.q.r.s.t.a.u.v.! . ", -" . $ w.1.f.|.4.x.y.z.z.A.B.k.C.q.D.E.F.G.. ", -" . $ i.w.w.w.H.e.I.J.K.L.M.M.N.L.O.P.Q.R.. ", -" . $ ^.w.=.S.T.T.g.U.V.W.J.X.Y.Z.Y.D.`. +. ", -" . $ .+++@+@+@+#+#+Q.$+%+&+*+*+=+-+;+>+,+. ", -" . . . . . . . . . . . . . . . . . . . . "}; diff --git a/xemacs-packages/gnus/etc/gnus/connect.xpm b/xemacs-packages/gnus/etc/gnus/connect.xpm deleted file mode 100644 index f58e8b30..00000000 --- a/xemacs-packages/gnus/etc/gnus/connect.xpm +++ /dev/null @@ -1,85 +0,0 @@ -/* XPM */ -static char * stock_connect_xpm[] = { -"24 24 58 1", -" c None", -". c #000000", -"+ c #989389", -"@ c #807D74", -"# c #C6C2BA", -"$ c #34332D", -"% c #B7B3AA", -"& c #C4C2BD", -"* c #EAE8E3", -"= c #9C978D", -"- c #BCB9B2", -"; c #363433", -"> c #E2E1DD", -", c #F0EFEC", -"' c #AAA7A0", -") c #F0EEEB", -"! c #B2B0AB", -"~ c #F9F9F8", -"{ c #C5C3BD", -"] c #0F0F0D", -"^ c #F2F0ED", -"/ c #EBEAE6", -"( c #8A857B", -"_ c #ECEBE8", -": c #EEECEA", -"< c #9F9C93", -"[ c #F3F2F0", -"} c #E8E7E4", -"| c #E3E1DD", -"1 c #78756B", -"2 c #BEBBB5", -"3 c #B3B1AA", -"4 c #7D786E", -"5 c #E1DFDB", -"6 c #D1D0CC", -"7 c #938E84", -"8 c #C8C5BF", -"9 c #A7A298", -"0 c #010101", -"a c #8C8981", -"b c #A6A29B", -"c c #726D63", -"d c #CECAC3", -"e c #A7A49E", -"f c #7E7A70", -"g c #A09D94", -"h c #817D73", -"i c #6C685E", -"j c #3C3933", -"k c #8B877E", -"l c #706C62", -"m c #B1ADA4", -"n c #97938A", -"o c #625E54", -"p c #6A655B", -"q c #37342D", -"r c #646056", -"s c #8B877D", -" ", -" ", -" ", -" ", -" ", -" ", -" .. .. ", -" ..+@.#@.. ", -" $%&*@.*@=-; ", -" .>,'*@.)@!~{] ", -"......@>,'*@.)@!~{@.....", -"*******^/(_@.:@<[}|*****", -"@@@@@1123451.6@789@@@@@@", -".....01abcd1.e@fghi.....", -" ]abcd1.e@fgh] ", -" ]jklmi.n@opq. ", -" ]]+r.s@.. ", -" ]] ]. ", -" ", -" ", -" ", -" ", -" ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/contact.pbm b/xemacs-packages/gnus/etc/gnus/contact.pbm deleted file mode 100644 index 64a50b50b83d22873ebc286d1a68edc85a2b3201..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 81 zcmWGA;W9E&Ff!p{fC2mee;gQ?{68=S2rvatI~0C_DI{!BNB~pl2d4NBOwmB`4NUQ$ QE& c #D9C7B8", -", c #D9C7B9", -"' c #D8C5B8", -") c #D1C0B3", -"! c #D6C5B7", -"~ c #EBEAE5", -"{ c #D3D0C9", -"] c #CDBCAC", -"^ c #AFA093", -"/ c #3A3531", -"( c #443F3A", -"_ c #AE9F93", -": c #CBBAAB", -"< c #4E4E4C", -"[ c #595957", -"} c #595857", -"| c #7D7C7A", -"1 c #D3D0CA", -"2 c #C6B5A4", -"3 c #3D3833", -"4 c #433D37", -"5 c #C2B0A2", -"6 c #D4D1CA", -"7 c #B0A08E", -"8 c #261F18", -"9 c #D37D1E", -"0 c #D68021", -"a c #B26616", -"b c #27241F", -"c c #9C8E7F", -"d c #EAE9E5", -"e c #A29281", -"f c #2E2012", -"g c #CC751A", -"h c #CC761A", -"i c #BF6C16", -"j c #24211C", -"k c #8E8170", -"l c #EAE8E3", -"m c #E9E8E3", -"n c #E9E7E3", -"o c #8E7F6C", -"p c #221E17", -"q c #C56D14", -"r c #7D450D", -"s c #AF5F11", -"t c #221E19", -"u c #7F7260", -"v c #E9E7E2", -"w c #E8E6E1", -"x c #E7E5E1", -"y c #E7E5E0", -"z c #D5D1CB", -"A c #3E372C", -"B c #1C1F1F", -"C c #301B06", -"D c #542D07", -"E c #291B0E", -"F c #151412", -"G c #473F33", -"H c #E8E6E2", -"I c #546371", -"J c #849CB4", -"K c #56687C", -"L c #343332", -"M c #495868", -"N c #566D85", -"O c #293643", -"P c #E6E4DF", -"Q c #E5E4DE", -"R c #EEEDE9", -"S c #7B95AF", -"T c #7B96B0", -"U c #68819B", -"V c #8999AA", -"W c #5A7088", -"X c #607A96", -"Y c #5B7691", -"Z c #E5E3DE", -"` c #4B4A48", -" . c #757471", -".. c #E6E3DE", -"+. c #3B3A39", -"@. c #747371", -"#. c #D3CFC8", -"$. c #E2E1DD", -"%. c #E7E4E0", -"&. c #D2CFC8", -"*. c #D1D0CA", -"=. c #C2C0B9", -" ", -" ", -" ", -" . . . . . . . . . . . . . . . . . . . . ", -" . + @ # # # # # # # # # # # # # # # # # $ . ", -" . # % . . . . . . . & * = - - - - - - - ; . ", -" . # . > , ' ) ! > , . * * ~ ~ ~ ~ - - ~ { . ", -" . # . ] ^ / . ( _ : . * < [ ~ } } | - ~ 1 . ", -" . # . 2 3 . . . 4 5 . * * ~ ~ - - - - - 6 . ", -" . # . 7 8 9 0 a b c . * [ < | [ - } | d 6 . ", -" . # . e f g h i j k . * * l l m n n n n 6 . ", -" . # . o p q r s t u . v v w w w x y y y z . ", -" . # . A B C D E F G . H H y y y y y y y 6 . ", -" . # . I J K L M N O . y y P P P P P P Q { . ", -" . R . S T U V W X Y . y y P P P P Z Z Z { . ", -" . d ` . . . . . . . ` y y ...+.+.Z @.Z #.. ", -" . $.y y y y y y y y y %.P Z Z Z Z Z Z Z &.. ", -" . *.6 z 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 =.. ", -" . . . . . . . . . . . . . . . . . . . . . ", -" ", -" ", -" ", -" ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/copy.xpm b/xemacs-packages/gnus/etc/gnus/copy.xpm deleted file mode 100644 index 25ccc170..00000000 --- a/xemacs-packages/gnus/etc/gnus/copy.xpm +++ /dev/null @@ -1,104 +0,0 @@ -/* XPM */ -static char * stock_mail_copy_xpm[] = { -"24 24 77 1", -" c None", -". c #010101", -"+ c #2F2F2F", -"@ c #E3E2E1", -"# c #FCFCFC", -"$ c #B3B2B1", -"% c #95938E", -"& c #F7F7F7", -"* c #F5F4F2", -"= c #F8F8F8", -"- c #F7F6F6", -"; c #EAE9E5", -"> c #7B7976", -", c #D2CFCA", -"' c #E1E0DD", -") c #908E8B", -"! c #EBEAEA", -"~ c #F1F0EE", -"{ c #E2E0DD", -"] c #7C7B78", -"^ c #C6C3C0", -"/ c #E5E3DE", -"( c #DCDAD7", -"_ c #8F8C88", -": c #EBEBEA", -"< c #EFEDEA", -"[ c #DFDDDA", -"} c #787774", -"| c #C1BEBA", -"1 c #E6E3E0", -"2 c #EFEEEC", -"3 c #CBCAC6", -"4 c #ECECEC", -"5 c #F3F2F0", -"6 c #DCDCDC", -"7 c #7D7C79", -"8 c #B4B2AE", -"9 c #E7E5E1", -"0 c #F0EFEB", -"a c #E4E2DD", -"b c #7B7874", -"c c #AFACA6", -"d c #ABA8A3", -"e c #F9F8F6", -"f c #EAE9E8", -"g c #B0ADA7", -"h c #F5F3F0", -"i c #B9B8B6", -"j c #CBC9C4", -"k c #DEDBD5", -"l c #9D9994", -"m c #DBD9D6", -"n c #747370", -"o c #A09C97", -"p c #DAD8D5", -"q c #E7E6E3", -"r c #E8E6E1", -"s c #E0DED9", -"t c #F7F6F4", -"u c #D3D1CF", -"v c #868480", -"w c #C2BFBD", -"x c #DAD9D5", -"y c #F6F5F1", -"z c #D8D6D1", -"A c #F7F5F2", -"B c #92908B", -"C c #CCCAC5", -"D c #F7F6F2", -"E c #F5F4F0", -"F c #EAE8E3", -"G c #D2D0CB", -"H c #D9D7D2", -"I c #DAD8D3", -"J c #D5D3CE", -"K c #D6D4CF", -"L c #040404", -" ", -" ", -" ", -" .+........... ", -" .@###########$. ", -" .#%&*=*-*-*;>,. ", -" .#')!~-*-*{]^/. ", -" .#~(_:~<~[}|1/. ", -" .#~23]4567890a. ", -" .#22~b.+........... ", -" .#~2c.@###########$. ", -" .#2de.#%&*=*-*-*;>,. ", -" .fgeh.#')!~-*-*{]^/. ", -" .ijkk.#~(_:~<~[}|1/. ", -" .....#~23]4567890a. ", -" .#22~l]mnopqrs. ", -" .#~2ctuvwxoy0z. ", -" .#2deetptAABrC. ", -" .fgehDEAEAhFBG. ", -" .ijkkkHIJKGGGB. ", -" ............L ", -" ", -" ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/cu-exit.pbm b/xemacs-packages/gnus/etc/gnus/cu-exit.pbm deleted file mode 100644 index 210869cce7836f3325e4fe48f70d16214dbbcbeb..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 81 zcmWGA;W9E&Ff!p{Km+m&41o+xi4ClU0W3-iEa47pP7bUt4$KY>jG+z;K|m6u07U+0 PV7$)2@Q;BZ1Y`sNnq~{( diff --git a/xemacs-packages/gnus/etc/gnus/cu-exit.xpm b/xemacs-packages/gnus/etc/gnus/cu-exit.xpm deleted file mode 100644 index 17236223..00000000 --- a/xemacs-packages/gnus/etc/gnus/cu-exit.xpm +++ /dev/null @@ -1,31 +0,0 @@ -/* XPM */ -static char * cu_exit_xpm[] = { -"24 24 4 1", -" c None", -". c #000000000000", -"X c #FFFFFFFFFFFF", -"o c #999999999999", -" ", -" ", -" ", -" ", -" ", -" ..... ", -" .. .XXX. ", -" ..X..XXXX... ", -" .XXXX.XXXX.X... ", -" ..XXXX.XXX.XXX.. ", -" .XXX.......... ", -" .XXX.XXX.XXX.. ", -" .XX.XXX.XXX. ", -" .XX.XXX.XX.. ", -" ............ ", -" .X.X.X.X.. ", -"ooooooo..........ooooooo", -"ooooooo.X.X.X.X.oooooooo", -"ooooooo.........oooooooo", -"ooooooo..X...X..oooooooo", -"ooooooo...X.X...oooooooo", -"ooooooo........ooooooooo", -"ooooooooo.....oooooooooo", -"oooooooooooooooooooooooo"}; diff --git a/xemacs-packages/gnus/etc/gnus/cut.xpm b/xemacs-packages/gnus/etc/gnus/cut.xpm deleted file mode 100644 index 3f8e71d2..00000000 --- a/xemacs-packages/gnus/etc/gnus/cut.xpm +++ /dev/null @@ -1,67 +0,0 @@ -/* XPM */ -static char * cut_xpm[] = { -"24 24 40 1", -" c None", -". c #000000", -"+ c #C9C7C2", -"@ c #E6E4E0", -"# c #EFEEED", -"$ c #494946", -"% c #73726E", -"& c #F0EEED", -"* c #7F7D75", -"= c #F2F1EF", -"- c #D2CFC8", -"; c #E7E7E4", -"> c #BAB5AB", -", c #565653", -"' c #EDECE9", -") c #A4A097", -"! c #817F7E", -"~ c #4E4C48", -"{ c #F6F5F4", -"] c #474541", -"^ c #EFEEEC", -"/ c #8C8B8A", -"( c #F3F2F0", -"_ c #77746D", -": c #323232", -"< c #EBEBEA", -"[ c #605D58", -"} c #F5F4F3", -"| c #CECCC7", -"1 c #363634", -"2 c #6F6E6D", -"3 c #BEBDBB", -"4 c #EAE7E4", -"5 c #B8B5B1", -"6 c #474747", -"7 c #DAD8D4", -"8 c #9B9996", -"9 c #161615", -"0 c #6D6B6A", -"a c #3A3837", -" ", -" ", -" . . ", -" . . ", -" .+. .@. ", -" .#$ %@. ", -" .&*. .=-. ", -" .;>, %'). ", -" !#*. .=-~ ", -" .{>] ~^>. ", -" /(_.:<-[ ", -" .}|123>. ", -" .456>. ", -" .78.. ", -" .90a. ", -" ............. ", -" . ... ... ... ", -" .. .. .. .. ", -" . . . . ", -" .. .. .. .. ", -" .... .. . ", -" .... .... ", -" ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/delete.pbm b/xemacs-packages/gnus/etc/gnus/delete.pbm deleted file mode 100644 index 886be51fd12d21a317b31373296718fb431e2bf0..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 81 zcmWGA;W9E&Ff!p{sAFI}+`!NHL10gZLLG~O9E$=25b-E5*cdQKNHAE)G5(PM|3ftY ahln~Dss0dwAsN*lysAIg|36^--v9tY_ZeRR diff --git a/xemacs-packages/gnus/etc/gnus/delete.xpm b/xemacs-packages/gnus/etc/gnus/delete.xpm deleted file mode 100644 index e2d1d907..00000000 --- a/xemacs-packages/gnus/etc/gnus/delete.xpm +++ /dev/null @@ -1,270 +0,0 @@ -/* XPM */ -static char * stock_delete_xpm[] = { -"24 24 243 2", -" c None", -". c #000000", -"+ c #1C1C1C", -"@ c #767676", -"# c #E6E6E6", -"$ c #D3D3D3", -"% c #C3C3C3", -"& c #909090", -"* c #494949", -"= c #48473D", -"- c #BAB8A6", -"; c #E2E2DF", -"> c #F1F1F0", -", c #EAE9E6", -"' c #F2F2EE", -") c #EBEAE5", -"! c #C1C0B5", -"~ c #57564A", -"{ c #525146", -"] c #A8A68F", -"^ c #BDBBA1", -"/ c #C0BEA3", -"( c #A3A18A", -"_ c #6D6C5C", -": c #7C7C72", -"< c #4C4C49", -"[ c #45453F", -"} c #44433A", -"| c #6F6F67", -"1 c #C6C5B9", -"2 c #B6B59B", -"3 c #6D6C5D", -"4 c #B3B19B", -"5 c #A7A68E", -"6 c #908F7A", -"7 c #AAA993", -"8 c #CCCBB5", -"9 c #D0CEBA", -"0 c #D5D3C1", -"a c #AEADA3", -"b c #94938A", -"c c #454442", -"d c #232321", -"e c #353431", -"f c #292823", -"g c #1E1E1A", -"h c #535246", -"i c #ADAC93", -"j c #929189", -"k c #C2C1AF", -"l c #B1AF96", -"m c #ACAA92", -"n c #93927D", -"o c #080808", -"p c #D1D0C1", -"q c #D6D5C4", -"r c #DFDED1", -"s c #CECDC0", -"t c #ACACA6", -"u c #908F8A", -"v c #7E7D77", -"w c #5C5C55", -"x c #47463E", -"y c #656456", -"z c #777665", -"A c #807E6F", -"B c #BEBDA7", -"C c #B5B39A", -"D c #A19F88", -"E c #D9D8CC", -"F c #F6F5F2", -"G c #DBDAD1", -"H c #DAD9CE", -"I c #E5E4D9", -"J c #D0CFC3", -"K c #D3D3C9", -"L c #CAC9BC", -"M c #B7B6A6", -"N c #B8B6A1", -"O c #B0AF96", -"P c #B9B89D", -"Q c #B9B79D", -"R c #B8B69C", -"S c #C4C2A9", -"T c #AFAD97", -"U c #8B8976", -"V c #AAA998", -"W c #B6B6B2", -"X c #F9F9F7", -"Y c #FAFAF8", -"Z c #F4F4F0", -"` c #E2E1DA", -" . c #D9D9CE", -".. c #DBDACF", -"+. c #D3D1BE", -"@. c #C5C4AC", -"#. c #D6D5C3", -"$. c #CDCCBF", -"%. c #BBBAAD", -"&. c #7C7A69", -"*. c #717060", -"=. c #131313", -"-. c #999882", -";. c #AFAE9D", -">. c #C3C3BE", -",. c #DEDEDC", -"'. c #E9E9E8", -"). c #FBFBFA", -"!. c #FDFDFC", -"~. c #FDFDFD", -"{. c #FCFBFA", -"]. c #F2F2EF", -"^. c #EAE9E3", -"/. c #C0BFB1", -"(. c #959484", -"_. c #787766", -":. c #6E6D5D", -"<. c #5B5B4D", -"[. c #5D5C4F", -"}. c #A3A293", -"|. c #B8B7A6", -"1. c #D8D7D0", -"2. c #DBDBD4", -"3. c #D3D2CA", -"4. c #C8C8C3", -"5. c #C6C5BD", -"6. c #BDBCAD", -"7. c #BAB8A8", -"8. c #9F9E8B", -"9. c #8E8C78", -"0. c #8C8B77", -"a. c #7A7968", -"b. c #6C6B5D", -"c. c #4E4D45", -"d. c #424242", -"e. c #7B7B73", -"f. c #9F9F96", -"g. c #D2D1C7", -"h. c #DCDBD2", -"i. c #CCCBBE", -"j. c #D1D0C2", -"k. c #C4C3B6", -"l. c #9A9883", -"m. c #807F6D", -"n. c #7D7C6B", -"o. c #6A695E", -"p. c #40403E", -"q. c #37372D", -"r. c #0F0F0F", -"s. c #383734", -"t. c #787875", -"u. c #999893", -"v. c #8A897E", -"w. c #B3B2A4", -"x. c #AAAA9E", -"y. c #878673", -"z. c #8F8D79", -"A. c #626155", -"B. c #545451", -"C. c #31312E", -"D. c #2B2B23", -"E. c #71715D", -"F. c #57574B", -"G. c #42423A", -"H. c #262620", -"I. c #212121", -"J. c #1B1B1B", -"K. c #242424", -"L. c #161613", -"M. c #2A2A22", -"N. c #303027", -"O. c #3F3F34", -"P. c #7A7A65", -"Q. c #5B5B51", -"R. c #858576", -"S. c #76766B", -"T. c #98988E", -"U. c #75756B", -"V. c #515146", -"W. c #7F7F74", -"X. c #6A6A58", -"Y. c #404035", -"Z. c #626251", -"`. c #545445", -" + c #3E3E33", -".+ c #555546", -"++ c #34342B", -"@+ c #515143", -"#+ c #85856E", -"$+ c #5D5D54", -"%+ c #919182", -"&+ c #828278", -"*+ c #AAAAA3", -"=+ c #7A7A71", -"-+ c #4E4E45", -";+ c #8A8A80", -">+ c #7C7C6D", -",+ c #424237", -"'+ c #606052", -")+ c #5A5A4A", -"!+ c #3C3C32", -"~+ c #4E4E41", -"{+ c #35352C", -"]+ c #ACAC9C", -"^+ c #85857B", -"/+ c #BBBBB3", -"(+ c #A3A39A", -"_+ c #54544B", -":+ c #93938A", -"<+ c #919185", -"[+ c #686856", -"}+ c #414136", -"|+ c #434337", -"1+ c #A4A493", -"2+ c #C1C1B6", -"3+ c #B1B1A2", -"4+ c #6B6B5F", -"5+ c #9D9D8B", -"6+ c #848470", -"7+ c #71715E", -"8+ c #A5A594", -"9+ c #C2C2B7", -"0+ c #7B7B65", -"a+ c #5F5F4F", -"b+ c #666654", -"c+ c #49493C", -"d+ c #575748", -"e+ c #57574A", -"f+ c #7D7D6D", -"g+ c #767669", -"h+ c #B3B3A8", -"i+ c #A1A194", -"j+ c #6D6D61", -"k+ c #B3B3A5", -"l+ c #696957", -"m+ c #414135", -"n+ c #565647", -"o+ c #444438", -"p+ c #595951", -"q+ c #585849", -"r+ c #4E4E40", -"s+ c #747467", -"t+ c #616153", -" . . . . . . ", -" . + @ # $ % & * . . ", -" . . . = - ; > , ' ) ! ~ { . . . ", -" . ] ^ / ( _ : < [ } | 1 2 3 4 5 6 . ", -" . 7 8 9 0 a b c d e f g h i j k l m n . ", -" o p 8 q r s t u v w x y z A B C 2 C D . ", -" . E F G H I J K L M N O D P Q R S T U . ", -" . V W X Y Z ` ...0 +.S / @.#.$.%.&.*.. ", -" =.-.;.>.,.'.).!.~.{.X ].^.G /.(._.:.<.. ", -" . [.n }.|.1.2.3.4.5.6.7.8.9.0.9.a.b.c. ", -" . d.e.f.g.h.i.j.k.l l l l.m.n.o.p.. ", -" . q.r.s.t.u.v.w.x.( y.z.A.B.C.. D.. ", -" . E.F.G.H.I.J.. K.. . . . L.M.N.O.. ", -" . P.Q.R.S.T.U.V.W.X.Y.Z.`. +.+++@+. ", -" . #+$+%+&+*+=+-+;+>+,+'+)+!+~+{+`.. ", -" . #+Q.]+^+/+(+_+:+<+,+'+[+}+X.|+X.. ", -" . #+Q.1+^+2+3+4+3+5+`.6+7+|+X.|+X.. ", -" . #+Q.8+^+9+3+4+3+5+`.6+7+|+X.|+X.. ", -" . #+Q.5+^+2+3+4+3+5+`.6+7+|+X.|+X.. ", -" . 0+Q.1+^+2+3+4+3+5+`.6+7+|+X.|+a+. ", -" . b+Q.1+&+2+3+4+3+5+`.6+7+|+X.c+d+. ", -" . e+f+g+h+i+j+k+5+`.6+l+m+n+o+. . ", -" . . . p+q+r+s+t+~+c+c+. . . ", -" . . . . . . . . . . "}; diff --git a/xemacs-packages/gnus/etc/gnus/describe-group.pbm b/xemacs-packages/gnus/etc/gnus/describe-group.pbm deleted file mode 100644 index de7bf1104317ae6686562b822f04b5feb493f14c..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 81 zcmWGA;W9E&Ff!o^4Gq;;)D;ryy6=@js0hO(4u;S`7L5fAq5%xMek!;IFf=(pMM47@ f_PkIC4Pl&>$pF-q_oyp0F!cZL^`Rl5pFC6m%K{qn diff --git a/xemacs-packages/gnus/etc/gnus/describe-group.xpm b/xemacs-packages/gnus/etc/gnus/describe-group.xpm deleted file mode 100644 index b4a6f42a..00000000 --- a/xemacs-packages/gnus/etc/gnus/describe-group.xpm +++ /dev/null @@ -1,32 +0,0 @@ -/* XPM */ -static char * describe_group_xpm[] = { -"24 24 5 1", -". c None", -" c #000000000000", -"o c #FFFFF5F5ACAC", -"+ c #E1E1E0E0E0E0", -"@ c #C7C7C6C6C6C6", -"........................", -"........................", -".................oooo...", -" .. .. .. .. .. oo oo o.", -"..............oooooooooo", -".............ooooooooooo", -" .. .. .. .. oo oo oo oo", -"............oooooooooooo", -"............oooooooooooo", -" .. .. .. .. oo oo oo oo", -"............oooooooooooo", -"............oooooooooooo", -" .. .. .. .. oo oo oo oo", -"............oooooooooooo", -"..... ...oooooooooooo", -" .. ++ .. .o oo oo oo", -"... @@@+ ....ooooooooo", -"... @ ....oooooooo.", -" . . .. .. .. ..", -". ..............", -" ................", -" .. .. .. .. .. ..", -" ..................", -" ...................."}; diff --git a/xemacs-packages/gnus/etc/gnus/describe.xpm b/xemacs-packages/gnus/etc/gnus/describe.xpm deleted file mode 100644 index 38062d53..00000000 --- a/xemacs-packages/gnus/etc/gnus/describe.xpm +++ /dev/null @@ -1,95 +0,0 @@ -/* XPM */ -static char * stock_properties_xpm[] = { -"24 24 68 1", -" c None", -". c #000000", -"+ c #74716E", -"@ c #C9C4BD", -"# c #DFDAD2", -"$ c #F4EFE5", -"% c #F2ECE1", -"& c #FFFFFF", -"* c #4C4B48", -"= c #EEE5D4", -"- c #ECE2CF", -"; c #EADFC9", -"> c #F9F9F9", -", c #E2D2B1", -"' c #F4F4F4", -") c #EEEEEE", -"! c #959595", -"~ c #F5F5F5", -"{ c #F6F6F6", -"] c #D9D9D9", -"^ c #C7B99C", -"/ c #E9E9E9", -"( c #787878", -"_ c #E1E1E1", -": c #E2E2E2", -"< c #C8C8C8", -"[ c #877E69", -"} c #9A8F78", -"| c #DEDEDE", -"1 c #E3E3E3", -"2 c #929292", -"3 c #AFA389", -"4 c #ACACAC", -"5 c #A2A2A2", -"6 c #E4E4E4", -"7 c #BCBCBC", -"8 c #939393", -"9 c #EDEDED", -"0 c #EFEFEF", -"a c #F0F0F0", -"b c #E5E5E5", -"c c #E7E7E7", -"d c #E8E8E8", -"e c #EAEAEA", -"f c #EBEBEB", -"g c #BEBEBE", -"h c #F1F1F1", -"i c #DFDFDF", -"j c #F3F3F3", -"k c #E0E0E0", -"l c #ABABAB", -"m c #AEAEAE", -"n c #AFAFAF", -"o c #ADADAD", -"p c #B0B0B0", -"q c #B1B1B1", -"r c #F7F7F7", -"s c #B3B3B3", -"t c #F8F8F8", -"u c #B4B4B4", -"v c #B5B5B5", -"w c #B6B6B6", -"x c #FAFAFA", -"y c #FBFBFB", -"z c #DCDCDC", -"A c #DDDDDD", -"B c #E6E6E6", -"C c #969696", -" ", -" ", -" ", -" ......... ", -" .+@#$%.&&. ", -" *=---;.&>. ", -" .......;.,,,,.'). ", -" !~~{].;.^.,^^./(.. ", -" .~_:<.;.[.^.}..|].. ", -" .~:1.;.2.[.3.4...5. ", -" .{16..7/8.[.49)0a|. ", -" .{6bcd/ef8.g9)0ahi. ", -" .{bcd/ef9ef9)0ahjk. ", -" .{cllefmnomnppqj'_. ", -" .rd/ef9)09)0ahj'~:. ", -" .r/4o9)ppnppqss~{1. ", -" .tef9)0ah0ahj'~{rb. ", -" .>9npahssqssuvw>xc. ", -" .>)0ahj'~j'~{r>xyd. ", -" .nzA|ik_:k_:1bBcdC. ", -" ................. ", -" ", -" ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/diropen.xpm b/xemacs-packages/gnus/etc/gnus/diropen.xpm deleted file mode 100644 index 6937b99a..00000000 --- a/xemacs-packages/gnus/etc/gnus/diropen.xpm +++ /dev/null @@ -1,44 +0,0 @@ -/* XPM */ -static char * diropen_xpm[] = { -"19 24 17 1", -" c None", -". c #000100", -"+ c #C6C9A6", -"@ c #D0D3AF", -"# c #93997C", -"$ c #E6E7D0", -"% c #BEC19E", -"& c #B4B895", -"* c #A7AA88", -"= c #6B6D59", -"- c #4A4E40", -"; c #7C8166", -"> c #898E72", -", c #3C4032", -"' c #575845", -") c #34332C", -"! c #24231D", -" ............... ", -" .+@@@@@@@@@@@@@#. ", -".$@@@@@@@@@@@@@@@#.", -".++++%%%%%%%%%&&&*.", -".&&&&&&&&&&******#.", -".*%+++%%%%%%%%%&=#.", -".*+***********##-#.", -".*+****;===;####-#.", -".*+****=*****###-#.", -".*+****;*****###-#.", -".*+****########>-#.", -".*&######>>>>>>>,>.", -".*#-------------'>)", -".*&&&&&&&&&&&&&*#>)", -".*&************#'>)", -".*&***********##,>)", -".*&****====;###>,>)", -".#&****=**#**##>,;)", -".#&****>****###>,;)", -".#&****########>,;)", -".##''''''''''''',;)", -".#>==============;)", -".''''''''''''''''-!", -" ................. "}; diff --git a/xemacs-packages/gnus/etc/gnus/disconnect.xpm b/xemacs-packages/gnus/etc/gnus/disconnect.xpm deleted file mode 100644 index e08b2825..00000000 --- a/xemacs-packages/gnus/etc/gnus/disconnect.xpm +++ /dev/null @@ -1,69 +0,0 @@ -/* XPM */ -static char * stock_disconnect_xpm[] = { -"24 24 42 1", -" c None", -". c #000000", -"+ c #989389", -"@ c #807D74", -"# c #C6C2BA", -"$ c #43423C", -"% c #B7B3AA", -"& c #C4C2BD", -"* c #EAE8E3", -"= c #E2E1DD", -"- c #F0EFEC", -"; c #AAA7A0", -"> c #C5D2C8", -", c #E9EEEA", -"' c #F0EEEB", -") c #F2F0ED", -"! c #EBEAE6", -"~ c #8A857B", -"{ c #ECEBE8", -"] c #EEECEA", -"^ c #78756B", -"/ c #BEBBB5", -"( c #B3B1AA", -"_ c #7D786E", -": c #E1DFDB", -"< c #D1D0CC", -"[ c #010101", -"} c #8C8981", -"| c #A6A29B", -"1 c #726D63", -"2 c #CECAC3", -"3 c #A7A49E", -"4 c #0F0F0D", -"5 c #F0F3F1", -"6 c #272622", -"7 c #8B877E", -"8 c #706C62", -"9 c #B1ADA4", -"0 c #6C685E", -"a c #97938A", -"b c #646056", -"c c #8B877D", -" ", -" ", -" ", -" ", -" ", -" ", -" .. ..", -" ..+@. .#@", -" $%&*@.... .*@", -" .=-;*@.>>,. .'@", -".....@=-;*@.... .'@", -"******)!~{@. .]@", -"@@@@^^/(_:^. .<@", -"....[^}|12^.... .3@", -" 4}|12^.>>5. .3@", -" 67890.... .a@", -" 44+b. .c@", -" 44 4.", -" ", -" ", -" ", -" ", -" ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/exit-gnus.pbm b/xemacs-packages/gnus/etc/gnus/exit-gnus.pbm deleted file mode 100644 index 32ad0e0ebe9673bfbefa86e1d3e9132e2a516521..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 81 zcmWGA;W9E&Ff!p{aAaUmZV)JR;FJF$8XCf2$H01(f$!}B!O#GvEex(DA#7?4p`w9W lObjj}j(QCZqN0I33=E;6uK5id<)wo5ySzj1hB7cP008Y?6KDVc diff --git a/xemacs-packages/gnus/etc/gnus/exit-gnus.xpm b/xemacs-packages/gnus/etc/gnus/exit-gnus.xpm deleted file mode 100644 index 534f3c2f..00000000 --- a/xemacs-packages/gnus/etc/gnus/exit-gnus.xpm +++ /dev/null @@ -1,33 +0,0 @@ -/* XPM */ -static char * exit_gnus_xpm[] = { -"24 24 6 1", -" c None", -". c #8686ADAD7D7D", -"X c #919187876969", -"o c #C2C2B9B99C9C", -"O c #A8A8F0F0ECEC", -"+ c #EFEFEFEFEFEF", -" ", -" .... . ", -" .. .. . ", -" ............. ", -" . . . .... ", -" ............. ", -" .............. .. ", -" . . .......... . ", -" .XXXX... .. ", -" o.XXX. . .. ", -" oo.X. .. ... ", -" ooX. . ... ", -" oXo. .. ", -" ooX . . ", -" ooX ", -"OOOOoXXOOOOOOOOOOOOOOOOO", -"OOOoXoXOOOOOOOOOOOOOOOOO", -"OOOooXXOOOO+OOOOOOOOOOOO", -"O+OoooXOO+OOO+OO+OOO+OOO", -"OXXoXoXoXOO++O++OO++OO+O", -"XXXXXXXXXXXX+OOOOOOOOOOO", -"XXXXXXXXXXXXXX+O++OO++OO", -"XXXXXXXXXXXXXXXXOOOOOOOO", -"O++O++++O+OO++OOOO++OOO+"}; diff --git a/xemacs-packages/gnus/etc/gnus/exit-summ.pbm b/xemacs-packages/gnus/etc/gnus/exit-summ.pbm deleted file mode 100644 index d0192310607c6f40033068a55cc5c4c7c244f866..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 81 zcmWGA;W9E&Ff!p1aAaWsgNFYPm{|`nF+LD*Ji@^FfRXXQB*q7fKoQ;t!j4CP;tY%j W8W@3U9GHw6L_=L5x+ZZdKo|ff#}ZBe diff --git a/xemacs-packages/gnus/etc/gnus/exit-summ.xpm b/xemacs-packages/gnus/etc/gnus/exit-summ.xpm deleted file mode 100644 index 5234ccb1..00000000 --- a/xemacs-packages/gnus/etc/gnus/exit-summ.xpm +++ /dev/null @@ -1,30 +0,0 @@ -/* XPM */ -static char * exit_summ_xpm[] = { -"24 24 3 1", -". c None", -" c #000000000000", -"X c #E1E1E0E0E0E0", -" .. .. .. .. .. .. .. ..", -"........................", -"........................", -" .. .. .. ..", -"...... XXXX .....", -"...... XXXXXXX .....", -" .. .. XX XX XX .. ..", -"...... XXXXXXXX .....", -"...... XXXXXXX .....", -" .. .. X XX .. ..", -"...... XXXX .....", -"...... XXXX .....", -" .. .. X XXXXX .. ..", -"...... XXXXXXX .....", -"...... XXXXX XX .....", -" .. .. X XXXXX .. ..", -"...... XXXXX .....", -"...... X .....", -" .. . . .. ..", -"........................", -"........................", -" .. .. .. .. .. .. .. ..", -"........................", -"........................"}; diff --git a/xemacs-packages/gnus/etc/gnus/exit.xpm b/xemacs-packages/gnus/etc/gnus/exit.xpm deleted file mode 100644 index 7f9daf14..00000000 --- a/xemacs-packages/gnus/etc/gnus/exit.xpm +++ /dev/null @@ -1,167 +0,0 @@ -/* XPM */ -static char * stock_exit_xpm[] = { -"24 24 140 2", -" c None", -". c #000000", -"+ c #D6D6D4", -"@ c #BDBDBC", -"# c #A8A8A4", -"$ c #92928F", -"% c #727370", -"& c #61615E", -"* c #20201F", -"= c #F1F1EF", -"- c #E6E6E4", -"; c #DADAD7", -"> c #CFCFCD", -", c #C4C4C1", -"' c #A8A8A5", -") c #767674", -"! c #777774", -"~ c #1E1E1D", -"{ c #B9B9B7", -"] c #AEAEAC", -"^ c #8F8F8D", -"/ c #262626", -"( c #414140", -"_ c #E9836C", -": c #DEDEDC", -"< c #C5C5C2", -"[ c #636362", -"} c #040504", -"| c #040604", -"1 c #050705", -"2 c #E87B62", -"3 c #E67056", -"4 c #D5D5D3", -"5 c #DBDBD8", -"6 c #D0D0CE", -"7 c #080A07", -"8 c #0A0C09", -"9 c #0A0D09", -"0 c #0B0E0A", -"a c #F0B0A1", -"b c #EB8D77", -"c c #DF421E", -"d c #E97E66", -"e c #CBCBC8", -"f c #0C0F0B", -"g c #0F130D", -"h c #10140E", -"i c #11150F", -"j c #EFA392", -"k c #BFBFBD", -"l c #5D5D5C", -"m c #10150F", -"n c #141912", -"o c #161C14", -"p c #171D15", -"q c #B7B7B4", -"r c #0C0C0C", -"s c #192017", -"t c #1C2319", -"u c #1D241A", -"v c #CD8484", -"w c #990000", -"x c #701616", -"y c #A6A6A5", -"z c #181E16", -"A c #1E261B", -"B c #212A1E", -"C c #222B1F", -"D c #4F0000", -"E c #AEAEAB", -"F c #1D261B", -"G c #242E21", -"H c #273224", -"I c #283325", -"J c #580000", -"K c #B5B5B3", -"L c #293426", -"M c #2D3929", -"N c #2E3A2A", -"O c #7C4343", -"P c #6A0000", -"Q c #720000", -"R c #BDBDBB", -"S c #232C20", -"T c #2A3526", -"U c #303C2B", -"V c #33402E", -"W c #C5C5C3", -"X c #1E261C", -"Y c #303D2C", -"Z c #374532", -"` c #394834", -" . c #500000", -".. c #CDCDCB", -"+. c #1B2319", -"@. c #253022", -"#. c #303E2D", -"$. c #394934", -"%. c #3D4E38", -"&. c #9D9D9B", -"*. c #565655", -"=. c #2C3828", -"-. c #40503A", -";. c #43553E", -">. c #BABAB7", -",. c #777776", -"'. c #323830", -"). c #232C1F", -"!. c #313E2D", -"~. c #3B4A36", -"{. c #43553D", -"]. c #485B42", -"^. c #4A5E44", -"/. c #F0F0EE", -"(. c #E5E5E3", -"_. c #C6C6C3", -":. c #ACACAB", -"<. c #8B8B8A", -"[. c #32392F", -"}. c #2C3728", -"|. c #3F503A", -"1. c #465840", -"2. c #4B5E44", -"3. c #4E6347", -"4. c #506549", -"5. c #DADAD8", -"6. c #7A7D78", -"7. c #333C30", -"8. c #475A41", -"9. c #4F6348", -"0. c #53694C", -"a. c #566C4E", -"b. c #576D4F", -"c. c #91968F", -"d. c #3B4736", -"e. c #42543C", -"f. c #51674A", -"g. c #586F50", -"h. c #5B7353", -"i. c #5C7454", -" ", -" . . . . . . . . . . . . . . . . ", -" . + @ # $ % & & & * . . . . . . ", -" . = - ; > , ' ) ! ~ . . . . . . ", -" . . = - ; > , { ] ^ / . . . . . . ", -" . . . = - ; > , { { { ( . . . . . . ", -" . _ . : - ; > < { { { [ } | 1 1 1 . ", -". . . . . . 2 3 . 4 5 6 < { { { [ 7 8 9 0 0 . ", -". a 2 2 2 2 b c d . e 6 < { { { [ f g h i i . ", -". j c c c c c c c 3 . k < { l { [ m n o p p . ", -". j c c c c c c c c 3 . q { l r [ n s t u u . ", -". v w w w w w w w w w x . y r { [ z A B C C . ", -". v w w w w w w w w D . E { { { [ F G H I I . ", -". v w w w w w w w J . K < { { { [ C L M N N . ", -". O P P P P Q w J . R 6 < { { { [ S T U V V . ", -". . . . . . Q J . W 5 6 < { { { [ X H Y Z ` . ", -" . .. ..- 5 6 < { { { [ +.@.#.$.%.. ", -" . . . = - 5 6 < { ] &.*.B =.Z -.;.. ", -" . . = - 5 6 >.&.,.'.).!.~.{.].^.. ", -" . /.(._.:.<.[.}.Z |.1.2.3.4.4.. ", -" . 5.k 6.7.Z -.8.9.0.a.a.b.b.b.. ", -" . c.d.e.^.f.g.h.i.i.i.i.i.i.i.. ", -" . . . . . . . . . . . . . . . . ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/followup.pbm b/xemacs-packages/gnus/etc/gnus/followup.pbm deleted file mode 100644 index 61be114096b3eb182aa962728a44e8bc45bfb176..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 81 zcmWGA;W9E&Ff!p1WE5avU}69QK8C*v$E&(A-7Zex;1h_N| h1Y86h8aNzSBovqo0vH_x7#V c #F5F5F5", -", c #F4F4F4", -"' c #E3E3E3", -") c #EEEEEE", -"! c #4F4F4F", -"~ c #F3F3F3", -"{ c #F2F2F2", -"] c #F1F1F1", -"^ c #F0F0F0", -"/ c #EFEFEF", -"( c #EDEDED", -"_ c #AEAEAE", -": c #E4E4E4", -"< c #434343", -"[ c #ACACAC", -"} c #C8C8C8", -"| c #A0A0A0", -"1 c #D4D4D4", -"2 c #ECECEC", -"3 c #959595", -"4 c #3E3E3E", -"5 c #4D4D4D", -"6 c #818181", -"7 c #C6C6C6", -"8 c #6A6A6A", -"9 c #636363", -"0 c #B9B9B9", -"a c #737373", -"b c #7C7C7C", -"c c #5B88B2", -"d c #9EB8D1", -"e c #5080AD", -"f c #B5C9DC", -"g c #AFC5DA", -"h c #B2C7DB", -"i c #B6CADD", -"j c #A4BDD5", -"k c #9CB7D1", -"l c #080D11", -"m c #BCBCBC", -"n c #9BB6D0", -"o c #A0BAD3", -"p c #9AB5CF", -"q c #97B3CE", -"r c #5F8BB4", -"s c #91B0CC", -"t c #95B2CE", -"u c #4C79A3", -"v c #49749C", -"w c #3F6588", -"x c #2A435B", -"y c #456F96", -"z c #375978", -" ", -" ", -" ", -" ................. ", -" .+@@@@#$%&*=-;>,'+. ", -" .)!@>,~{{]^^/)('!_. ", -" .@:<$~{{]^/))('![}. ", -" .@>:!&]^^/)(('<|1}. ", -" .@&>:<=^/)(2'!31:}. ", -" .@>>>:4>)(2'567::}. ", -" .@&>>:8<~2'!877>.}. ", -" .@>>:9@0!^!37a7>... ", -" .@&:9@>:1![7::b:.c. ", -" .@:a@>>>>:.......de. ", -" .@b@::::::.fghiiijkel ", -" .ammmmmmmm.nokknpokqr. ", -" ..........sdppnkkkotu.", -" .vwwwwwwwwx. ", -" .yzzzzzwwx. ", -" .......wx. ", -" .x. ", -" .. ", -" . ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/fuwo.pbm b/xemacs-packages/gnus/etc/gnus/fuwo.pbm deleted file mode 100644 index b81af10c3997ce1eb584a907505fcac6282cd795..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 81 zcmWGA;W9E&Ff!p1WE5afU}6A+Kvn?;76u0%0R|2R1_6+eW2y+l1qRkY0j?cP!X*qk dCJY6k0t#FV4y-H+tPBD`#MBVL7{bBm003Mb2}A$@ diff --git a/xemacs-packages/gnus/etc/gnus/fuwo.xpm b/xemacs-packages/gnus/etc/gnus/fuwo.xpm deleted file mode 100644 index 362cbc57..00000000 --- a/xemacs-packages/gnus/etc/gnus/fuwo.xpm +++ /dev/null @@ -1,31 +0,0 @@ -/* XPM */ -static char * fuwo_xpm[] = { -"24 24 4 1", -" c None", -". c #A5A5A5A59595", -"X c #C7C7C6C6C6C6", -"o c #E1E1E0E0E0E0", -" ", -" . ", -" .. . ", -" .. . ", -" .. . ", -" ... . . ", -" . . ..X. ", -" . . ..XXX. ", -" . .. ..XXXXXo. ", -" . . ...XXXXXXooo. ", -" . .X .o.XXXXXoooo. ", -" .XX .oo.XXXoooooo. ", -" .X .oo..XXooooooo. ", -" . .oo.XXooooooooo. ", -" . .o.XoooooooooooX.", -" . .XXoooooooooooo.", -" . .Xoooooooooooo. ", -" . .ooooooooooo. ", -" . ..oooooooooo. ", -" .. .ooooooo.. ", -" .oooooo. ", -" .ooo.. ", -" .oo. ", -" .. "}; diff --git a/xemacs-packages/gnus/etc/gnus/get-news.pbm b/xemacs-packages/gnus/etc/gnus/get-news.pbm deleted file mode 100644 index c0080716c4494d4ea6a56f29a9583152fdadb79a..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 81 zcmWGA;W9E&Ff!pP6%Aa)#K0)x*wB1}Q8cibQGqcuv~kf1#_+ c #F2F0EC", -", c #E1DFDC", -"' c #AFADAA", -") c #272726", -"! c #020202", -"~ c #3F3E3E", -"{ c #36302D", -"] c #181818", -"^ c #FBF8F5", -"/ c #FEFCF8", -"( c #FAF8F5", -"_ c #F5F4F1", -": c #F2F1ED", -"< c #F1EFEB", -"[ c #F1EEEB", -"} c #EAE9E6", -"| c #DAD8D4", -"1 c #100E0E", -"2 c #1F100E", -"3 c #AF3A1E", -"4 c #FBAB93", -"5 c #FAE9E3", -"6 c #F0EFEB", -"7 c #E9E8E5", -"8 c #EAE8E6", -"9 c #ECEAE8", -"0 c #EDEBE9", -"a c #EDEBE8", -"b c #EACFC6", -"c c #D5340A", -"d c #751904", -"e c #100806", -"f c #34160D", -"g c #AF3C20", -"h c #FCCCBD", -"i c #F7BEAD", -"j c #E67554", -"k c #DFDDDB", -"l c #DBD9D6", -"m c #D8D7D3", -"n c #DBDAD6", -"o c #E3E2DE", -"p c #ECEBE8", -"q c #E5572D", -"r c #E33A0B", -"s c #D4340A", -"t c #691504", -"u c #100504", -"v c #582C22", -"w c #0F0F0F", -"x c #FDD4C8", -"y c #F7BFAF", -"z c #E87554", -"A c #D5512B", -"B c #C68270", -"C c #BEBDBA", -"D c #A5A3A0", -"E c #9C9A95", -"F c #B9B7B2", -"G c #D7D6D2", -"H c #E7E5E2", -"I c #E79A85", -"J c #E53C0B", -"K c #E43C0B", -"L c #E23A0B", -"M c #C93009", -"N c #010000", -"O c #040100", -"P c #FAB19C", -"Q c #FACCBE", -"R c #EB8264", -"S c #D8532D", -"T c #C0340F", -"U c #932006", -"V c #141412", -"W c #857974", -"X c #DA370B", -"Y c #EC7C5B", -"Z c #E95B32", -"` c #DE380B", -" . c #9D2306", -".. c #626261", -"+. c #FEF1ED", -"@. c #F09479", -"#. c #DC532B", -"$. c #C0350F", -"%. c #942006", -"&. c #621404", -"*. c #E2522B", -"=. c #F2A690", -"-. c #E74E21", -";. c #E23B0B", -">. c #C99181", -",. c #454342", -"'. c #E5E4E2", -"). c #FCFBFA", -"!. c #E2D8D3", -"~. c #C34C2A", -"{. c #B02B07", -"]. c #9E2D12", -"^. c #EF8D71", -"/. c #F09B83", -"(. c #EADDD7", -"_. c #272724", -":. c #F0EEEC", -"<. c #F3F2EF", -"[. c #D7D6D3", -"}. c #BFBEBB", -"|. c #9E6153", -"1. c #3F0D02", -"2. c #F0B9A9", -"3. c #F6F5F4", -"4. c #E8E7E4", -"5. c #DAD8D5", -"6. c #585652", -"7. c #F6F4F0", -"8. c #DAD8D6", -"9. c #C2C1BE", -"0. c #989691", -"a. c #0A0A08", -"b. c #F6F4F2", -"c. c #F4F3F1", -"d. c #E4E3E0", -"e. c #D3D2CE", -"f. c #63625D", -"g. c #DCDAD8", -"h. c #C7C6C2", -"i. c #ABAAA5", -"j. c #0A0A0A", -"k. c #FAF8F6", -"l. c #EFEDEA", -"m. c #DDDCD8", -"n. c #C6C4C2", -"o. c #3E3E39", -"p. c #1B1B19", -"q. c #F0EEEA", -"r. c #E0DFDD", -"s. c #CCCBC9", -"t. c #C0BFBB", -"u. c #131311", -"v. c #676663", -"w. c #FCFAF8", -"x. c #D6D4D2", -"y. c #BCBAB7", -"z. c #3C3C3A", -"A. c #DEDCD9", -"B. c #7E4B3E", -"C. c #232323", -"D. c #CC9385", -"E. c #FAFAF7", -"F. c #E6E6E2", -"G. c #CDCCCA", -"H. c #B0B0AC", -"I. c #EDE3DF", -"J. c #E78468", -"K. c #DF5D3A", -"L. c #631909", -"M. c #282828", -"N. c #B46E5E", -"O. c #FCC3B2", -"P. c #F1A691", -"Q. c #DCD2CC", -"R. c #C8C6C3", -"S. c #7E7C78", -"T. c #E8AD9C", -"U. c #E96139", -"V. c #EB7452", -"W. c #EF8E72", -"X. c #EA8063", -"Y. c #9E2E13", -"Z. c #3F1811", -"`. c #121212", -" + c #6B433B", -".+ c #E0A191", -"++ c #FDD3C7", -"@+ c #F4AD98", -"#+ c #DE532B", -"$+ c #C83409", -"%+ c #B48274", -"&+ c #383534", -"*+ c #D6340A", -"=+ c #E43D0F", -"-+ c #E8582E", -";+ c #ED7957", -">+ c #F4B6A4", -",+ c #F4B09D", -"'+ c #F0E5E0", -")+ c #F4F3EF", -"!+ c #FDF8F6", -"~+ c #FBCEC1", -"{+ c #F28B6E", -"]+ c #E44E23", -"^+ c #D3370A", -"/+ c #BF2F09", -"(+ c #260800", -"_+ c #190F0B", -":+ c #D5350A", -"<+ c #E43D0C", -"[+ c #E74C1F", -"}+ c #EFBBAB", -"|+ c #F5F4F3", -"1+ c #F5F3F1", -"2+ c #EAB1A0", -"3+ c #DE4316", -"4+ c #C5310A", -"5+ c #591202", -"6+ c #0E0504", -"7+ c #C83009", -"8+ c #E0532B", -"9+ c #E7E6E3", -"0+ c #E7E6E2", -"a+ c #DDDCD9", -"b+ c #CFCECA", -"c+ c #C14724", -"d+ c #AE2907", -"e+ c #290800", -"f+ c #0F0705", -"g+ c #9B2205", -"h+ c #C1A89F", -"i+ c #D1D0CC", -"j+ c #CFCDCA", -"k+ c #C7C6C3", -"l+ c #BBBAB7", -"m+ c #B5B4B1", -"n+ c #A7A6A2", -"o+ c #66564F", -"p+ c #0B0908", -"q+ c #010100", -"r+ c #222221", -"s+ c #51504B", -"t+ c #5D5C57", -"u+ c #3B3B37", -" . . + @ # # $ % ", -" . . . . & # * = - ; > , ' ) ! ~ . . . . ", -". . { ] ^ / ( _ : > < [ } | . 1 . . ", -" . 2 3 4 5 6 - 7 8 9 0 0 a b c d e . ", -" . f g h i j k l m n o } p a q r s t u . . ", -" v w x y z A B C D E F G H I J K L M . N ", -" O P Q R S T U . . . . V W X Y Z K ` .. ", -" ..+.@.#.$.%.. . . &.*.=.-.;.>.! . ", -",.'.).!.~.{.. . . ].^./.(.n _.. ", -"@ :.<.[.}.|.. 1.2.3.4.5.6.. ", -"# 7.6 8.9.0.. a.b.c.d.e.f.. ", -"# > < g.h.i.. j.k.l.m.n.o.. ", -"p., q.r.s.t.u. v.w.9 x.y.. . ", -"z.' [ 7 A.[.B.. C.D.E.F.G.H.. . ", -" ) } 0 I.J.K.L.. M.N.O.P.Q.R.S.. . ", -" ! | T.U.V.W.X.Y.Z.a.`. +.+++@+#+$+%+. . ", -" &+. *+=+-+;+>+,+'+)+k.!+~+{+]+^+/+(+. . ", -" . _+d :+L <+[+}+|+l.1+|+2+3+^+4+5+. . . ", -" . 6+t 7+` 8+9+0+o a+[.b+c+d+e+. . . ", -" . f+. g+h+i+j+k+l+m+n+o+. . . . ", -" . . . p+. q+r+s+t+u+. . . . . . . ", -" . . . . . . . . . . . . ", -" ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/home.xpm b/xemacs-packages/gnus/etc/gnus/home.xpm deleted file mode 100644 index 57e8f9cc..00000000 --- a/xemacs-packages/gnus/etc/gnus/home.xpm +++ /dev/null @@ -1,128 +0,0 @@ -/* XPM */ -static char * home_xpm[] = { -"24 24 101 2", -" c None", -". c #000000", -"+ c #212121", -"@ c #2C2C2C", -"# c #C1665A", -"$ c #924B37", -"% c #2A2A2A", -"& c #333333", -"* c #343434", -"= c #242424", -"- c #944D3A", -"; c #A05443", -"> c #181818", -", c #474747", -"' c #555555", -") c #8D8D8D", -"! c #383838", -"~ c #191919", -"{ c #974F3C", -"] c #222222", -"^ c #313131", -"/ c #A1A1A1", -"( c #676767", -"_ c #ACACAC", -": c #BCBCBC", -"< c #585858", -"[ c #141414", -"} c #1C1C1C", -"| c #464646", -"1 c #666666", -"2 c #BABABA", -"3 c #7E7E7E", -"4 c #D2D2D2", -"5 c #FFFFFF", -"6 c #4F4F4F", -"7 c #262626", -"8 c #232323", -"9 c #505050", -"0 c #B2B2B2", -"a c #909090", -"b c #9A9A9A", -"c c #838383", -"d c #171717", -"e c #202020", -"f c #717171", -"g c #A6A6A6", -"h c #616161", -"i c #1D1D1D", -"j c #1F1F1F", -"k c #C4C4C4", -"l c #CACACA", -"m c #AEAEAE", -"n c #D1D1D1", -"o c #7C7C7C", -"p c #BFBFBF", -"q c #6C6C6C", -"r c #EEEEEE", -"s c #949494", -"t c #C7C7C7", -"u c #EBEBEB", -"v c #7D7D7D", -"w c #6E6E6E", -"x c #A9A9A9", -"y c #E99E8F", -"z c #DD806D", -"A c #9B5343", -"B c #CECECE", -"C c #626262", -"D c #858585", -"E c #ECA292", -"F c #D0533A", -"G c #934F3E", -"H c #6D6D6D", -"I c #ECA291", -"J c #CF543C", -"K c #371D16", -"L c #5D5D5D", -"M c #868686", -"N c #787878", -"O c #ECA696", -"P c #C95C49", -"Q c #E17C66", -"R c #924E3D", -"S c #888888", -"T c #A0A0A0", -"U c #3D1208", -"V c #D15137", -"W c #919191", -"X c #879981", -"Y c #82947C", -"Z c #8A9B85", -"` c #6E8467", -" . c #5D7555", -".. c #4C6042", -"+. c #3F4F37", -"@. c #303D2A", -"#. c #7F8F7A", -"$. c #64785E", -"%. c #44563E", -"&. c #657460", -"*. c #40503A", -" ", -" . . ", -" . . . . . + @ . ", -" . # $ . . % & * = . ", -" . - ; . > , ' ) ! ~ . ", -" . { . ] ^ / ( _ : < [ . ", -" . . } | 1 2 3 4 : 5 6 7 . ", -" . 8 9 0 a 4 b 5 : 5 : c d . ", -" . e f g 4 b 5 : 5 : 5 : 5 h i . ", -" . j k k l 5 m 5 2 5 2 5 : 5 n o } . ", -" . 8 m p p p p p p p p . . . . . a q = . ", -" . . . . r 5 5 5 5 5 5 5 . s t u . v . . . . ", -" . 4 5 . . . . . 5 . : 5 5 . w . ", -" . x 5 . y z A . 5 . B 5 5 . C . ", -" . D 5 . E F G . 5 . . . . . H . ", -" . . 5 . I J K . k s L L M N . . ", -" . . r . O P G . 5 5 5 5 5 2 . ", -" . 2 . Q # R . : : : : : S . ", -" . T U V # A . 5 5 5 5 5 W . ", -" . . . . . . . . . . . . . . . . . . . . . ", -" } X Y Z X ` ...+.@.. Y #.$.%.&.*.. ", -" . . . . . . . . . . . . . . . . . ", -" . . . ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/important.xpm b/xemacs-packages/gnus/etc/gnus/important.xpm deleted file mode 100644 index e972facf..00000000 --- a/xemacs-packages/gnus/etc/gnus/important.xpm +++ /dev/null @@ -1,32 +0,0 @@ -/* XPM */ -static char *magick[] = { -/* columns rows colors chars-per-pixel */ -"24 24 2 1", -"! c red", -"w c Gray75", -/* pixels */ -"wwwwwwwwwwwwwwwwwwwwwwww", -"wwwwwwwwwwwwwwwwwwwwwwww", -"wwwwwwwww!!!wwwwwwwwwwww", -"wwwwwwwww!!!wwwwwwwwwwww", -"wwwwwwww!!!!!wwwwwwwwwww", -"wwwwwwww!!!!!wwwwwwwwwww", -"wwwwwww!!!!!!!wwwwwwwwww", -"wwwwwww!!!!!!!wwwwwwwwww", -"wwwwwww!!!!!!!wwwwwwwwww", -"wwwwwww!!!!!!!wwwwwwwwww", -"wwwwwww!!!!!!!wwwwwwwwww", -"wwwwwww!!!!!!!wwwwwwwwww", -"wwwwwww!!!!!!!wwwwwwwwww", -"wwwwwwww!!!!!wwwwwwwwwww", -"wwwwwwww!!!!!wwwwwwwwwww", -"wwwwwwww!!!!!wwwwwwwwwww", -"wwwwwwwww!!!wwwwwwwwwwww", -"wwwwwwwwwwwwwwwwwwwwwwww", -"wwwwwwwww!!!wwwwwwwwwwww", -"wwwwwwww!!!!!wwwwwwwwwww", -"wwwwwwww!!!!!wwwwwwwwwww", -"wwwwwwwww!!!wwwwwwwwwwww", -"wwwwwwwwwwwwwwwwwwwwwwww", -"wwwwwwwwwwwwwwwwwwwwwwww" -}; diff --git a/xemacs-packages/gnus/etc/gnus/inbox.pbm b/xemacs-packages/gnus/etc/gnus/inbox.pbm deleted file mode 100644 index 2c93e3c74bb28af40b169e4154ee81a7cc06b8bf..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 81 zcmWGA;W9E&Ff!p{f55;Y!N9@7z|O?L(9Xc%4noYwA26~XU~6xXJl>GLEMcCA#0d_T f4-8Cy7?|oAnB))euz#>%{_ud|a|44N0|Wp7-h&gb diff --git a/xemacs-packages/gnus/etc/gnus/inbox.xpm b/xemacs-packages/gnus/etc/gnus/inbox.xpm deleted file mode 100644 index 5774e3ab..00000000 --- a/xemacs-packages/gnus/etc/gnus/inbox.xpm +++ /dev/null @@ -1,103 +0,0 @@ -/* XPM */ -static char * stock_inbox_xpm[] = { -"24 24 76 1", -" c None", -". c #000000", -"+ c #B5CADD", -"@ c #BFD1E1", -"# c #C3D4E3", -"$ c #C7D7E5", -"% c #B0C6DA", -"& c #6B94BB", -"* c #131E29", -"= c #739ABF", -"- c #7EA2C4", -"; c #9AB6D0", -"> c #E4EBF2", -", c #DDE6EF", -"' c #8CACCA", -") c #5C8AB4", -"! c #090F15", -"~ c #B1C7DB", -"{ c #D0DDEA", -"] c #D9E3ED", -"^ c #88A9C8", -"/ c #4D7CA7", -"( c #030405", -"_ c #41688D", -": c #32506C", -"< c #C4D5E4", -"[ c #A5BED5", -"} c #456F97", -"| c #3B5F81", -"1 c #C8D8E6", -"2 c #9CB8D2", -"3 c #395B7B", -"4 c #C6D6E4", -"5 c #BBCEDF", -"6 c #3D6183", -"7 c #B6CBDE", -"8 c #426A90", -"9 c #E2C6A9", -"0 c #E5CDB4", -"a c #D5AA7F", -"b c #9D6733", -"c c #CB9967", -"d c #ADC4D9", -"e c #B99877", -"f c #CFBAA4", -"g c #9A7149", -"h c #CDA378", -"i c #D2A87E", -"j c #608DB6", -"k c #AA7B4B", -"l c #C2A588", -"m c #996633", -"n c #BB9978", -"o c #C3976B", -"p c #D2A980", -"q c #D1A77D", -"r c #E0C4A8", -"s c #C9B097", -"t c #D7B38E", -"u c #DAC2A9", -"v c #BD9063", -"w c #CEA57C", -"x c #E5CFBB", -"y c #393633", -"z c #E0C8B1", -"A c #C9A480", -"B c #D1A87E", -"C c #D0A67B", -"D c #E1CAB4", -"E c #52504D", -"F c #D8C6B5", -"G c #CBA988", -"H c #CCAF93", -"I c #D2B496", -"J c #A67D51", -"K c #E2CFBD", -" ...... ", -" .+@#$%&*. ", -" .=-;$>,')! ", -" ...=~{]^/( ", -" .=+#$_:. ", -" .<[@}|. ", -" .12@}3. ", -" ....425}6.... ", -" .=2527}8}:. ", -" ..9.=227}}:. ", -" ..0abb.=2~}:.. ", -" ..0abbbbc.=d:.ef.. ", -".0abbbbghii.j.kkklf.. ", -".mnabgopqqqi.iokkkkef. ", -".mmmnrooqiqqqiiiokkkks. ", -".mmmmmnrooqiqqqiiiokkl. ", -" ..mmmmmnrooqiqqiiituf. ", -" ..mmmmmnrvwiqqtxxy. ", -" ..mmmmmzABCDxE.. ", -" ...mmmFGHIE.. ", -" ...mJK... ", -" ..... ", -" ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/index.xpm b/xemacs-packages/gnus/etc/gnus/index.xpm deleted file mode 100644 index 7e1de121..00000000 --- a/xemacs-packages/gnus/etc/gnus/index.xpm +++ /dev/null @@ -1,201 +0,0 @@ -/* XPM */ -static char * index_xpm[] = { -"24 24 174 2", -" c None", -". c #000000", -"+ c #FDFDFD", -"@ c #F5F5F5", -"# c #F6F6F6", -"$ c #D0D0D0", -"% c #C1C1C1", -"& c #C3C3C3", -"* c #C6C6C6", -"= c #C8C8C8", -"- c #8D8D8D", -"; c #CACACA", -"> c #919191", -", c #EFEFEF", -"' c #878787", -") c #8A8A8A", -"! c #5C5C5C", -"~ c #F8F8F8", -"{ c #EAEAEA", -"] c #CCCCCC", -"^ c #CECECE", -"/ c #979797", -"( c #CDCDCD", -"_ c #A1A1A1", -": c #090600", -"< c #A3A3A3", -"[ c #C5C5C5", -"} c #C4C4C4", -"| c #D1D1D1", -"1 c #D2D2D1", -"2 c #D2D2D2", -"3 c #9A9A9A", -"4 c #E8E8E8", -"5 c #949494", -"6 c #939393", -"7 c #574F4F", -"8 c #FDFDFC", -"9 c #777777", -"0 c #7E7E7E", -"a c #9D9D9D", -"b c #6B6B6B", -"c c #F1F1F1", -"d c #ECECEC", -"e c #CFCFCF", -"f c #575050", -"g c #FDFAF8", -"h c #A5A5A5", -"i c #B9B9B9", -"j c #EEEEEE", -"k c #EDEDED", -"l c #D5D5D5", -"m c #BABABA", -"n c #6D6767", -"o c #F9F1EA", -"p c #9E9E9E", -"q c #B5B5B5", -"r c #D9D9D9", -"s c #D7D7D7", -"t c #BCBCBC", -"u c #625C5B", -"v c #F9EEE4", -"w c #4F4D4A", -"x c #646464", -"y c #747474", -"z c #D6D6D5", -"A c #DFDFDF", -"B c #A0A0A0", -"C c #615C5B", -"D c #F9F0E4", -"E c #746C67", -"F c #FEFDFC", -"G c #FFFEFD", -"H c #131210", -"I c #636363", -"J c #7C7C7C", -"K c #F3F2F2", -"L c #98948F", -"M c #F9EFE3", -"N c #A09489", -"O c #FEFDFD", -"P c #766D68", -"Q c #736961", -"R c #A3A3A2", -"S c #A6A6A6", -"T c #DBDBDB", -"U c #C7C7C7", -"V c #E8E5E2", -"W c #97938E", -"X c #F6E9D8", -"Y c #84817A", -"Z c #FBF3EA", -"` c #908C86", -" . c #F1EDE7", -".. c #7B7975", -"+. c #878786", -"@. c #070000", -"#. c #FAFAFA", -"$. c #DDDDDD", -"%. c #E2DFDC", -"&. c #A8A199", -"*. c #F0E0CE", -"=. c #C8BFB4", -"-. c #D5CCBF", -";. c #DFD7CD", -">. c #DAD3C9", -",. c #DDCFC4", -"'. c #928C84", -"). c #A8A8A8", -"!. c #959595", -"~. c #040000", -"{. c #D9D5D2", -"]. c #D9CABB", -"^. c #D7C8B8", -"/. c #DECFBF", -"(. c #D8C9B9", -"_. c #E3D3C2", -":. c #C9BBAC", -"<. c #D9CEC2", -"[. c #7F766D", -"}. c #909090", -"|. c #D3D3D3", -"1. c #060100", -"2. c #C0BDBA", -"3. c #8C8782", -"4. c #C2B5A7", -"5. c #BFB4A6", -"6. c #B8AB9D", -"7. c #BAAD9E", -"8. c #BEB0A2", -"9. c #948A7F", -"0. c #716860", -"a. c #E2E2E2", -"b. c #A9A9A8", -"c. c #332C2B", -"d. c #5D5954", -"e. c #79736C", -"f. c #958C80", -"g. c #8D8379", -"h. c #988D82", -"i. c #706760", -"j. c #787878", -"k. c #E4E4E4", -"l. c #C2C2C2", -"m. c #201A1A", -"n. c #57514F", -"o. c #625C59", -"p. c #625A53", -"q. c #6B625A", -"r. c #585251", -"s. c #696764", -"t. c #080000", -"u. c #989898", -"v. c #B0B0B0", -"w. c #AFAFAF", -"x. c #999999", -"y. c #9D9897", -"z. c #050000", -"A. c #0C0303", -"B. c #080100", -"C. c #030000", -"D. c #282523", -"E. c #5A5A5A", -"F. c #868686", -"G. c #ECE4E2", -"H. c #DED7D5", -"I. c #D8D1D0", -"J. c #E0DBD7", -"K. c #E9E6E3", -"L. c #FCFBFA", -"M. c #030500", -"N. c #0B0505", -"O. c #14100F", -"P. c #090806", -"Q. c #000100", -" ", -" . . . . . . . . . . . . . . . . . . . . ", -" . + @ @ @ @ @ @ @ # # # # # # # # # $ . ", -" . @ % % % & & & & * * * * * = = = = - . ", -" . # & & & * * * * = = = = = ; ; ; ; > . ", -" . , ' ' ' ) ) ) ) - - - - - > > > > ! . ", -" . ~ { { { { { { { { { { { { { { { { ; . ", -" . # ; ; ; ] ] ] ] ] ^ ^ ^ ^ $ $ $ $ / . ", -" . # ] ] ] ( ^ ^ ^ _ : < [ } | 1 | 2 3 . ", -" . 4 5 5 5 / / / 6 7 8 . 9 0 - a a a b . ", -" . ~ c d d d d d e f g . h i $ j j k * . ", -" . ~ 2 2 2 2 l l m n o . > p q r r r < . ", -" . ~ l l l l s s t u v w . x . y p z < . ", -" . A B B B B < 9 . C D E F . G H . I J . ", -" . ~ @ , , , j . K L M N O P F Q R . S . ", -" . ~ T T T T U . V W X Y Z ` ...+.@.< . ", -" . #.$.$.$.$.& . %.&.*.=.-.;.>.,.'.@.p . ", -" . { ).).).).!.~.{.].^./.(._.:.<.[.@.}.. ", -" . #.@ c c c |.1.2.3.4.5.6.7.8.9.0.@.] . ", -" . #.a.a.a.a.l b.c.d.e.f.g.9.h.i.. j.q . ", -" . #.a.a.a.a.k.l.j.m.n.o.p.q.r.s.t.u.q . ", -" . a.v.v.v.v.v.w.x.y.z.A.t.B.C.D.E.F.m . ", -" . . . . . . . . . ~.G.H.I.J.K.L.M.. . . ", -" ~.N.z.O.C.P.. Q. "}; diff --git a/xemacs-packages/gnus/etc/gnus/jump-to.xpm b/xemacs-packages/gnus/etc/gnus/jump-to.xpm deleted file mode 100644 index 8f989797..00000000 --- a/xemacs-packages/gnus/etc/gnus/jump-to.xpm +++ /dev/null @@ -1,171 +0,0 @@ -/* XPM */ -static char * jump_to_xpm[] = { -"24 24 144 2", -" c None", -". c #000000", -"+ c #9ABC82", -"@ c #C1E3AA", -"# c #A0C487", -"$ c #8F6508", -"% c #AD671D", -"& c #D6AF41", -"* c #E1B744", -"= c #B86F20", -"- c #7E5907", -"; c #D8E7CD", -"> c #D9E7CF", -", c #DDEAD2", -"' c #E4EFDA", -") c #EBF6DF", -"! c #C8EBB0", -"~ c #A2C688", -"{ c #986F26", -"] c #E2B946", -"^ c #EFCD64", -"/ c #F4D268", -"( c #F6D469", -"_ c #E7C24A", -": c #D5B044", -"< c #BC8C31", -"[ c #1A0700", -"} c #D7E6CD", -"| c #B2D29C", -"1 c #B6D69F", -"2 c #BDDEA5", -"3 c #C4E7AC", -"4 c #CAEEB1", -"5 c #A1C387", -"6 c #CBB86E", -"7 c #EDD97E", -"8 c #FEE882", -"9 c #FEE77E", -"0 c #FDDF60", -"a c #FBD14F", -"b c #E4BF49", -"c c #BB8C31", -"d c #CFE2C3", -"e c #B2D19C", -"f c #B5D59F", -"g c #BBDBA4", -"h c #C1E3A9", -"i c #C6E9AE", -"j c #C3E6AB", -"k c #A9CE8D", -"l c #DCBA5C", -"m c #FBE46B", -"n c #FFEB64", -"o c #FFE054", -"p c #FED952", -"q c #F8CF4E", -"r c #C4A13E", -"s c #8BA27B", -"t c #618249", -"u c #628349", -"v c #64864B", -"w c #66894D", -"x c #688B4E", -"y c #678B4D", -"z c #6B9251", -"A c #719755", -"B c #55833A", -"C c #ECC75E", -"D c #FFED59", -"E c #FFE757", -"F c #FFDF54", -"G c #FBD44F", -"H c #E1BD48", -"I c #B36C1F", -"J c #608148", -"K c #628449", -"L c #63854A", -"M c #65894C", -"N c #6C9151", -"O c #527E39", -"P c #B39237", -"Q c #F0C248", -"R c #FFF25B", -"S c #FFEB58", -"T c #FFE155", -"U c #FBD450", -"V c #E3BD49", -"W c #BC983B", -"X c #618349", -"Y c #628549", -"Z c #65884B", -"` c #4D7735", -" . c #907934", -".. c #DCB444", -"+. c #FCDB52", -"@. c #FFEF5A", -"#. c #FFE957", -"$. c #FEDF54", -"%. c #F9D24F", -"&. c #E0BA48", -"*. c #B08F37", -"=. c #52743B", -"-. c #456A2F", -";. c #608248", -">. c #628448", -",. c #476F31", -"'. c #7F6B32", -"). c #D0AF4B", -"!. c #F5CF4E", -"~. c #FFE255", -"{. c #FEDA52", -"]. c #EAC54B", -"^. c #D0AC42", -"/. c #9C5D1A", -"(. c #5A7B42", -"_. c #456C2F", -":. c #6F5C23", -"<. c #A78833", -"[. c #F0C54A", -"}. c #FFDA52", -"|. c #FFDE53", -"1. c #C39032", -"2. c #886423", -"3. c #BC9D3B", -"4. c #F0C84E", -"5. c #FFD551", -"6. c #FED751", -"7. c #FDD550", -"8. c #EDC74C", -"9. c #E5BF49", -"0. c #CCA941", -"a. c #AB7727", -"b. c #B1822D", -"c. c #DCB746", -"d. c #DFBA47", -"e. c #EDC64C", -"f. c #E9C34B", -"g. c #D6B144", -"h. c #C19D3D", -"i. c #AB7C2B", -"j. c #BC7222", -"k. c #BB983B", -"l. c #B09638", -"m. c #A2621B", -" ", -" ", -" . ", -" . . ", -" . + . . . . . . . ", -" . . . . . . @ # . . $ % & * = - . . ", -" . ; > , ' ) ! ! ~ . { ] ^ / ( _ : < [ . ", -" . } | 1 2 3 4 4 3 5 . 6 7 8 9 0 a b c . ", -" . d e f g h i i h j k . l m n o p q r - . ", -" . s t u v w x x y z A B . C D E F G H I . ", -" . s J t K L v v M N O . P Q R S T U V W . ", -" . s J J t X u Y Z ` . ...+.@.#.$.%.&.*.. ", -" . =.-.-.-.-.;.>.,.. '.).!.E E ~.{.].^./.. ", -" . . . . . . (._.. :.<.[.}.|.|.{.%.V 1.$ . ", -" . -.. . 2.3.4.5.6.7.8.9.0.a.. ", -" . . . . b.c.d.e.f.g.h.i.. . ", -" . . $ j.k.l.m.$ . . ", -" . . . . . . ", -" ", -" ", -" ", -" ", -" ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/kill-group.pbm b/xemacs-packages/gnus/etc/gnus/kill-group.pbm deleted file mode 100644 index 50831447f5041925080300538cf32a5470704f5f..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 81 zcmWGA;W9E&Ff!o^6%ABiVsH_0)c=1XgfWoAVnIx3C`S#4NR6O|1-FZUD8~+lP!~ZB k4F(qhK@AU%P!>TB28I|0Q4R(U5e7m1|F2y`LKzqs0K2vjGynhq diff --git a/xemacs-packages/gnus/etc/gnus/kill-group.xpm b/xemacs-packages/gnus/etc/gnus/kill-group.xpm deleted file mode 100644 index 1ee4fa42..00000000 --- a/xemacs-packages/gnus/etc/gnus/kill-group.xpm +++ /dev/null @@ -1,30 +0,0 @@ -/* XPM */ -static char * kill_group_xpm[] = { -"24 24 3 1", -". c None", -"o c #000000000000", -"+ c #9A9A6C6C4E4E", -"o..o..o..o..o..o..o..o..", -"........................", -"........................", -"o..o..o..o..o..o..o..o..", -"........................", -"........................", -"o..o..o..o..++.o..o..o..", -".......++..++++.........", -"........++.+++..........", -"o..o..o.+++++..o..o..o..", -".........+++............", -".........++++...........", -"o..o..o.++++++.o..o..o..", -"........++.++++.........", -".......++...++++........", -"o..o...+.o...++o..o..o..", -"........................", -"........................", -"o..o..o..o..o..o..o..o..", -"........................", -"........................", -"o..o..o..o..o..o..o..o..", -"........................", -"........................"}; diff --git a/xemacs-packages/gnus/etc/gnus/left-arrow.xpm b/xemacs-packages/gnus/etc/gnus/left-arrow.xpm deleted file mode 100644 index 586fe448..00000000 --- a/xemacs-packages/gnus/etc/gnus/left-arrow.xpm +++ /dev/null @@ -1,70 +0,0 @@ -/* XPM */ -static char * left_arrow_xpm[] = { -"24 24 43 1", -" c None", -". c #000000", -"+ c #B9D0B9", -"@ c #CDDECB", -"# c #B6C7B6", -"$ c #B1C9B0", -"% c #B3C4B3", -"& c #B4CBB2", -"* c #B5CEB5", -"= c #B7CCB5", -"- c #B9CEB7", -"; c #BAD1BA", -"> c #BBCFBA", -", c #BBD0B9", -"' c #B2C9B0", -") c #7EAB78", -"! c #AAC7A8", -"~ c #B3CAB1", -"{ c #B0C9B0", -"] c #B0C9AE", -"^ c #AEC7AC", -"/ c #AAC5A8", -"( c #A9C4A7", -"_ c #698267", -": c #2D2D2D", -"< c #CFDFCC", -"[ c #ADC8AB", -"} c #B0C7AE", -"| c #ADC6AB", -"1 c #678C63", -"2 c #9BAD9A", -"3 c #85AE81", -"4 c #87AF84", -"5 c #87B083", -"6 c #88AF84", -"7 c #88B085", -"8 c #86AF82", -"9 c #547150", -"0 c #3C5235", -"a c #5B7950", -"b c #4A6342", -"c c #3B5035", -"d c #415639", -" ", -" ", -" ", -" . ", -" .. ", -" .+. ", -" .@#. ", -" .@$%........ ", -" .@&*=-;->,'). ", -" .@!~{]^///^(_. ", -" :<[}||[!^^}^[1. ", -" .23444445645789. ", -" .0aaaaaaaaaaab. ", -" .0aaaaaaaaaab. ", -" .0aabccccccd. ", -" .0ab........ ", -" .0b. ", -" .b. ", -" .. ", -" . ", -" ", -" ", -" ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/lock-broken.xpm b/xemacs-packages/gnus/etc/gnus/lock-broken.xpm deleted file mode 100644 index 15676bd7..00000000 --- a/xemacs-packages/gnus/etc/gnus/lock-broken.xpm +++ /dev/null @@ -1,231 +0,0 @@ -/* XPM */ -static char * stock_lock_broken_xpm[] = { -"24 24 204 2", -" c None", -". c #0E0E0E", -"+ c #262626", -"@ c #464646", -"# c #3C3C3C", -"$ c #3B3B3B", -"% c #212121", -"& c #252525", -"* c #ADADAD", -"= c #F0F0F0", -"- c #EAEAEA", -"; c #1A1A1A", -"> c #000000", -", c #FAFAFA", -"' c #F4F4F4", -") c #4D4D4D", -"! c #303030", -"~ c #D8D8D8", -"{ c #E5E5E5", -"] c #B0B0B0", -"^ c #414141", -"/ c #484848", -"( c #030303", -"_ c #DADADA", -": c #E4E4E4", -"< c #353535", -"[ c #070707", -"} c #A6A6A6", -"| c #E6E6E6", -"1 c #686868", -"2 c #020202", -"3 c #3E3E3E", -"4 c #EFEFEF", -"5 c #9B9B9B", -"6 c #343434", -"7 c #F8F8F8", -"8 c #999999", -"9 c #F1F1F1", -"0 c #C4C4C4", -"a c #232323", -"b c #535353", -"c c #AEAEAE", -"d c #F3F3F3", -"e c #D3D3D3", -"f c #242424", -"g c #4E4E4E", -"h c #EEEEEE", -"i c #B5B5B5", -"j c #0F0601", -"k c #200E03", -"l c #765E49", -"m c #7D6A56", -"n c #38291D", -"o c #180A03", -"p c #D6CBC1", -"q c #A09E9D", -"r c #1D1109", -"s c #2A1E13", -"t c #3D2E21", -"u c #3F3123", -"v c #47423D", -"w c #DBB98E", -"x c #D6B183", -"y c #D3AC7E", -"z c #CFA573", -"A c #CD9E67", -"B c #C39056", -"C c #46270A", -"D c #281F14", -"E c #675643", -"F c #A48367", -"G c #D8AB7C", -"H c #BF9E7C", -"I c #DCBB93", -"J c #DCB786", -"K c #D1A872", -"L c #231B12", -"M c #7B6C58", -"N c #C69B63", -"O c #C39860", -"P c #C09257", -"Q c #BD8A4A", -"R c #B9803D", -"S c #AA6E28", -"T c #412409", -"U c #100B07", -"V c #CDB598", -"W c #E8CCA9", -"X c #DAB587", -"Y c #D4AC7D", -"Z c #D1A775", -"` c #C99F6A", -" . c #AF8B5B", -".. c #2E2517", -"+. c #1E1910", -"@. c #0B0805", -"#. c #594B39", -"$. c #2A2015", -"%. c #C2975E", -"&. c #BE8D50", -"*. c #BB823F", -"=. c #AE722C", -"-. c #422409", -";. c #0E0B07", -">. c #AB957E", -",. c #E9CEAC", -"'. c #DBB68A", -"). c #D5AD7E", -"!. c #D0A975", -"~. c #C9A26F", -"{. c #B99667", -"]. c #AA895F", -"^. c #31291C", -"/. c #322A1C", -"(. c #54493B", -"_. c #C69C64", -":. c #C2965E", -"<. c #BE8E50", -"[. c #C29156", -"}. c #9E692A", -"|. c #1A150D", -"1. c #887762", -"2. c #EAD1AF", -"3. c #DDB98E", -"4. c #D4AC7E", -"5. c #D2A876", -"6. c #C39E6D", -"7. c #927751", -"8. c #15110C", -"9. c #988468", -"0. c #C2945A", -"a. c #BE8F51", -"b. c #BC8544", -"c. c #BE8A4F", -"d. c #9A6526", -"e. c #70604D", -"f. c #EFD6B5", -"g. c #DEBD93", -"h. c #D4AC7C", -"i. c #D0A672", -"j. c #C9A069", -"k. c #9D7E53", -"l. c #140F09", -"m. c #1F1710", -"n. c #EFD8B9", -"o. c #E3C39C", -"p. c #D7B080", -"q. c #D4AC79", -"r. c #CDA46F", -"s. c #3A2C1B", -"t. c #FFFFFF", -"u. c #1C160D", -"v. c #B29E85", -"w. c #E6C8A3", -"x. c #D7B081", -"y. c #D1A874", -"z. c #CBA16A", -"A. c #BA905A", -"B. c #251C10", -"C. c #DF421E", -"D. c #F7F7F7", -"E. c #DFDFDF", -"F. c #2F2619", -"G. c #92806A", -"H. c #E6C7A2", -"I. c #D6AF7E", -"J. c #CCA26C", -"K. c #53422A", -"L. c #211910", -"M. c #2A2014", -"N. c #E1E1E1", -"O. c #6A5C4A", -"P. c #EAD0AD", -"Q. c #DAB68B", -"R. c #D2A978", -"S. c #CEA56E", -"T. c #C89D66", -"U. c #856740", -"V. c #534026", -"W. c #F9F9F9", -"X. c #FBFBFB", -"Y. c #E2E2E2", -"Z. c #42362B", -"`. c #D1BA9B", -" + c #DCBA8E", -".+ c #D1A773", -"++ c #C4975C", -"@+ c #BE8C4C", -"#+ c #B4813F", -"$+ c #281B0B", -"%+ c #E3E3E3", -"&+ c #372416", -"*+ c #74654F", -"=+ c #B68E5C", -"-+ c #926231", -";+ c #452B11", -">+ c #341E09", -",+ c #221205", -"'+ c #150802", -")+ c #FDFDFD", -"!+ c #030000", -"~+ c #050000", -"{+ c #010000", -"]+ c #C3C3C3", -" ", -" ", -" . + @ # $ % ", -" & * = - ; > , ' ) > ", -" ! ~ { ] ^ / ( $ _ : < ", -" [ } | 1 2 3 4 5 > ", -" 6 7 8 > > 9 0 a ", -" b 9 c > > d e f ", -" g h i > j k l m n o ", -" ^ p q r s t u > v w x y z A B C ", -" D E F G H I J K L > M N O P Q R S T ", -" U V W X Y Z ` ...+. @.#.$.%.&.*.=.-. ", -" ;.>.,.'.).!.~.{.].^./. (._.:.<.[.}.-. ", -" |.1.2.3.4.5.6.7.8. > 9.0.a.b.c.d.T ", -" e.f.g.h.i.j.k.l.> > > > > > > > > > ", -" m.n.o.p.q.r._.s. > t.t.t.t.t.t.t.> ", -" u.v.w.x.y.z.A.B.> > t.C.C.D.C.C.E.> ", -" F.G.H.I.i.J.K.L.M. > t.C.C.C.C.C.N.> ", -" O.P.Q.R.S.T.U.V. > t.W.C.C.C.X.Y.> ", -" Z.`. +.+z.++@+#+$+> > t.C.C.C.C.C.%+> ", -" &+*+=+-+;+>+,+'+ > t.C.C.)+C.C.{ > ", -" !+~+{+> > - %+%+: { { ]+> ", -" > > > > > > > > > ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/lock-ok.xpm b/xemacs-packages/gnus/etc/gnus/lock-ok.xpm deleted file mode 100644 index 630d9b40..00000000 --- a/xemacs-packages/gnus/etc/gnus/lock-ok.xpm +++ /dev/null @@ -1,215 +0,0 @@ -/* XPM */ -static char * stock_lock_ok_xpm[] = { -"24 24 188 2", -" c None", -". c #000000", -"+ c #212121", -"@ c #9E9E9E", -"# c #E6E6E6", -"$ c #E7E7E7", -"% c #C8C8C8", -"& c #A0A0A0", -"* c #131313", -"= c #5F5F5F", -"- c #EDEDED", -"; c #D6D6D6", -"> c #D5D5D5", -", c #DDDDDD", -"' c #D8D8D8", -") c #A1A1A1", -"! c #3C3C3C", -"~ c #353535", -"{ c #EFEFEF", -"] c #CFCFCF", -"^ c #4C4C4C", -"/ c #141414", -"( c #6A6A6A", -"_ c #D0D0D0", -": c #B2B2B2", -"< c #454545", -"[ c #E2E2E2", -"} c #292929", -"| c #0F0F0F", -"1 c #949494", -"2 c #E9E9E9", -"3 c #C3C3C3", -"4 c #1C1C1C", -"5 c #E1E1E1", -"6 c #272727", -"7 c #DEDEDE", -"8 c #B6B6B6", -"9 c #B7B6B6", -"0 c #150902", -"a c #2E2419", -"b c #251D15", -"c c #616160", -"d c #5E5A56", -"e c #29211A", -"f c #15100C", -"g c #2F251B", -"h c #1D1710", -"i c #4A392B", -"j c #656361", -"k c #565352", -"l c #392B1D", -"m c #322110", -"n c #0C0500", -"o c #EFDBBF", -"p c #EDD9C0", -"q c #E9D5BE", -"r c #E7D2B9", -"s c #E5D0B3", -"t c #DCC09D", -"u c #D9BE99", -"v c #DABE99", -"w c #D7BB95", -"x c #D5B68E", -"y c #D2AF85", -"z c #CFA77C", -"A c #9A5E1B", -"B c #F0DABF", -"C c #E4C6A0", -"D c #D6AF80", -"E c #D3AC7B", -"F c #D0A570", -"G c #C99F68", -"H c #C69B64", -"I c #C69C64", -"J c #C89D66", -"K c #C79C65", -"L c #C39860", -"M c #C09256", -"N c #BC8645", -"O c #B67C36", -"P c #985E1A", -"Q c #EED8BC", -"R c #E3C39C", -"S c #D3AA7B", -"T c #CFA670", -"U c #CA9F68", -"V c #C89E66", -"W c #C89F68", -"X c #C49961", -"Y c #C09358", -"Z c #BC8746", -"` c #B77D39", -" . c #EED8BB", -".. c #E2C29B", -"+. c #D6AE7F", -"@. c #CA9E6D", -"#. c #C69861", -"$. c #BF925A", -"%. c #BB8E56", -"&. c #BD8E56", -"*. c #5C7354", -"=. c #EFDABE", -"-. c #E4C49D", -";. c #D7B080", -">. c #DAB685", -",. c #D4B07C", -"'. c #D0A971", -"). c #CEA46B", -"!. c #CDA46D", -"~. c #FFFFFF", -"{. c #DBE0D9", -"]. c #52684B", -"^. c #4E6346", -"/. c #52674A", -"(. c #EFD8BB", -"_. c #E0C199", -":. c #D3AA7A", -"<. c #C89B67", -"[. c #C3965F", -"}. c #BC8E56", -"|. c #BA8B52", -"1. c #BA8C54", -"2. c #F6F6F6", -"3. c #F7F7F7", -"4. c #F8F8F8", -"5. c #E6E9E5", -"6. c #6B8064", -"7. c #4B5F45", -"8. c #44553D", -"9. c #E3C29C", -"0. c #D9B484", -"a. c #D4AE77", -"b. c #CFA770", -"c. c #CCA46B", -"d. c #CBA36B", -"e. c #B6BEB3", -"f. c #4E6047", -"g. c #788274", -"h. c #CBD2C9", -"i. c #6A8063", -"j. c #384834", -"k. c #EDD6B8", -"l. c #E1BD94", -"m. c #D1A874", -"n. c #BD9058", -"o. c #B7874E", -"p. c #B48349", -"q. c #B5844C", -"r. c #8F9C8A", -"s. c #53684B", -"t. c #475841", -"u. c #657C5E", -"v. c #4A5D44", -"w. c #626E5D", -"x. c #EED8BA", -"y. c #E0C099", -"z. c #D8B37F", -"A. c #D2AD76", -"B. c #CEA66F", -"C. c #CCA46D", -"D. c #FAFAFA", -"E. c #6A7E63", -"F. c #63715E", -"G. c #E3E3E3", -"H. c #EED5B7", -"I. c #DFC096", -"J. c #D2A776", -"K. c #CEA46E", -"L. c #C89D65", -"M. c #C49960", -"N. c #C1955C", -"O. c #C2955C", -"P. c #FBFBFB", -"Q. c #FCFCFC", -"R. c #80937A", -"S. c #6D796A", -"T. c #FEFEFE", -"U. c #E5E5E5", -"V. c #AC8C65", -"W. c #CFA772", -"X. c #C49256", -"Y. c #C08D51", -"Z. c #BA8849", -"`. c #B78342", -" + c #B48240", -".+ c #B68241", -"++ c #EAEAEA", -"@+ c #E4E4E4", -" ", -" ", -" . . . . . ", -" . + @ # $ % & * ", -" . = - # ; > , ' ) ! . ", -" ~ { ] ^ . . / ( _ : < ", -" . [ ' } . | ( % 1 . ", -" * 2 3 . 4 5 @ . ", -" 6 7 8 . . $ 9 . ", -" 0 a b c d e f g b h b i j k l m n ", -" . o p q r s t u u v u w x y z A . ", -" . B C D E F G H I J K L M N O P . ", -" . Q R D S T U I V W V X Y Z ` A . ", -" . ...+.@.#.$.%.&.. . . . . . . . . *. ", -" . =.-.;.>.,.'.).!.. ~.~.~.~.~.~.{.].^./.", -" . (._.:.<.[.}.|.1.. ~.2.3.3.4.5.6.7.8. ", -" . Q 9.+.0.a.b.c.d.. ~.e.f.g.h.i.7.j. ", -" . k.l.m.#.n.o.p.q.. ~.r.s.t.u.v.w.. ", -" . x.y.S z.A.B.c.C.. ~.D.E.s./.F.G.. ", -" . H.I.J.K.L.M.N.O.. ~.P.Q.R.S.T.U.. ", -" . V.W.X.Y.Z.`. +.+. ++G.G.@+U.U.3 . ", -" . . . . . . . . . . . . . . . . . ", -" ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/lock.xpm b/xemacs-packages/gnus/etc/gnus/lock.xpm deleted file mode 100644 index c9aa18d9..00000000 --- a/xemacs-packages/gnus/etc/gnus/lock.xpm +++ /dev/null @@ -1,227 +0,0 @@ -/* XPM */ -static char * stock_lock_xpm[] = { -"24 24 200 2", -" c None", -". c #000000", -"+ c #212121", -"@ c #9E9E9E", -"# c #E6E6E6", -"$ c #E7E7E7", -"% c #C8C8C8", -"& c #A0A0A0", -"* c #131313", -"= c #5F5F5F", -"- c #EDEDED", -"; c #D6D6D6", -"> c #D5D5D5", -", c #DDDDDD", -"' c #D8D8D8", -") c #A1A1A1", -"! c #3C3C3C", -"~ c #353535", -"{ c #EFEFEF", -"] c #CFCFCF", -"^ c #4C4C4C", -"/ c #141414", -"( c #6A6A6A", -"_ c #D0D0D0", -": c #B2B2B2", -"< c #454545", -"[ c #E2E2E2", -"} c #292929", -"| c #0F0F0F", -"1 c #949494", -"2 c #E9E9E9", -"3 c #C3C3C3", -"4 c #1C1C1C", -"5 c #E1E1E1", -"6 c #272727", -"7 c #DEDEDE", -"8 c #B6B6B6", -"9 c #B7B6B6", -"0 c #150902", -"a c #2E2419", -"b c #251D15", -"c c #616160", -"d c #5E5A56", -"e c #29211A", -"f c #15100C", -"g c #2F251B", -"h c #1D1710", -"i c #4A392B", -"j c #656361", -"k c #565352", -"l c #392B1D", -"m c #322110", -"n c #0C0500", -"o c #EFDBBF", -"p c #EDD9C0", -"q c #E9D5BE", -"r c #E7D2B9", -"s c #E5D0B3", -"t c #DCC09D", -"u c #D9BE99", -"v c #DABE99", -"w c #D7BB95", -"x c #D5B68E", -"y c #D2AF85", -"z c #CFA77C", -"A c #9A5E1B", -"B c #F0DABF", -"C c #E4C6A0", -"D c #D6AF80", -"E c #D3AC7B", -"F c #D0A570", -"G c #C99F68", -"H c #C69B64", -"I c #C69C64", -"J c #C89D66", -"K c #C79C65", -"L c #C39860", -"M c #C09256", -"N c #BC8645", -"O c #B67C36", -"P c #985E1A", -"Q c #EED8BC", -"R c #E3C39C", -"S c #D3AA7B", -"T c #CFA670", -"U c #CA9F68", -"V c #C89E66", -"W c #C89F68", -"X c #C49961", -"Y c #C09358", -"Z c #BC8746", -"` c #B77D39", -" . c #EED8BB", -".. c #E2C29B", -"+. c #D6AE7F", -"@. c #CA9E6D", -"#. c #C69861", -"$. c #BF925A", -"%. c #BB8E56", -"&. c #BD8E56", -"*. c #BD9058", -"=. c #BC8F58", -"-. c #B9884E", -";. c #B48145", -">. c #BA8442", -",. c #B47834", -"'. c #975C1A", -"). c #EFDABE", -"!. c #E4C49D", -"~. c #D7B080", -"{. c #DAB685", -"]. c #D4B07C", -"^. c #D0A971", -"/. c #CEA46B", -"(. c #CDA46D", -"_. c #CCA66D", -":. c #CCA46B", -"<. c #CA9F63", -"[. c #C79858", -"}. c #B9813F", -"|. c #B37834", -"1. c #975D1A", -"2. c #EFD8BB", -"3. c #E0C199", -"4. c #D3AA7A", -"5. c #C89B67", -"6. c #C3965F", -"7. c #BC8E56", -"8. c #BA8B52", -"9. c #BA8C54", -"0. c #BB8D55", -"a. c #BA8C55", -"b. c #B6864C", -"c. c #B47F43", -"d. c #BA833F", -"e. c #B37934", -"f. c #9B601E", -"g. c #E3C29C", -"h. c #D9B484", -"i. c #D4AE77", -"j. c #CFA770", -"k. c #CBA36B", -"l. c #CCA46C", -"m. c #CA9D61", -"n. c #C69856", -"o. c #BA813E", -"p. c #B27733", -"q. c #A36B2F", -"r. c #EDD6B8", -"s. c #E1BD94", -"t. c #D1A874", -"u. c #B7874E", -"v. c #B48349", -"w. c #B5844C", -"x. c #B5884D", -"y. c #B48146", -"z. c #B27A3C", -"A. c #B67D3A", -"B. c #B07530", -"C. c #A67137", -"D. c #EED8BA", -"E. c #E0C099", -"F. c #D8B37F", -"G. c #D2AD76", -"H. c #CEA66F", -"I. c #CCA46D", -"J. c #CCA56D", -"K. c #C99D61", -"L. c #C69858", -"M. c #B9803D", -"N. c #B67D38", -"O. c #AB783F", -"P. c #EED5B7", -"Q. c #DFC096", -"R. c #D2A776", -"S. c #CEA46E", -"T. c #C89D65", -"U. c #C49960", -"V. c #C1955C", -"W. c #C2955C", -"X. c #C2965C", -"Y. c #C09155", -"Z. c #BC8A4B", -"`. c #BE8A4C", -" + c #A9773C", -".+ c #AC8C65", -"++ c #CFA772", -"@+ c #C49256", -"#+ c #C08D51", -"$+ c #BA8849", -"%+ c #B78342", -"&+ c #B48240", -"*+ c #B68241", -"=+ c #B88544", -"-+ c #BB8949", -";+ c #BC8748", -">+ c #BA874A", -",+ c #B98548", -"'+ c #B27B3B", -")+ c #6D4215", -" ", -" ", -" . . . . . ", -" . + @ # $ % & * ", -" . = - # ; > , ' ) ! . ", -" ~ { ] ^ . . / ( _ : < ", -" . [ ' } . | ( % 1 . ", -" * 2 3 . 4 5 @ . ", -" 6 7 8 . . $ 9 . ", -" 0 a b c d e f g b h b i j k l m n ", -" . o p q r s t u u v u w x y z A . ", -" . B C D E F G H I J K L M N O P . ", -" . Q R D S T U I V W V X Y Z ` A . ", -" . ...+.@.#.$.%.&.*.=.-.;.>.,.'.. ", -" . ).!.~.{.].^./.(._.:.<.[.}.|.1.. ", -" . 2.3.4.5.6.7.8.9.0.a.b.c.d.e.f.. ", -" . Q g.+.h.i.j.:.k.l.k.m.n.o.p.q.. ", -" . r.s.t.#.*.u.v.w.x.b.y.z.A.B.C.. ", -" . D.E.S F.G.H.:.I.J.l.K.L.M.N.O.. ", -" . P.Q.R.S.T.U.V.W.X.X.Y.Z.>.`. +. ", -" . .+++@+#+$+%+&+*+=+-+;+>+,+'+)+. ", -" . . . . . . . . . . . . . . . ", -" ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/mail-reply.pbm b/xemacs-packages/gnus/etc/gnus/mail-reply.pbm deleted file mode 100644 index 9ca76596fb1dc23f14ce7fe6ee4085636e77bff3..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 81 zcmWGA;W9E&Ff!p{U}RumUckT-z+l6{=qkX>CBPygV6?!(Bp^i3 c #7B7976", -", c #D2CFCA", -"' c #E1E0DD", -") c #908E8B", -"! c #EBEAEA", -"~ c #F1F0EE", -"{ c #E2E0DD", -"] c #7C7B78", -"^ c #C6C3C0", -"/ c #E5E3DE", -"( c #DCDAD7", -"_ c #8F8C88", -": c #EBEBEA", -"< c #EFEDEA", -"[ c #DFDDDA", -"} c #787774", -"| c #C1BEBA", -"1 c #E6E3E0", -"2 c #EFEEEC", -"3 c #CBCAC6", -"4 c #ECECEC", -"5 c #F3F2F0", -"6 c #DCDCDC", -"7 c #7D7C79", -"8 c #B4B2AE", -"9 c #E7E5E1", -"0 c #F0EFEB", -"a c #E4E2DD", -"b c #9D9994", -"c c #DBD9D6", -"d c #747370", -"e c #A09C97", -"f c #DAD8D5", -"g c #E7E6E3", -"h c #E8E6E1", -"i c #E0DED9", -"j c #AFACA6", -"k c #F7F6F4", -"l c #D3D1CF", -"m c #868480", -"n c #C2BFBD", -"o c #DAD9D5", -"p c #F6F5F1", -"q c #D8D6D1", -"r c #ABA8A3", -"s c #F9F8F6", -"t c #F7F5F2", -"u c #92908B", -"v c #CCCAC5", -"w c #EAE9E8", -"x c #B0ADA7", -"y c #F5F3F0", -"z c #F7F6F2", -"A c #F5F4F0", -"B c #EAE8E3", -"C c #D2D0CB", -"D c #B9B8B6", -"E c #CBC9C4", -"F c #DEDBD5", -"G c #D9D7D2", -"H c #DAD8D3", -"I c #D5D3CE", -"J c #D6D4CF", -"K c #040404", -" ", -" ", -" ", -" . . . . . . . ", -" . . ", -" ", -" . . ", -" ", -" . . ", -" .+........... ", -" . .@###########$. ", -" .#%&*=*-*-*;>,. ", -" . .#')!~-*-*{]^/. ", -" .#~(_:~<~[}|1/. ", -" . . .#~23]4567890a. ", -" .#22~b]cdefghi. ", -" .#~2jklmnoep0q. ", -" .#2rsskfkttuhv. ", -" .wxsyzAtAtyBuC. ", -" .DEFFFGHIJCCCu. ", -" ............K ", -" ", -" ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/new.xpm b/xemacs-packages/gnus/etc/gnus/new.xpm deleted file mode 100644 index 2d4690ed..00000000 --- a/xemacs-packages/gnus/etc/gnus/new.xpm +++ /dev/null @@ -1,154 +0,0 @@ -/* XPM */ -static char * new_xpm[] = { -"24 24 127 2", -" c None", -". c #000000", -"+ c #D3D3D3", -"@ c #F6F6F6", -"# c #FFFFFF", -"$ c #F9F9F9", -"% c #DADADA", -"& c #585858", -"* c #C7C7C7", -"= c #D1D1D1", -"- c #D6D6D6", -"; c #FEFEFE", -"> c #FDFDFD", -", c #C0C0C0", -"' c #E1E1E1", -") c #F0F0F0", -"! c #9B9B9B", -"~ c #FCFCFB", -"{ c #FBFBFB", -"] c #AFAFAE", -"^ c #E9E9E9", -"/ c #DFDFDF", -"( c #8F8F8F", -"_ c #FAFAF9", -": c #F9F9F8", -"< c #A4A4A3", -"[ c #F4F4F4", -"} c #CFCFCF", -"| c #A2A2A2", -"1 c #F8F8F7", -"2 c #F8F7F6", -"3 c #9E9E9E", -"4 c #F7F6F5", -"5 c #F6F6F4", -"6 c #F4F3F2", -"7 c #DEDDDC", -"8 c #D3D2D0", -"9 c #B7B7B5", -"0 c #9F9E9D", -"a c #706F6F", -"b c #65625A", -"c c #F5F4F3", -"d c #F2F2F0", -"e c #E4E4E2", -"f c #DAD9D7", -"g c #D8D8D6", -"h c #CDCCCA", -"i c #AFAEAC", -"j c #88847B", -"k c #F3F3F1", -"l c #EFEFED", -"m c #EEEDEB", -"n c #EDECEA", -"o c #E9E8E6", -"p c #D5D4D3", -"q c #C4C3C2", -"r c #8F8A81", -"s c #F6F5F4", -"t c #F5F5F3", -"u c #F1F1EF", -"v c #F1F0EE", -"w c #ECEBE9", -"x c #EAE9E7", -"y c #E5E4E2", -"z c #E4E3E0", -"A c #D2D1CE", -"B c #8D887E", -"C c #F3F2F1", -"D c #F0F0EE", -"E c #F0EFED", -"F c #EFEEEC", -"G c #E8E7E5", -"H c #E5E4E1", -"I c #E2E1DE", -"J c #E1DFDC", -"K c #979288", -"L c #A49E93", -"M c #E8E7E4", -"N c #E7E6E3", -"O c #E3E2DF", -"P c #E2E0DD", -"Q c #E1E0DC", -"R c #E0DFDB", -"S c #A19C90", -"T c #EDEDEB", -"U c #EBEAE8", -"V c #E9E8E5", -"W c #E6E4E1", -"X c #E3E2DE", -"Y c #DFDEDA", -"Z c #DEDDD9", -"` c #DDDCD8", -" . c #A19B90", -".. c #E7E5E2", -"+. c #E4E3DF", -"@. c #DCDBD7", -"#. c #E6E5E2", -"$. c #E5E4E0", -"%. c #E2E1DD", -"&. c #DBD9D5", -"*. c #D9D7D3", -"=. c #9F998D", -"-. c #E4E2DF", -";. c #DDDBD7", -">. c #DCDAD6", -",. c #D8D6D2", -"'. c #9E988D", -"). c #EDEDED", -"!. c #E1E0DD", -"~. c #E0DEDA", -"{. c #D8D6D1", -"]. c #D7D5D1", -"^. c #9D978B", -"/. c #E1DFDB", -"(. c #DEDCD8", -"_. c #D7D6D1", -":. c #D5D3CE", -"<. c #9B958A", -"[. c #999891", -"}. c #A39E92", -"|. c #A39D92", -"1. c #A39D91", -"2. c #A29C90", -"3. c #A19B8F", -"4. c #9D978C", -"5. c #9B968A", -"6. c #676359", -" ", -" . . . . . . . . . . . . . ", -" . + @ # # # # # # # # $ % & . ", -" . @ # # # # # # # # # # * = - . ", -" . # # # # # # # ; # ; > , ' ) ! . ", -" . # # # # # ; > ~ > ~ { ] ^ # / ( . ", -" . # # # ; > ~ { _ { _ : < ) # [ } | . ", -" . # ; > ~ { _ : 1 : 1 2 3 . . . . . . . ", -" . # ~ { _ : 1 2 4 2 4 5 6 7 8 9 0 a b . ", -" . # _ : 1 2 4 5 c 5 c 6 d e f g h i j . ", -" . # 1 2 4 5 c 6 k 6 k d l m n o p q r . ", -" . # s t 6 6 k d u d u v m w x y z A B . ", -" . # 6 C d D l v E v E F w G H z I J K . ", -" . # 6 C d D l v E v E F w G H z I J L . ", -" . # D l l F m n n n n w M N O P Q R S . ", -" . # T n w w w U V U V V H W X Y Z ` .. ", -" . # U o o G M M N M N ..+.X R Z ` @. .. ", -" . # N #.#.#.H W $.W $.+.%.R Z @.&.*.=.. ", -" . $ z O X -.+.%.X %.X Q Q Z ;.>.*.,.'.. ", -" . ).!.J Q R %.R Q R Q Y ~.;.>.*.{.].^.. ", -" . = /.~.Y Z R Z ~.Z ~.(.(.>.>.,._.:.<.. ", -" . [.}.L |.1.|.S 2.S 2.3. .=.=.4.4.5.6.. ", -" . . . . . . . . . . . . . . . . . . ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/next-node.xpm b/xemacs-packages/gnus/etc/gnus/next-node.xpm deleted file mode 100644 index 385766e5..00000000 --- a/xemacs-packages/gnus/etc/gnus/next-node.xpm +++ /dev/null @@ -1,45 +0,0 @@ -/* XPM */ -static char * next_node2_xpm[] = { -"24 24 18 1", -" c None", -". c #000000", -"+ c #FFFFFF", -"@ c #DADAD6", -"# c #BCBCB8", -"$ c #506B46", -"% c #778E6F", -"& c #0F1308", -"* c #77A16E", -"= c #C2D7BE", -"- c #6B9060", -"; c #A9C7A6", -"> c #C1D6BD", -", c #BDD3B8", -"' c #B0CAAD", -") c #A4C3A2", -"! c #445B2C", -"~ c #8CA782", -" .................. ", -" .+++++++++++++++@#. ", -" .+++++++++++++++#+#. ", -" .+++$#++++++++++#%$&. ", -" .+++..#@++++++++@%$&. ", -" .+++.*.#@@+@++++++@#. ", -" .+@@.=-.#@@++@@@@@@#. ", -".......=;-.#@@@+@@@@@#. ", -".=>>>>>,;;-.#@@@@@@@@#. ", -".=;;;;';;;;-.##@@@@@@#. ", -".@>,,,>,,,,;-.#@@@@@@#. ", -".)----------!.%#@@@@@#. ", -".~---------!.%##@@@@##. ", -".*--------!.$%##@@@@@#. ", -".......--!.%####@@@@@#. ", -" .##%.-!.$%####@@@@##. ", -" .@##.!.%####@####@##. ", -" .+##..%%#####@@@@@@#. ", -" .+@#.#####@@@####@@#. ", -" .+@@#####@@@@####@##. ", -" .+##################. ", -" ..................... ", -" ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/next-page.pbm b/xemacs-packages/gnus/etc/gnus/next-page.pbm deleted file mode 100644 index fbf7eaec0c3795ff4044ec27bbe634980d78cac8..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 81 zcmWGA;W9E&Ff!p{00aBuKN1Xh5*WaUg(rcHCxM+Op}q%10@*+jh!mKtfB(n+{~rbm Ih*l^G0E;3Im;e9( diff --git a/xemacs-packages/gnus/etc/gnus/next-page.xpm b/xemacs-packages/gnus/etc/gnus/next-page.xpm deleted file mode 100644 index 75236fee..00000000 --- a/xemacs-packages/gnus/etc/gnus/next-page.xpm +++ /dev/null @@ -1,119 +0,0 @@ -/* XPM */ -static char * stock_next_page_xpm[] = { -"24 24 92 2", -" c None", -". c #000000", -"+ c #5B7289", -"@ c #FFFFFF", -"# c #F2F2F2", -"$ c #E5E5E5", -"% c #D8D8D8", -"& c #CCCCCC", -"* c #B0B0B0", -"= c #8B8B8B", -"- c #6A6A6A", -"; c #494949", -"> c #888888", -", c #C9C9C9", -"' c #E3E3E3", -") c #EEEEEE", -"! c #E6E6E6", -"~ c #DEDEDE", -"{ c #D6D6D6", -"] c #ADADAD", -"^ c #556D85", -"/ c #47617B", -"( c #BFBFBF", -"_ c #B2B2B2", -": c #ACACAC", -"< c #A6A6A6", -"[ c #F6F6F6", -"} c #384F66", -"| c #3A5067", -"1 c #DADADA", -"2 c #3A5168", -"3 c #D3D3D3", -"4 c #3B5269", -"5 c #47617C", -"6 c #3D526A", -"7 c #48627D", -"8 c #B6B6B6", -"9 c #959595", -"0 c #7C7C7C", -"a c #616161", -"b c #464646", -"c c #262626", -"d c #C5C5C5", -"e c #3E546A", -"f c #49637D", -"g c #3F556B", -"h c #4B647E", -"i c #40566C", -"j c #4C647F", -"k c #41576D", -"l c #4C657F", -"m c #42586E", -"n c #4E6780", -"o c #44586F", -"p c #4F6881", -"q c #B5B5B5", -"r c #45596F", -"s c #506982", -"t c #77838F", -"u c #9C9FA1", -"v c #91969C", -"w c #91979C", -"x c #92979C", -"y c #92979D", -"z c #A2A3A4", -"A c #9D9FA2", -"B c #8F9296", -"C c #8F9396", -"D c #8F9397", -"E c #909397", -"F c #868788", -"G c #465B70", -"H c #526A83", -"I c #3E5975", -"J c #3F5A76", -"K c #415B77", -"L c #425C78", -"M c #435E79", -"N c #445F7A", -"O c #46607B", -"P c #68727D", -"Q c #7D8185", -"R c #616A73", -"S c #3B4F63", -"T c #3C5064", -"U c #3C5065", -"V c #3E5166", -"W c #3F5266", -"X c #405367", -"Y c #405468", -"Z c #344353", -"` c #2F4050", -" ", -" ", -" . . . . . . . . . . . . . . . . ", -" . + @ # $ % & * = - ; > , ' ) ! ~ { ] ^ . ", -" . / @ # $ % & ( _ : < @ @ [ ) ! ~ { _ } . ", -" . / @ # $ % & ( _ : < @ ' [ ) ! ~ { _ | . ", -" . / @ # $ % & ( _ : < @ . 1 ) ! ~ { * 2 . ", -" . / @ # $ % & ( _ : < @ . . 3 ! ~ { * 4 . ", -" . 5 @ # $ % & ( _ : < @ . . . & ~ { * 6 . ", -" . 7 @ # $ 8 9 0 a b c . . . . . d { * e . ", -" . f @ # $ % & ( _ : < @ . . . & ~ { * g . ", -" . h @ # $ % & ( _ : < @ . . 3 ! ~ { * i . ", -" . j @ # $ % & ( _ : < @ . 1 ) ! ~ { * k . ", -" . l @ # $ % & ( _ : < @ ' [ ) ! ~ { * m . ", -" . n @ # $ % & ( _ : < @ @ [ ) ! ~ { * o . ", -" . p @ # $ % & ( _ : < @ @ [ ) ! ~ { q r . ", -" . s t u v w x y y z < A B C C D D E F G . ", -" . H I J K L M N O P Q R S T U V W X Y Z . ", -" . . . . . . . . . ` . . . . . . . . . . ", -" . . . ", -" ", -" ", -" ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/next-ur.pbm b/xemacs-packages/gnus/etc/gnus/next-ur.pbm deleted file mode 100644 index 678bbb09f8bb27ac63913086163e3b41e264bc5d..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 81 zcmWGA;W9E&Ff!p1WE5avU}69QK8C*v$E&(A-7Zex;1h_N| j1Y86h8aNzSB-EKV1h_Z|cqj-2C`fQ9xUybhVQ>Hd!Ws;4 diff --git a/xemacs-packages/gnus/etc/gnus/next-ur.xpm b/xemacs-packages/gnus/etc/gnus/next-ur.xpm deleted file mode 100644 index bea13280..00000000 --- a/xemacs-packages/gnus/etc/gnus/next-ur.xpm +++ /dev/null @@ -1,35 +0,0 @@ -/* XPM */ -static char * next_ur_xpm[] = { -"24 24 8 1", -". c None", -" c #000000000000", -"X c #A5A5A5A59595", -"o c #C7C7C6C6C6C6", -"O c #FFFF00000000", -"+ c #9A9A6C6C4E4E", -"@ c #E1E1E0E0E0E0", -"# c #FFFFFFFFFFFF", -" .. .. .. .. .. .. .. ..", -"........................", -"............X...........", -" .. .. .. .XXX. .. .. ..", -".........XXooOX.........", -".......XXooo+O@X........", -" .. XXXoooo++@@@X. .. ..", -"....X@Xoooooo@@@X.......", -"....X@@Xooo@@@@@@X......", -" .. X@@XXoo@@@@@@@X.. ..", -"....X@@Xoo@@@@@@@@@X....", -"....X@Xo@@@XX@@@@@@oX...", -" .. oXoo@XXooO@@@@@@X ..", -"....oXoXXooo+OX@@@@Xo...", -"....XXXoooo++@@X@@Xo....", -" .. X@Xoooooo@@@XX .. ..", -"....X@@Xooo@@@@@@X......", -"....X@@XXoo@@@@@@@X.....", -" .. X@@Xoo@@@@@@@@@X. ..", -"....X@Xo@ @@@@@@@ X...", -"... oXoo ## @@ @@ ## ...", -" .. oXo #### @ #### ..", -".....oX #### @@@ #### ..", -".....oX@ ## @@@@X ## ..."}; diff --git a/xemacs-packages/gnus/etc/gnus/not-spam.xpm b/xemacs-packages/gnus/etc/gnus/not-spam.xpm deleted file mode 100644 index f8db326a..00000000 --- a/xemacs-packages/gnus/etc/gnus/not-spam.xpm +++ /dev/null @@ -1,149 +0,0 @@ -/* XPM */ -static char * stock_not_spam_xpm[] = { -"24 24 122 2", -" c None", -". c #1D1E1E", -"+ c #333839", -"@ c #393F40", -"# c #171819", -"$ c #B2B8B9", -"% c #D5E3E7", -"& c #AABABD", -"* c #64696A", -"= c #0C0D0D", -"- c #929C9E", -"; c #E7F0F3", -"> c #EDF0F1", -", c #E5EDEF", -"' c #C5D9DD", -") c #2E3132", -"! c #3F4343", -"~ c #1F2121", -"{ c #DFEBEE", -"] c #B7C4C8", -"^ c #D2D9DA", -"/ c #E1EFF2", -"( c #B6CBCF", -"_ c #3C4547", -": c #1E2223", -"< c #191E1F", -"[ c #2D2E2F", -"} c #191A1A", -"| c #252829", -"1 c #7E8E92", -"2 c #B7C2C3", -"3 c #C3D9DD", -"4 c #9CACB0", -"5 c #C3CDCE", -"6 c #C7E1E7", -"7 c #668F97", -"8 c #90ACB2", -"9 c #CDDDE1", -"0 c #485559", -"a c #88A6AC", -"b c #1F2223", -"c c #3F4545", -"d c #242728", -"e c #313B3E", -"f c #A8C2C8", -"g c #B2BDC0", -"h c #CFE5E9", -"i c #C2D9DE", -"j c #81989C", -"k c #A2C0C5", -"l c #85A9B1", -"m c #E5ECEE", -"n c #E7F2F4", -"o c #9BAEB3", -"p c #C8E1E7", -"q c #3A3E3F", -"r c #0C0E0E", -"s c #000000", -"t c #333737", -"u c #B3C2C5", -"v c #DDEDF0", -"w c #D8E4E6", -"x c #DAECEF", -"y c #D5E9ED", -"z c #D2E7EC", -"A c #95ADB2", -"B c #DBE2E2", -"C c #EDEFF0", -"D c #A2B1B3", -"E c #8FA4A8", -"F c #D7E2E5", -"G c #798F94", -"H c #151819", -"I c #F3B5A7", -"J c #865E55", -"K c #AFB9BB", -"L c #F1F8F9", -"M c #F7FBFB", -"N c #D9EBEF", -"O c #ECF4F6", -"P c #F3F7F7", -"Q c #E9F2F4", -"R c #EEF2F3", -"S c #E9EDEE", -"T c #C5C8C9", -"U c #C2C6C8", -"V c #E0E7E7", -"W c #DDEAED", -"X c #7A9DA5", -"Y c #EB8169", -"Z c #B83618", -"` c #924E3C", -" . c #9FA5A6", -".. c #E3EEF0", -"+. c #ECF5F7", -"@. c #D6EAED", -"#. c #CBE4E9", -"$. c #747C7D", -"%. c #B43518", -"&. c #E76A4D", -"*. c #B53F24", -"=. c #CB705A", -"-. c #C4D8DB", -";. c #D2E6E9", -">. c #CAE3E8", -",. c #A9C8CF", -"'. c #EC927D", -"). c #E66F54", -"!. c #D26951", -"~. c #F1A897", -"{. c #E76547", -"]. c #C58B7D", -"^. c #A8ABAC", -"/. c #70A1AB", -"(. c #DF421E", -"_. c #C43A1A", -":. c #E17055", -"<. c #DD8D7A", -"[. c #FFFFFF", -"}. c #030505", -"|. c #A2432E", -"1. c #AC3316", -" ", -" ", -" . + @ ", -" # $ % & * . ", -" = - ; > , ' ) ! ", -" ~ { ] ^ / ( _ : < [ } ", -" | 1 2 3 4 5 6 7 8 9 0 a b ", -" c d e f g h i j k l m n o p q r ", -" s t u v w / x y z A B C D E F G H ", -" s s I J K L M N O P Q R S T U V W X < ", -"s I Y Z ` ...+.@.#.$.s s s s s s s s s s s s ", -"s %.&.Y *.=.-.;.>.,.s '.).).).).).).).).).).!.s ", -"s %.%.%.&.~.{.].^./.s ).(.(.(.(.(.(.(.(.(.(._.s ", -"s %.%.%.%.%.&.~.:.<.s ).(.[.[.(.(.(.(.[.[.(._.s ", -" s s %.%.%.%.%.&.~.s ).(.[.[.[.(.(.[.[.[.(._.s ", -" s s %.%.%.%.%.s ).(.(.[.[.[.[.[.[.(.(._.s ", -" s s %.%.%.s ).(.(.(.[.[.[.[.(.(.(._.s ", -" }.s s |.s ).(.(.(.[.[.[.[.(.(.(._.s ", -" s s s ).(.(.[.[.[.[.[.[.(.(._.s ", -" s ).(.[.[.[.(.(.[.[.[.(._.s ", -" s ).(.[.[.(.(.(.(.[.[.(._.s ", -" s ).(.(.(.(.(.(.(.(.(.(._.s ", -" s !._._._._._._._._._._.1.s ", -" s s s s s s s s s s s s "}; diff --git a/xemacs-packages/gnus/etc/gnus/oort.xface b/xemacs-packages/gnus/etc/gnus/oort.xface deleted file mode 100644 index 6444b55e..00000000 --- a/xemacs-packages/gnus/etc/gnus/oort.xface +++ /dev/null @@ -1,3 +0,0 @@ -X-Face: $BP*2z+\?fNM."!*~JsIgw(Y]n?WG!KMc;^jL$SLrt@X4%uMguO/$3HO<5@43P@[~'kE'fG - #YdP[sb6IJ5|Sm[z#9sI|)iJ})U5;Rt-?jI3i24zoJmonTV}kTVOm/5wMCnc3P~d#+BF1c&N6mdF{u - CE+<;lN!v~JRyR"q0d5<\y]faXpTC4,wpQ{=<==?LRA`}3qqIgr diff --git a/xemacs-packages/gnus/etc/gnus/open.xpm b/xemacs-packages/gnus/etc/gnus/open.xpm deleted file mode 100644 index 6b95c7e4..00000000 --- a/xemacs-packages/gnus/etc/gnus/open.xpm +++ /dev/null @@ -1,200 +0,0 @@ -/* XPM */ -static char * open_xpm[] = { -"24 24 173 2", -" c None", -". c #000000", -"+ c #010100", -"@ c #B5B8A5", -"# c #E4E7D2", -"$ c #878A76", -"% c #33342B", -"& c #0B0B0B", -"* c #E2E5CF", -"= c #CFD4AF", -"- c #CED3AE", -"; c #B2B696", -"> c #2D2D25", -", c #23241D", -"' c #9D9F90", -") c #C6CAA6", -"! c #C4C9A5", -"~ c #C6CBA7", -"{ c #C7CCA8", -"] c #C9CEA9", -"^ c #555847", -"/ c #1A1B15", -"( c #20201A", -"_ c #D4D6C2", -": c #BEC2A0", -"< c #B3B896", -"[ c #B0B595", -"} c #B3B797", -"| c #B6BB99", -"1 c #BBC09E", -"2 c #BCC19F", -"3 c #81856C", -"4 c #3E3F32", -"5 c #010101", -"6 c #DADDC8", -"7 c #AFB494", -"8 c #AAAF8F", -"9 c #A3A789", -"0 c #A6AA8B", -"a c #A9AD8E", -"b c #A7AB8D", -"c c #A4A88A", -"d c #A1A588", -"e c #AAAD96", -"f c #B3B5A5", -"g c #B8BBAA", -"h c #BABCAB", -"i c #C1C3B2", -"j c #C7CAB7", -"k c #CACDBB", -"l c #BABDA8", -"m c #0C0C09", -"n c #DDDFCB", -"o c #969B7E", -"p c #9DA286", -"q c #95987C", -"r c #96997E", -"s c #9A9D81", -"t c #999D80", -"u c #9DA184", -"v c #A5AA8B", -"w c #A4A98A", -"x c #A3A889", -"y c #A2A588", -"z c #A2A587", -"A c #9FA386", -"B c #9B9E83", -"C c #898D74", -"D c #D8DBC9", -"E c #84866E", -"F c #7D8169", -"G c #151612", -"H c #D7DAC9", -"I c #797D67", -"J c #3D3F34", -"K c #E0E0D9", -"L c #EBEDDD", -"M c #E8EBD9", -"N c #E7EAD8", -"O c #E3E6D4", -"P c #DEE1D0", -"Q c #DADCCC", -"R c #DADCD1", -"S c #2B2C28", -"T c #D7DAC6", -"U c #6F735E", -"V c #0D0D0D", -"W c #F4F4EC", -"X c #CACFAB", -"Y c #C6CBA8", -"Z c #C2C6A4", -"` c #ABB091", -" . c #23251E", -".. c #494B3D", -"+. c #DCDCD4", -"@. c #EAECDD", -"#. c #CDD2AD", -"$. c #CCD1AC", -"%. c #CACFAA", -"&. c #BABF9D", -"*. c #B5B999", -"=. c #81836C", -"-. c #070806", -";. c #D5D8C4", -">. c #161616", -",. c #F2F2EA", -"'. c #C9CEAA", -"). c #C8CDA9", -"!. c #C4C9A6", -"~. c #C1C5A3", -"{. c #BCC09F", -"]. c #B6BB9A", -"^. c #B0B494", -"/. c #9DA185", -"(. c #535445", -"_. c #B6B8A7", -":. c #747470", -"<. c #ECECE2", -"[. c #C3C8A5", -"}. c #C2C7A4", -"|. c #C0C5A2", -"1. c #BFC4A1", -"2. c #BDC2A0", -"3. c #B9BD9C", -"4. c #B9BE9D", -"5. c #A9AD8F", -"6. c #A3A78A", -"7. c #80836D", -"8. c #020201", -"9. c #A6A998", -"0. c #B8BC9B", -"a. c #AFB394", -"b. c #ACB091", -"c. c #A8AC8E", -"d. c #A6AA8C", -"e. c #9FA286", -"f. c #9B9F83", -"g. c #9A9D82", -"h. c #8A8D75", -"i. c #4F5243", -"j. c #070705", -"k. c #9E9F91", -"l. c #E5E6DA", -"m. c #ADB192", -"n. c #A5A98C", -"o. c #9FA387", -"p. c #999D81", -"q. c #95987E", -"r. c #92957B", -"s. c #8C8F76", -"t. c #8A8D74", -"u. c #71735F", -"v. c #080908", -"w. c #E3E5D9", -"x. c #C0C3AF", -"y. c #94987C", -"z. c #8F9379", -"A. c #8B8F75", -"B. c #8A8E74", -"C. c #888C73", -"D. c #858970", -"E. c #868971", -"F. c #82866E", -"G. c #80836C", -"H. c #7D8069", -"I. c #797C66", -"J. c #727560", -"K. c #717460", -"L. c #71745F", -"M. c #6A6D59", -"N. c #434538", -"O. c #080907", -"P. c #050504", -" ", -" ", -" ", -" . . . . . . . ", -" + @ # # # # # $ % ", -" & * = = = - - ; > ", -", ' * ) ! ~ { ] ] ^ / ", -"( _ : < [ } | 1 2 3 4 5 . . . . . . . ", -", 6 7 8 9 0 8 a b c d e f g h i j k l . ", -"m n o p q r s t r u v w x y 9 z A B C . ", -". D E F G . . . . . . . . . . . . . . . 5 5 ", -". H I J K L M M M M M M M M M M M N O P Q R S ", -". T U V W = = = = = = = = = - - - X Y Z 1 ` . ", -". T ..+.@.#.- - #.- #.#.#.#.#.$.%.Y Z &.*.=.-. ", -". ;.>.,.X %.X %.'.%.'.{ ).).Y !.~.{.].^./.(.m ", -". _.:.<.[.}.}.Z |.Z 1.2.|.2.3.4.} [ 5.6.7.8. ", -". 9.+.0.0.*.} } [ [ a.a.a.b.c.d.e.f.g.h.i.j. ", -". k.l.m.5.d.n.6.6.d o.e.f.p.q.r.s.t.t.u.v. ", -". w.x.y.z.A.B.C.C.D.E.F.G.H.I.J.K.L.M.N.O. ", -" . . . . . . . . . . . . . . . . . . P. ", -" ", -" ", -" ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/outbox.xpm b/xemacs-packages/gnus/etc/gnus/outbox.xpm deleted file mode 100644 index 58b5212b..00000000 --- a/xemacs-packages/gnus/etc/gnus/outbox.xpm +++ /dev/null @@ -1,96 +0,0 @@ -/* XPM */ -static char * stock_outbox_xpm[] = { -"24 24 69 1", -" c None", -". c #000000", -"+ c #E66040", -"@ c #EE937E", -"# c #E55E3F", -"$ c #E1431F", -"% c #EC8770", -"& c #F0A08E", -"* c #F3B7A9", -"= c #EF9985", -"- c #E76749", -"; c #ED8C75", -"> c #F5BEB1", -", c #F3B4A5", -"' c #F4B8AA", -") c #F1A593", -"! c #E55B3B", -"~ c #E45534", -"{ c #F4BDB0", -"] c #F4BAAC", -"^ c #EF9C89", -"/ c #E34E2B", -"( c #C0391A", -"_ c #8A2912", -": c #3E3E3C", -"< c #D4D3D2", -"[ c #DB411D", -"} c #F1A999", -"| c #D23E1C", -"1 c #812611", -"2 c #C7C7C5", -"3 c #ACABA8", -"4 c #6A6966", -"5 c #E9775D", -"6 c #CECDCC", -"7 c #A93217", -"8 c #9B9A97", -"9 c #494846", -"0 c #9A9996", -"a c #BBBBB9", -"b c #747370", -"c c #A5A4A1", -"d c #AAA9A6", -"e c #686765", -"f c #7D7C79", -"g c #686764", -"h c #9C9B98", -"i c #999895", -"j c #ABAAA7", -"k c #A9A8A5", -"l c #AF3417", -"m c #E55D3D", -"n c #C5C5C3", -"o c #8D8C89", -"p c #626260", -"q c #B2B1AE", -"r c #A7A6A3", -"s c #B4B4B2", -"t c #C3C3C1", -"u c #92918E", -"v c #D1D0CF", -"w c #373735", -"x c #CACAC8", -"y c #A8A7A4", -"z c #CCCCCA", -"A c #52514E", -"B c #C8C8C6", -"C c #B5B5B3", -"D c #7E7D7A", -" . ", -" .. ", -" .+. ", -" ....@#. ", -" .$%&*=@-. ", -" .;>,')@@@!. ", -" .~{]*^@@@@@-.", -" ...@>/((((((_. ", -" .:<.[}|((((((1. ", -" ..234.5+(_...(1. ", -" ..63444.@(7...._. ", -" ..6344448.@(.90a.. ", -".634444bcd.#$.eff.a.. ", -".gh34bijkk.lm.iffff0a. ", -".ggghniikdo..pddiffffq. ", -".ggggghniikdkkkdddiffr. ", -" ..ggggghniikdkkdddsta. ", -" ..ggggghnurdkksvvw. ", -" ..gggggxrdyzvA.. ", -" ...gggB3qCA.. ", -" ...gDv... ", -" ..... ", -" ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/paste.xpm b/xemacs-packages/gnus/etc/gnus/paste.xpm deleted file mode 100644 index cdd86366..00000000 --- a/xemacs-packages/gnus/etc/gnus/paste.xpm +++ /dev/null @@ -1,116 +0,0 @@ -/* XPM */ -static char * paste_xpm[] = { -"24 24 89 1", -" c None", -". c #000000", -"+ c #B9B9B9", -"@ c #FEFEFE", -"# c #F9F9F9", -"$ c #757575", -"% c #F5F5E8", -"& c #565651", -"* c #FFFFFF", -"= c #A0A0A0", -"- c #939393", -"; c #7C7C7C", -"> c #C5C5BB", -", c #CFC6A0", -"' c #D7CEAA", -") c #ADA689", -"! c #4B483C", -"~ c #6D6D6D", -"{ c #6C6C6C", -"] c #A9A9A9", -"^ c #3D3A30", -"/ c #979178", -"( c #C1B898", -"_ c #8A793D", -": c #C3BB9A", -"< c #AFA78A", -"[ c #444236", -"} c #FAFAFA", -"| c #EFEFEF", -"1 c #C7C7C7", -"2 c #D8D8D8", -"3 c #D2D2D2", -"4 c #7B7B7B", -"5 c #302E26", -"6 c #89846C", -"7 c #C4BC9A", -"8 c #847235", -"9 c #C5C5C5", -"0 c #A7A7A7", -"a c #ADADAD", -"b c #9A9A9A", -"c c #9B9B9B", -"d c #868686", -"e c #424242", -"f c #847033", -"g c #C9C09E", -"h c #464337", -"i c #35332A", -"j c #2D2B23", -"k c #C6BE9D", -"l c #826F33", -"m c #7F7964", -"n c #4C493C", -"o c #171612", -"p c #13120F", -"q c #3E3B31", -"r c #282210", -"s c #474438", -"t c #B3B3B3", -"u c #D6D6D6", -"v c #B7AE90", -"w c #B1AA8C", -"x c #37352B", -"y c #151410", -"z c #8F8F8F", -"A c #989898", -"B c #C6C6C6", -"C c #B9B293", -"D c #11100D", -"E c #434035", -"F c #636363", -"G c #767676", -"H c #AAA48B", -"I c #A5A086", -"J c #A19A7F", -"K c #312F26", -"L c #AFA88C", -"M c #050403", -"N c #12110E", -"O c #A9A489", -"P c #A39E85", -"Q c #EBE7D0", -"R c #D2C9A5", -"S c #A29053", -"T c #8E7C3D", -"U c #88793B", -"V c #806C2F", -"W c #78652B", -"X c #251F0C", -" .... ", -" ......+@#$...... ", -".%%%%%&*=-;&>%%%,. ", -".%''')!*~{]^/(''_. ", -".%::<[}|123456<78. ", -".%''!900abcde!)'f. ", -".%g:6hijjjjj56(E({?|3<|;w2Fwgb fj0^${4IF_D5)2Lnj*c!I>I@7rAbo)@B0v%Vy;usB diff --git a/xemacs-packages/gnus/etc/gnus/post.xpm b/xemacs-packages/gnus/etc/gnus/post.xpm deleted file mode 100644 index 7a3eaa5e..00000000 --- a/xemacs-packages/gnus/etc/gnus/post.xpm +++ /dev/null @@ -1,35 +0,0 @@ -/* XPM */ -static char * post_xpm[] = { -"24 24 8 1", -". c None", -" c #434343434343", -"X c #A5A5A5A59595", -"O c #000000000000", -"+ c #C7C7C6C6C6C6", -"@ c #FFFF00000000", -"# c #9A9A6C6C4E4E", -"$ c #E1E1E0E0E0E0", -"O..O..O..O..O..O..O..O..", -"........................", -"............X...........", -"O..O..O..O.XXX.O..O..O..", -".........XX++@X.........", -".......XX+++#@$X........", -"O..OXXX++++##$$$X.O..O..", -"....X$X++++++$$$X.......", -"....X$$X+++$$$$$$X......", -"O..OX$$XX++$$$$$$$X..O..", -"....X$$X++$$$$$$$$$X....", -"....X$X+$$$$$$$$$$$+X...", -"O..O+X++$$$$$$$$$$$$XO..", -"....+X+$$$$$$$$$$$$X+...", -".....+X$$$$$$$$$$$X+....", -"O..O.+X$$$$$$$$$XXO..O..", -"......+X$$$$$$$X++......", -"......+X$$$$$XX+........", -"O..O..O+X$$$X++O..O..O..", -".......+X$$X++..........", -"........+XX+............", -"O..O..O..O+.O..O..O..O..", -"........................", -"........................"}; diff --git a/xemacs-packages/gnus/etc/gnus/preferences.xpm b/xemacs-packages/gnus/etc/gnus/preferences.xpm deleted file mode 100644 index 3cdc884d..00000000 --- a/xemacs-packages/gnus/etc/gnus/preferences.xpm +++ /dev/null @@ -1,114 +0,0 @@ -/* XPM */ -static char * preferences_xpm[] = { -"24 24 87 1", -" c None", -". c #000000", -"+ c #BAB5AB", -"@ c #D0CDC6", -"# c #88857D", -"$ c #C9C6BE", -"% c #CCC8C1", -"& c #E5E3E0", -"* c #FFFFFF", -"= c #757575", -"- c #2E2E2E", -"; c #F6F5F5", -"> c #CCCCCC", -", c #AFAFAF", -"' c #D3D1CB", -") c #C1C0BF", -"! c #F0EFED", -"~ c #797772", -"{ c #DCDCDC", -"] c #A5A19C", -"^ c #EAE9E5", -"/ c #F3F1F0", -"( c #EDEDED", -"_ c #A19D96", -": c #C1BDB4", -"< c #DBD8D3", -"[ c #D9D6D1", -"} c #89857E", -"| c #FCFCFC", -"1 c #EAE9E6", -"2 c #F5F4F3", -"3 c #C6C2BA", -"4 c #F0EFEE", -"5 c #F4F4F3", -"6 c #CBC7C0", -"7 c #ECECEB", -"8 c #676560", -"9 c #54524D", -"0 c #777676", -"a c #797978", -"b c #85827E", -"c c #79756F", -"d c #7590AE", -"e c #A4BAD0", -"f c #90A6BE", -"g c #9F9F9E", -"h c #BEBDBC", -"i c #B8B4AD", -"j c #87837C", -"k c #D3DFEA", -"l c #A2AEBC", -"m c #9DB6CE", -"n c #637B95", -"o c #E2E2E2", -"p c #EEEEED", -"q c #849CB6", -"r c #D7E2ED", -"s c #8D98A5", -"t c #9DB8D2", -"u c #607791", -"v c #EDEDEC", -"w c #99ADC3", -"x c #DFE7F0", -"y c #8193A9", -"z c #586D84", -"A c #5B7189", -"B c #F1F1F1", -"C c #EEEDEB", -"D c #A7A6A5", -"E c #726F6A", -"F c #A1B4C8", -"G c #EEF3F6", -"H c #60768F", -"I c #DEDDDC", -"J c #787776", -"K c #4E4E4D", -"L c #91A6BE", -"M c #F0F4F7", -"N c #97A5B6", -"O c #BFBEBD", -"P c #AAAAA9", -"Q c #ACACAB", -"R c #B0C6DB", -"S c #EDF2F6", -"T c #818A95", -"U c #6C85A1", -"V c #C0D1E2", -" .. ", -" .+@#. ", -" .$%+. .. ", -" .&$. .*=. ", -" .. -;$. .*>,. ", -" .' ..)!+~. .{,. ", -" .]%%^/+++. .(.. ", -" ._:%$<[+}. .|. ", -" .....123}..>. ", -" .456.,. ", -" .7.,.. ", -" .,.89. ", -" ....,.0abc. ", -" .def.. .ghij. ", -" .dklmn. .op6}. ", -" .qrsntu. .v/$}. ", -" .wxyztdA. .BCDE..", -" .FGyHtdA. .IJK,.", -" .LMNHtdA. .OPQ.", -" .RSTtdA.. ... ", -" .UtVLA.. ", -" .UUn.. ", -" ... ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/prev-node.xpm b/xemacs-packages/gnus/etc/gnus/prev-node.xpm deleted file mode 100644 index 586bf9c4..00000000 --- a/xemacs-packages/gnus/etc/gnus/prev-node.xpm +++ /dev/null @@ -1,44 +0,0 @@ -/* XPM */ -static char * prev_node3_xpm[] = { -"24 24 17 1", -" c None", -". c #000000", -"+ c #0F1308", -"@ c #FFFFFF", -"# c #BCBCB8", -"$ c #DADAD6", -"% c #778E6F", -"& c #C2D7BE", -"* c #A6BFA0", -"= c #A9C7A6", -"- c #BDD3B8", -"; c #B0CAAD", -"> c #C1D6BD", -", c #8CA782", -"' c #5B7950", -") c #6B9060", -"! c #445B2C", -" .................. ", -" +@#@@@@@@@@@@@@@@$. ", -" +@@%$@@@@@@@@@@@@@$. ", -" .$#%%$@@@@@@@@@$.$$$. ", -" .%$##$@@@@@@@@#..$$$. ", -" .#@@@@@@@@@$$#.&.#$$. ", -" .$@@@@@@@@@@#.$*.##$. ", -" .@@@@@@@@$$#.$=*.......", -" .@@@@@@@$$#.$==-&&&&&*.", -" .@@@@@@@$#.@====;====%.", -" .@$@$$$$#.$>>>>>>>>>>,.", -" .@$@$$$$#.'))))))))))!.", -" .@$$$$$$##.')))))))))!.", -" .@$$$$$$##%.')))'!!!!!.", -" .@$$$$$##$#%.')!.......", -" .@$$$$$$$###%.'!.%%%. ", -" .@$$#####$$##%.!.%##. ", -" .@$$$$$$$#####%..###. ", -" .@$$#####$$$###%.###. ", -" .@$$$$$$$$$$$#######. ", -" .@##################. ", -" ..................... ", -" ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/prev-ur.pbm b/xemacs-packages/gnus/etc/gnus/prev-ur.pbm deleted file mode 100644 index 49389198bdfe19f91dada91a4525e35083e4c3df..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 81 zcmWGA;W9E&Ff!p1WE5avU}69QK8C*v%E&(BI7iNeGvT$j$ d2>7x%G|X^d2~c2a2w-Fo03(nZh7cA82LRz}3_<_^ diff --git a/xemacs-packages/gnus/etc/gnus/prev-ur.xpm b/xemacs-packages/gnus/etc/gnus/prev-ur.xpm deleted file mode 100644 index 80131332..00000000 --- a/xemacs-packages/gnus/etc/gnus/prev-ur.xpm +++ /dev/null @@ -1,35 +0,0 @@ -/* XPM */ -static char * prev_ur_xpm[] = { -"24 24 8 1", -". c None", -" c #000000000000", -"X c #A5A5A5A59595", -"o c #C7C7C6C6C6C6", -"O c #FFFF00000000", -"+ c #9A9A6C6C4E4E", -"@ c #E1E1E0E0E0E0", -"# c #FFFFFFFFFFFF", -" .. .. .. .. .. .. .. ..", -"........................", -"............X...........", -" .. .. .. .XXX. .. .. ..", -".........XXooOX.........", -".......XXooo+O@X........", -" .. XXXoooo++@@@X. .. ..", -"....X@Xoooooo@@@X.......", -"....X@@Xooo@@@@@@X......", -" .. X@@XXoo@@@@@@@X.. ..", -"....X@@Xo @@@@@@ X....", -"....X@Xo ## X @ ## X...", -" .. oXo #XXXoO@ #### ..", -"....oXoXXooo+OX #### ...", -"....XXXoooo++@@X ## ....", -" .. X@Xoooooo@@@X .. ..", -"....X@@Xooo@@@@@@X......", -"....X@@XXoo@@@@@@@X.....", -" .. X@@Xoo@@@@@@@@@X. ..", -"....X@Xo@@@@@@@@@@@@X...", -"... oXoo@@@@@@@@@@@@X...", -" .. oXo@@@@@@@@@@@@X....", -".....oX@@@@@@@@@@@X.....", -".....oX@@@@@@@@@@X......"}; diff --git a/xemacs-packages/gnus/etc/gnus/preview.xbm b/xemacs-packages/gnus/etc/gnus/preview.xbm deleted file mode 100644 index a42e153d..00000000 --- a/xemacs-packages/gnus/etc/gnus/preview.xbm +++ /dev/null @@ -1,10 +0,0 @@ -#define preview_width 24 -#define preview_height 24 -static char preview_bits[] = { - 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, - 0x00,0xc0,0x03,0x00,0x3e,0x06,0xf0,0x03,0x04,0x08,0x00,0x0a,0x78,0x00,0x09, - 0x88,0xf9,0x08,0x10,0xc6,0x10,0x10,0x3a,0x13,0x10,0x06,0x15,0x20,0x02,0x29, - 0x20,0x02,0x31,0x20,0xad,0x0f,0x40,0xf9,0x03,0xc0,0xb8,0x07,0x80,0x07,0x0e, - 0x80,0x01,0x1c,0x00,0x00,0x18,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc8,0x00, - 0x00,0x00,0x39,0x00,0x00,0x00,0x08,0xc0,0x12,0x42,0x00,0x00,0x00,0x00,0x38, - 0x82,0x18,0x08,0x00,0x00,0x00 }; diff --git a/xemacs-packages/gnus/etc/gnus/preview.xpm b/xemacs-packages/gnus/etc/gnus/preview.xpm deleted file mode 100644 index 563a267e..00000000 --- a/xemacs-packages/gnus/etc/gnus/preview.xpm +++ /dev/null @@ -1,178 +0,0 @@ -/* XPM */ -static char * mail_preview_xpm[] = { -"24 24 151 2", -" c None", -". c #343434", -"+ c #2D2D2D", -"@ c #292929", -"# c #262626", -"$ c #2E2E2E", -"% c #303030", -"& c #737373", -"* c #A1A1A1", -"= c #B4B4B4", -"- c #B2B2B2", -"; c #9D9D9D", -"> c #676767", -", c #202020", -"' c #1C1C1C", -") c #272727", -"! c #616161", -"~ c #CACACA", -"{ c #CFCFCF", -"] c #D0D0D0", -"^ c #CECECE", -"/ c #C9C9C9", -"( c #C1C1C1", -"_ c #A7A7A7", -": c #4C4C4C", -"< c #131313", -"[ c #222222", -"} c #757575", -"| c #D3D3D3", -"1 c #DBDBDB", -"2 c #E7E7E7", -"3 c #EFEFEF", -"4 c #F3F3F3", -"5 c #F1F1F1", -"6 c #E5E5E5", -"7 c #D2D2D2", -"8 c #BCBCBC", -"9 c #5E5E5E", -"0 c #101010", -"a c #212121", -"b c #5B5B5B", -"c c #CCCCCC", -"d c #D7D7D7", -"e c #F5F5F5", -"f c #FAFAFA", -"g c #FBFBFB", -"h c #F8F8F8", -"i c #F0F0F0", -"j c #E1E1E1", -"k c #C2C2C2", -"l c #434343", -"m c #0F0F0F", -"n c #1F1F1F", -"o c #B9B9B9", -"p c #D4D4D4", -"q c #F7F7F7", -"r c #F9F9F9", -"s c #F6F6F6", -"t c #EAEAEA", -"u c #E2E2E2", -"v c #ABABAB", -"w c #0E0E0E", -"x c #000000", -"y c #111111", -"z c #686868", -"A c #9C9C9C", -"B c #808080", -"C c #8E8E8E", -"D c #919191", -"E c #929292", -"F c #949494", -"G c #939393", -"H c #8B8B8B", -"I c #838383", -"J c #A3A3A3", -"K c #555555", -"L c #080808", -"M c #535353", -"N c #333333", -"O c #AFAFAF", -"P c #E6E6E6", -"Q c #FDFDFD", -"R c #FEFEFE", -"S c #FCFCFC", -"T c #A8A8A8", -"U c #8D8D8D", -"V c #050505", -"W c #EEEEEE", -"X c #A6A6A6", -"Y c #C8C8C8", -"Z c #FFFFFF", -"` c #B6B6B6", -" . c #F4F4F4", -".. c #F2F2F2", -"+. c #A9A9A9", -"@. c #040404", -"#. c #2A2A2A", -"$. c #AAAAAA", -"%. c #ECECEC", -"&. c #A5A5A5", -"*. c #C7C7C7", -"=. c #D8D8D8", -"-. c #CDCDCD", -";. c #858585", -">. c #010101", -",. c #606060", -"'. c #646464", -"). c #C3C3C3", -"!. c #DADADA", -"~. c #494949", -"{. c #ADADAD", -"]. c #0A0A0A", -"^. c #BABABA", -"/. c #DCDCDC", -"(. c #989898", -"_. c #E9E9E9", -":. c #EBEBEB", -"<. c #A4A4A4", -"[. c #B7B7B7", -"}. c #D1D1D1", -"|. c #414141", -"1. c #3D3D3D", -"2. c #969696", -"3. c #A0A0A0", -"4. c #BEBEBE", -"5. c #D9D9D9", -"6. c #C5C5C5", -"7. c #515151", -"8. c #C0C0C0", -"9. c #959595", -"0. c #DDDDDD", -"a. c #484848", -"b. c #030303", -"c. c #454545", -"d. c #060606", -"e. c #B5B5B5", -"f. c #C6C6C6", -"g. c #C4C4C4", -"h. c #A2A2A2", -"i. c #828282", -"j. c #1E1E1E", -"k. c #191919", -"l. c #7C7C7C", -"m. c #E4E4E4", -"n. c #9E9E9E", -"o. c #525252", -"p. c #B0B0B0", -"q. c #6C6C6C", -"r. c #565656", -"s. c #797979", -"t. c #3A3A3A", -" ", -" ", -" . + @ # # # ", -" $ % & * = - ; > , ' ", -" ) ! = ~ { ] ^ / ( _ : < ", -" [ } ~ | 1 2 3 4 5 6 7 8 9 0 ", -" a b c d 6 e f g f h e i j k l m ", -" n o p 6 q r g g f r s i t u v w ", -" x y z A B C D E F F G G D C H I J K L ", -"x M N O P e r g Q R R Q S f h e i T U V ", -"x W y ~ t 5 q q g r S r f q e i X Y _ V ", -"x Z y ` t 3 4 e s q q q s ...+.~ ] J @. ", -"x Z #.$.v %.i .. .e e e 4 5 &.*.=.-.;.>. ", -"x Z ,.'.1 ; %.3 i 5 5 i i T ).=.!./ ~.x ", -"x Z {.].^./.(._.:.%.%.%.<.[.}.!.p &.>. ", -"x Z /.|.1.7 +.2.6 6 6 3.$.4.=.5.).% x ", -"x Z e 6.L 7.8.( 9.0.(.= Y J ).( a.b.x ", -"x Z g d c.d.. 3.( F e.8.~ f.U + b.].x x ", -"x Z e & ^.g.1.b.a.I h.&.i.l x j.[.k.x x x ", -"x Z l.p m.m.Y n.o.j.b.b.j.o.n.p.q.O j.n x x ", -"x & 8 8 8 8 8 8 &.&.&.&.&.&.&.8 8 r.x > N x x ", -" x x x x x x x x x x x x x x x x x x x s.t.x x ", -" x z n x ", -" x x "}; diff --git a/xemacs-packages/gnus/etc/gnus/print.xpm b/xemacs-packages/gnus/etc/gnus/print.xpm deleted file mode 100644 index 95f2f400..00000000 --- a/xemacs-packages/gnus/etc/gnus/print.xpm +++ /dev/null @@ -1,202 +0,0 @@ -/* XPM */ -static char * print_xpm[] = { -"24 24 175 2", -" c None", -". c #000000", -"+ c #C7C7C7", -"@ c #FAFAFA", -"# c #FCFCFC", -"$ c #FBFBFB", -"% c #F8F8F8", -"& c #AFAFAF", -"* c #F9F9F9", -"= c #E5E5E5", -"- c #E3E3E3", -"; c #E2E2E2", -"> c #E0E0E0", -", c #DFDFDF", -"' c #DCDCDC", -") c #DBDBDB", -"! c #B6B6B6", -"~ c #6B6B6B", -"{ c #676767", -"] c #818181", -"^ c #E7E7E7", -"/ c #606060", -"( c #A0A0A0", -"_ c #DADADA", -": c #E1E1E1", -"< c #B7B7B7", -"[ c #FDFDFD", -"} c #EFEFEF", -"| c #EEEEEE", -"1 c #EDEDED", -"2 c #ECECEC", -"3 c #EBEBEB", -"4 c #E9E9E9", -"5 c #E8E8E8", -"6 c #BFBFBF", -"7 c #8A8A8A", -"8 c #6A6A6A", -"9 c #9E9E9E", -"0 c #F6F6F6", -"a c #909090", -"b c #A2A2A2", -"c c #AAAAAA", -"d c #F4F4F4", -"e c #CECECE", -"f c #ADADAD", -"g c #AEAEAE", -"h c #BEBEBE", -"i c #A6A6A6", -"j c #CDCDCD", -"k c #F5F5F5", -"l c #DEDEDE", -"m c #DDDDDD", -"n c #C9C9C9", -"o c #878787", -"p c #888888", -"q c #D0D0D0", -"r c #6E6E6E", -"s c #797979", -"t c #D1D1D1", -"u c #A1A1A1", -"v c #B3B3B3", -"w c #FFFFFF", -"x c #CACACA", -"y c #A7A7A7", -"z c #A5A5A5", -"A c #A4A4A4", -"B c #A3A3A3", -"C c #87847C", -"D c #EAE8E3", -"E c #8D8982", -"F c #53524C", -"G c #807D74", -"H c #AAA9A5", -"I c #BAB5AB", -"J c #F3F3F3", -"K c #C3C1BD", -"L c #8B8B89", -"M c #E6E5E1", -"N c #F9F9F8", -"O c #FAFAF9", -"P c #F9F9F7", -"Q c #F7F6F5", -"R c #F7F7F4", -"S c #F6F5F4", -"T c #F2F1EE", -"U c #F0EFEC", -"V c #E5E5E4", -"W c #9F9F9F", -"X c #DFDED9", -"Y c #A4A3A1", -"Z c #6C6B6A", -"` c #F5F4F3", -" . c #D5D5D5", -".. c #D3D3D3", -"+. c #D4D4D3", -"@. c #D4D4D4", -"#. c #A9A9A9", -"$. c #B5B5B5", -"%. c #CDCDCB", -"&. c #B5B5B4", -"*. c #DCDAD3", -"=. c #6B6B6A", -"-. c #999896", -";. c #918F87", -">. c #999895", -",. c #E6E4E1", -"'. c #F0EEEC", -"). c #FAF9F9", -"!. c #F9F8F7", -"~. c #F8F7F6", -"{. c #F8F8F7", -"]. c #F4F3F1", -"^. c #F2F1EF", -"/. c #565655", -"(. c #858482", -"_. c #9C9B99", -":. c #6B6A68", -"<. c #585858", -"[. c #5E5C57", -"}. c #524F4B", -"|. c #4A4845", -"1. c #4B4A46", -"2. c #4B4946", -"3. c #4A4844", -"4. c #494743", -"5. c #484642", -"6. c #474541", -"7. c #464440", -"8. c #514F4B", -"9. c #53514E", -"0. c #7B7A77", -"a. c #797771", -"b. c #949391", -"c. c #989694", -"d. c #868480", -"e. c #6E6C66", -"f. c #706D67", -"g. c #5C5955", -"h. c #67645F", -"i. c #5B5954", -"j. c #585651", -"k. c #5D5B56", -"l. c #595652", -"m. c #53504C", -"n. c #575450", -"o. c #595752", -"p. c #5C5956", -"q. c #5B5956", -"r. c #61615E", -"s. c #696861", -"t. c #77756F", -"u. c #7E7B77", -"v. c #979690", -"w. c #96938D", -"x. c #807E77", -"y. c #7D7A74", -"z. c #787770", -"A. c #716F6A", -"B. c #6E6C67", -"C. c #595753", -"D. c #63615C", -"E. c #686661", -"F. c #6F6E68", -"G. c #6D6C66", -"H. c #72716B", -"I. c #76746F", -"J. c #6A6963", -"K. c #8B8880", -"L. c #B2AFA8", -"M. c #B6B3AD", -"N. c #BFBDB6", -"O. c #BDBBB4", -"P. c #B0AEA6", -"Q. c #ABA8A2", -"R. c #9C9991", -" ", -" . . . . . . . . . . . . ", -" . + @ # # # # # # # $ % & . ", -" . * = - - - ; > , , ' ) ! . ", -" . # ~ { ] ^ / ( _ : > > < . ", -" . [ } | 1 1 | 2 2 3 4 5 6 . ", -" . [ 7 8 9 0 a b 4 c a d + . ", -" . [ # # # # $ $ # # $ $ e . ", -" . [ f g = h % h i j 3 # j . ", -" . k l l l m l l , l 5 : n . ", -" . . @ o ~ p q r s t p u q v . . ", -" . w . x y z A z z i B b u u 9 . C . ", -" . w D E F . . . . . . . . . . G C H I . ", -" . w w J w w w w w w w w w w w w w w w w D . ", -" . K L M N O N P Q R O O S T T U V D W X I . ", -" . Y Z ` h .! ..! +.< @.#...$.%.&.*.=.-.;.. ", -" . >.=.,.'.Q N @ ).N !.~.{.{.].].].^./.(.;.. ", -" . _.:.<.[.}.|.1.2.2.2.3.4.5.6.4.7.8.9.0.a.. ", -" . b.c.d.e.f.g.h.i.j.i.k.l.m.n.o.p.q.r.s.t.. ", -" . u.v.w.;.x.y.z.t.A.t.A.B.C.D.E.F.G.H.I.J.. ", -" . . . . . . . . . . . . . . . . . . . . ", -" . K.L.M.N.N.N.N.N.O.P.L.Q.P.R.R.R.G G . ", -" . . . . . . . . . . . . . . . . . . ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/receipt.xpm b/xemacs-packages/gnus/etc/gnus/receipt.xpm deleted file mode 100644 index 18caaf1c..00000000 --- a/xemacs-packages/gnus/etc/gnus/receipt.xpm +++ /dev/null @@ -1,32 +0,0 @@ -/* XPM */ -static char * receipt_xpm[] = { -"24 24 5 1", -" c None", -". c #FFFFFFFFFFFF", -"X c #676766666363", -"o c #FFFF00000000", -"O c #AEAE3E3E4848", -" ", -" ", -" .. ", -" . ", -" . ", -" . ", -" .. ", -" Xooo .. ", -" Xoooooooo.. ", -" Xoooooooooooooo ... ", -" oooooooooooOOoo . ", -" ooooooooooOOOOo. ", -" oooooooooOO...o ", -" ooooooooooOOooo ", -" ooooooooooooooo ", -" ooooooooooooooo ", -" oooooooooooooo ", -" ooooooooooo ", -" ooooooo ", -" oooo ", -" oo ", -" ", -" ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/redo.xpm b/xemacs-packages/gnus/etc/gnus/redo.xpm deleted file mode 100644 index 273aec58..00000000 --- a/xemacs-packages/gnus/etc/gnus/redo.xpm +++ /dev/null @@ -1,69 +0,0 @@ -/* XPM */ -static char * stock_redo_xpm[] = { -"24 24 42 1", -" c None", -". c #000000", -"+ c #939A8D", -"@ c #BAD09D", -"# c #92998C", -"$ c #818F71", -"% c #ADBDA0", -"& c #C2D5AA", -"* c #D1DFBE", -"= c #BED2A3", -"- c #99A28F", -"; c #A8BCA6", -"> c #D5E1C6", -", c #CDDCBC", -"' c #D2E0BF", -") c #C5D7AE", -"! c #919889", -"~ c #8C9A7F", -"{ c #D4E0C5", -"] c #D3E0C1", -"^ c #BFD3A6", -"/ c #9BAA87", -"( c #B5C3A9", -"_ c #92AD62", -": c #7C9B40", -"< c #59702D", -"[ c #7F8E6B", -"} c #C8D9B2", -"| c #85A24D", -"1 c #53692A", -"2 c #A4B690", -"3 c #9BB572", -"4 c #6D8839", -"5 c #95A77E", -"6 c #8BA859", -"7 c #657255", -"8 c #98AF74", -"9 c #AFC394", -"0 c #6D7A5B", -"a c #9CAF84", -"b c #748261", -"c c #879772", -" ", -" ", -" ", -" . ", -" .. ", -" .+. ", -" ....@#. ", -" .$%&*=@-. ", -" .;>,')@@@!. ", -" .~{]*^@@@@@/. ", -" .(>_::::::<. ", -" .[}|::::::1. ", -" .23:<...:1. ", -" .@:4. .<. ", -" .@:.. .. ", -" .56. . ", -" .78. ", -" .9. ", -" .0a. ", -" .bc. ", -" ... ", -" ", -" ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/refresh.xpm b/xemacs-packages/gnus/etc/gnus/refresh.xpm deleted file mode 100644 index 827ce3f2..00000000 --- a/xemacs-packages/gnus/etc/gnus/refresh.xpm +++ /dev/null @@ -1,153 +0,0 @@ -/* XPM */ -static char * refresh_xpm[] = { -"24 24 126 2", -" c None", -". c #000000", -"+ c #F0FFEE", -"@ c #CAE3C6", -"# c #F5FFF4", -"$ c #0D110C", -"% c #729C6C", -"& c #A6CAA1", -"* c #CBE4C7", -"= c #EFFDEE", -"- c #172116", -"; c #88B583", -"> c #CCE5C8", -", c #CDE6C9", -"' c #CFE7CB", -") c #F3FFF2", -"! c #7FA879", -"~ c #689063", -"{ c #CDE5C9", -"] c #CFE7CA", -"^ c #D0E9CC", -"/ c #D4EAD0", -"( c #D5ECD1", -"_ c #AED5A9", -": c #9ABC95", -"< c #63865F", -"[ c #2B3A29", -"} c #8CB887", -"| c #70986A", -"1 c #71986B", -"2 c #729A6B", -"3 c #759C6D", -"4 c #759F6F", -"5 c #76A170", -"6 c #567453", -"7 c #AFCBAC", -"8 c #7EAB77", -"9 c #78A472", -"0 c #6F9669", -"a c #70976A", -"b c #71996B", -"c c #739B6D", -"d c #759F6E", -"e c #77A170", -"f c #526F4C", -"g c #B7D2B2", -"h c #60835B", -"i c #A5C9A0", -"j c #9AC195", -"k c #4F6B4C", -"l c #769F70", -"m c #516D4C", -"n c #B9D5B4", -"o c #7BA574", -"p c #C7E0C3", -"q c #6D9568", -"r c #51714E", -"s c #B6D3B2", -"t c #81AB7C", -"u c #C3DBBF", -"v c #6B9265", -"w c #C8EFC3", -"x c #A7CCA2", -"y c #B5D2B1", -"z c #80A87A", -"A c #90B68B", -"B c #79A674", -"C c #C6EAC1", -"D c #DEF7D9", -"E c #B3D7AE", -"F c #BBD9B8", -"G c #AFCCAB", -"H c #749E6D", -"I c #5B7B57", -"J c #8CB087", -"K c #BBE1B6", -"L c #DAF5D6", -"M c #E1F7DD", -"N c #DCF4D6", -"O c #D7F0D3", -"P c #CFECCB", -"Q c #C6E3C3", -"R c #BCD6B9", -"S c #7EA778", -"T c #64885F", -"U c #A6C1A3", -"V c #B3D5AE", -"W c #CDEAC9", -"X c #D0EBCB", -"Y c #CAE9C5", -"Z c #C7E6C3", -"` c #C3E3BF", -" . c #BDDCBA", -".. c #B5D2B2", -"+. c #96B991", -"@. c #76A071", -"#. c #3A4E37", -"$. c #5E7F5A", -"%. c #8FAF8B", -"&. c #9CBE97", -"*. c #C7E0C4", -"=. c #CBE3C6", -"-. c #CDE4C9", -";. c #CBE4C8", -">. c #C7E1C4", -",. c #C2DBBF", -"'. c #88AF82", -"). c #6B9266", -"!. c #557451", -"~. c #63885E", -"{. c #759C70", -"]. c #749E6F", -"^. c #72996B", -"/. c #739A6D", -"(. c #71996C", -"_. c #6E9668", -":. c #6C9367", -"<. c #5F815A", -"[. c #70996B", -"}. c #6E9467", -"|. c #698F63", -"1. c #6B9166", -"2. c #5D8059", -"3. c #4D6A49", -"4. c #6A8F64", -"5. c #283926", -" . ", -" . . ", -" . + . ", -" . . . . @ # . ", -" $ % & @ @ * * = . . . ", -" - ; @ @ * * > , ' ) . . ! ~ . ", -" . % @ * * > { ] ^ / ( _ . . : < . ", -" [ & @ } | 1 2 3 4 5 6 . . 7 . ", -". 8 @ 9 0 a b c d e f . . g h . ", -". i j 0 k . . . l m . . . n o . ", -". p q h . . r . . . . s t . ", -". u v . . . . w . . x y z . ", -". A B . . . C D . . . E F G H . ", -". I J . . K L M N O P Q R S T . ", -" . U . . V W X Y Z ` ...+.@.#.. ", -" . $.%.. . &.*.=., -.;.>.,.'.).!.. ", -" . ~.{.. . ].^.c /.(.| _.:.<.. . ", -" . . . [.}.|.~ 1.2.3.. . ", -" . q 4.. . . . ", -" 5.).. ", -" . . ", -" . ", -" ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/reply-all.xpm b/xemacs-packages/gnus/etc/gnus/reply-all.xpm deleted file mode 100644 index dfd560d1..00000000 --- a/xemacs-packages/gnus/etc/gnus/reply-all.xpm +++ /dev/null @@ -1,176 +0,0 @@ -/* XPM */ -static char * stock_mail_reply_to_all_xpm[] = { -"24 24 149 2", -" c None", -". c #000000", -"+ c #ADA99C", -"@ c #E6E1D0", -"# c #F0EAD9", -"$ c #A9A598", -"% c #141416", -"& c #161618", -"* c #080809", -"= c #DBD6C7", -"- c #1B1B1C", -"; c #050505", -"> c #5A5A5A", -", c #676767", -"' c #020202", -") c #807D76", -"! c #D49A3E", -"~ c #D2973B", -"{ c #040402", -"] c #6D6B6B", -"^ c #7A7979", -"/ c #030100", -"( c #040100", -"_ c #282724", -": c #DD9831", -"< c #DA962F", -"[ c #1A0E01", -"} c #BC6D1B", -"| c #BE6E13", -"1 c #BE6D13", -"2 c #BD6C13", -"3 c #3E3C36", -"4 c #D69029", -"5 c #D18D27", -"6 c #737067", -"7 c #110900", -"8 c #CF791C", -"9 c #CE791C", -"0 c #CD761A", -"a c #C47013", -"b c #4A4136", -"c c #A0731E", -"d c #96691A", -"e c #000100", -"f c #291703", -"g c #BA6613", -"h c #8C4E0D", -"i c #844A0D", -"j c #BF6D13", -"k c #1F2A0D", -"l c #306220", -"m c #4F7242", -"n c #448D44", -"o c #2E802E", -"p c #3A6F3A", -"q c #FFFFFF", -"r c #535353", -"s c #171009", -"t c #AC600C", -"u c #713F0A", -"v c #693A0A", -"w c #AA5F0A", -"x c #192B10", -"y c #275926", -"z c #68A769", -"A c #358A36", -"B c #2D812D", -"C c #FBFBFB", -"D c #F7F7F7", -"E c #FAFAFA", -"F c #F5F5F5", -"G c #4F4F4F", -"H c #AEAEAE", -"I c #141517", -"J c #6F767C", -"K c #534C46", -"L c #241609", -"M c #23180E", -"N c #484644", -"O c #354A4D", -"P c #050B07", -"Q c #4F7E4F", -"R c #399239", -"S c #2D852D", -"T c #297F29", -"U c #ACACAC", -"V c #C8C8C8", -"W c #151618", -"X c #6C7C8B", -"Y c #728EA9", -"Z c #5D6B78", -"` c #C8CBCD", -" . c #C3C7CD", -".. c #8090A2", -"+. c #5A728B", -"@. c #4E6479", -"#. c #111714", -"$. c #328732", -"%. c #2B7F2C", -"&. c #2B772C", -"*. c #434343", -"=. c #A0A0A0", -"-. c #D4D4D4", -";. c #25282A", -">. c #8A9EB4", -",. c #6A86A1", -"'. c #596A7C", -"). c #DDE1E4", -"!. c #DCE2E7", -"~. c #899CAC", -"{. c #687E96", -"]. c #546D87", -"^. c #10161D", -"/. c #8C8C8C", -"(. c #959595", -"_. c #E4E4E4", -":. c #23282D", -"<. c #8096AB", -"[. c #5D7996", -"}. c #53687D", -"|. c #CDD3D9", -"1. c #CBD2DC", -"2. c #899BAB", -"3. c #CCD4DC", -"4. c #5C748C", -"5. c #111820", -"6. c #4D4D4D", -"7. c #818181", -"8. c #C6C6C6", -"9. c #1F252B", -"0. c #6B8197", -"a. c #536D89", -"b. c #4A5D6F", -"c. c #81919F", -"d. c #8293A4", -"e. c #5A7087", -"f. c #496481", -"g. c #445D79", -"h. c #0E151B", -"i. c #6A6A6A", -"j. c #0E141A", -"k. c #0D1319", -"l. c #0E141B", -"m. c #0E131A", -"n. c #0F141A", -"o. c #636363", -"p. c #737373", -"q. c #7C7C7C", -"r. c #BCBCBC", -" ", -" . . ", -" + @ # $ . ", -" % & * = # # # . ", -" - ; > , ' ) ! ~ # . ", -" { ] ^ / ( _ : < # . ", -" [ } | 1 2 3 4 5 # 6 ", -" 7 8 9 0 a b c d # # . e . . . . . . ", -" f g h i j k l m n o p . q q q q q r . ", -" s t u v w x y z A o B . C D E F G H . ", -" I J K L M N O P Q R S T . F F F G U V . ", -" W X Y Z ` ...+.@.#.$.%.&.. F F *.=.-.V . ", -" ;.>.,.'.).!.~.{.].^.. . . /.F G (.-._.V . ", -" :.<.[.}.|.1.2.3.4.5.F F F F 6.7.8._._.V . ", -" 9.0.a.b.c.d.e.f.g.h.F F F G i.=._.F _.V . ", -" j.k.l.l.l.j.m.n.o.G F G (.8.p.8.F _.V . ", -" . q C F o.8.F _.-.G U 8._.F q._._.V . ", -" . q F p.-.F F F F _._.F F F F q._.V . ", -" . q q.-._._._._._._._._._._._._.q.V . ", -" . p.r.r.r.r.r.r.r.r.r.r.r.r.r.r.r.o.. ", -" . . . . . . . . . . . . . . . . . . ", -" ", -" ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/reply-wo.pbm b/xemacs-packages/gnus/etc/gnus/reply-wo.pbm deleted file mode 100644 index def54da8ede20b0f152e8ff1fd0b7b9b40450b53..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 81 zcmWGA;W9E&Ff!p{fCD}T22lnEg$70k2c`}MQT75O3lG--7dypSuFft@$C?~`Sr~Gd c90gez8JJucTsRn%3K&Eb7}!EXLx5%g0Na@iO8@`> diff --git a/xemacs-packages/gnus/etc/gnus/reply-wo.xpm b/xemacs-packages/gnus/etc/gnus/reply-wo.xpm deleted file mode 100644 index 370678af..00000000 --- a/xemacs-packages/gnus/etc/gnus/reply-wo.xpm +++ /dev/null @@ -1,31 +0,0 @@ -/* XPM */ -static char * reply_wo_xpm[] = { -"24 24 4 1", -" c None", -". c #000000000000", -"X c #E1E1E0E0E0E0", -"O c #FFFFFFFFFFFF", -" ", -" ", -" ", -" .... ", -" ..X.... ", -" ..XX.XX.. ", -" .O.XX.XXXX.. ", -" ..O.XXX.XXXX... ", -" .OO.XXXX.X....... ", -" .OO.XXXX...XXX.OO.. ", -" ..OO.XX....XXXX.OOOO.. ", -" .......XX.XXXX.OOO.... ", -" .OOO.XXX.XXXX.OO..OOO. ", -" .OOOO....XXX....OOOOO. ", -" .OOOOOOO..XX..OOOOOOO. ", -" .OOOOOOO......OOOOOOO. ", -" .OOOOOO.OO..O..OOOOOO. ", -" .OOOOO.OOOOOOOO.OOOOO. ", -" .OOOO.OOOOOOOOOO.OOOO. ", -" .OOO.OOOOOOOOOOOO.OOO. ", -" .O..OOOOOOOOOOOOOO..O. ", -" ..OOOOOOOOOOOOOOOOOO.. ", -" ...................... ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/reply.pbm b/xemacs-packages/gnus/etc/gnus/reply.pbm deleted file mode 100644 index ee181e663be77954bc10f855f980a40f8ebd3749..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 81 zcmWGA;W9E&Ff!p{KnAP~3dOJ Z7#Wyc7+g3QlnNL`6cp4#LqmXO006{n3 c #F5F5F5", -", c #F4F4F4", -"' c #E3E3E3", -") c #EEEEEE", -"! c #4F4F4F", -"~ c #F3F3F3", -"{ c #F2F2F2", -"] c #F1F1F1", -"^ c #F0F0F0", -"/ c #EFEFEF", -"( c #EDEDED", -"_ c #AEAEAE", -": c #E4E4E4", -"< c #434343", -"[ c #ACACAC", -"} c #C8C8C8", -"| c #A0A0A0", -"1 c #D4D4D4", -"2 c #ECECEC", -"3 c #959595", -"4 c #3E3E3E", -"5 c #4D4D4D", -"6 c #818181", -"7 c #C6C6C6", -"8 c #3D1A13", -"9 c #6A6A6A", -"0 c #636363", -"a c #B9B9B9", -"b c #737373", -"c c #EAC0BA", -"d c #7C7C7C", -"e c #DF9E95", -"f c #E0A198", -"g c #E1A59D", -"h c #E2A79E", -"i c #E3ABA3", -"j c #E3AAA2", -"k c #CC6253", -"l c #DD978D", -"m c #DF9F97", -"n c #DE9A90", -"o c #DD968C", -"p c #DD948A", -"q c #B14334", -"r c #BCBCBC", -"s c #431913", -"t c #EAC2BC", -"u c #DF9C92", -"v c #DD998F", -"w c #B54535", -"x c #65261D", -"y c #983A2C", -"z c #7C2F24", -"A c #63251D", -"B c #6C291F", -" ", -" ", -" ", -" ................. ", -" .+@@@@#$%&*=-;>,'+. ", -" .)!@>,~{{]^^/)('!_. ", -" .@:<$~{{]^/))('![}. ", -" .@>:!&]^^/)(('<|1}. ", -" .@&>:<=^/)(2'!31:}. ", -" .@>>>:4>)(2'567::}. ", -" .@&8>:9<~2'!977>:}. ", -" .@..:0@a!^!37b7>:}. ", -" ..c.0@>:1![7::d::}. ", -" .ce.......:>>>:d:}. ", -" .cfghihjek.::::::d}. ", -" .clmenoonpq.rrrrrrr0. ", -"stnuvvlnnnnw.......... ", -" .xyyyyyyyyz. ", -" .xyyAAAAAB. ", -" .xy....... ", -" .x. ", -" .. ", -" . ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/reverse-smile.xpm b/xemacs-packages/gnus/etc/gnus/reverse-smile.xpm deleted file mode 100644 index 56db090e..00000000 --- a/xemacs-packages/gnus/etc/gnus/reverse-smile.xpm +++ /dev/null @@ -1,20 +0,0 @@ -/* XPM */ -static char * reverse_smile_xpm[] = { -"13 14 3 1", -" c None", -". c #000000", -"+ c #FFDD00", -" ....... ", -" ..+++++.. ", -" .+++++++++. ", -".+++.....+++.", -".++.+++++.++.", -".++.+++++.++.", -".+++++++++++.", -".+++++++++++.", -".++..+++..++.", -".++..+++..++.", -".+++++++++++.", -" .+++++++++. ", -" ..+++++.. ", -" ....... "}; diff --git a/xemacs-packages/gnus/etc/gnus/right-arrow.xpm b/xemacs-packages/gnus/etc/gnus/right-arrow.xpm deleted file mode 100644 index da815687..00000000 --- a/xemacs-packages/gnus/etc/gnus/right-arrow.xpm +++ /dev/null @@ -1,68 +0,0 @@ -/* XPM */ -static char * right_arrow_xpm[] = { -"24 24 41 1", -" c None", -". c #000000", -"+ c #8CA782", -"@ c #B1CDAE", -"# c #77A16E", -"$ c #B4CEB1", -"% c #ACC8A9", -"& c #709867", -"* c #C1D6BD", -"= c #BDD3B8", -"- c #BFD4BB", -"; c #C2D7BE", -"> c #B0CAAD", -", c #B2CBB0", -"' c #AAC7A8", -") c #0F1308", -"! c #AEC5A8", -"~ c #AEC8AD", -"{ c #ABC7A8", -"] c #AAC6A7", -"^ c #A8C6A5", -"/ c #ADC8AD", -"( c #A8C7A8", -"_ c #A5C4A3", -": c #7F9F76", -"< c #A6BFA0", -"[ c #ABC7AA", -"} c #A7C5A4", -"| c #A9C7A6", -"1 c #AFC8AD", -"2 c #A4C3A2", -"3 c #6B9060", -"4 c #778E6F", -"5 c #698D60", -"6 c #6B9063", -"7 c #445B2C", -"8 c #6B8661", -"9 c #5B7950", -"0 c #6C8562", -"a c #65815C", -"b c #506B46", -" ", -" ", -" ", -" . ", -" .. ", -" .+. ", -" .@#. ", -" ........$%&. ", -" .*=-;;;;>,'&) ", -" .!~{{{]^'/(_:. ", -" .<[^}^|{%'{123. ", -" .45666666666657. ", -" .8999999999997. ", -" .099999999997. ", -" .abbbbbb9997. ", -" ........b97. ", -" .b7. ", -" .7. ", -" .. ", -" . ", -" ", -" ", -" ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/rot13.pbm b/xemacs-packages/gnus/etc/gnus/rot13.pbm deleted file mode 100644 index 800d9d6327bff0db1d4b73f4b9170258aac7e384..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 81 zcmWGA;W9E&Ff!p{fB-uNhJy@@3fZf|NjpT1_>a-#Q=)4|Nj6n0037L B5ugA7 diff --git a/xemacs-packages/gnus/etc/gnus/rot13.xpm b/xemacs-packages/gnus/etc/gnus/rot13.xpm deleted file mode 100644 index 18faa3e9..00000000 --- a/xemacs-packages/gnus/etc/gnus/rot13.xpm +++ /dev/null @@ -1,128 +0,0 @@ -/* XPM */ -static char * rot13_xpm[] = { -"24 24 101 2", -" g None", -". g #000000", -"+ g #212121", -"@ g #9E9E9E", -"# g #E6E6E6", -"$ g #E7E7E7", -"% g #C8C8C8", -"& g #A0A0A0", -"* g #131313", -"= g #5F5F5F", -"- g #EDEDED", -"; g #D6D6D6", -"> g #D5D5D5", -", g #DDDDDD", -"' g #D8D8D8", -") g #A1A1A1", -"! g #3C3C3C", -"~ g #353535", -"{ g #EFEFEF", -"] g #CFCFCF", -"^ g #4C4C4C", -"/ g #141414", -"( g #6A6A6A", -"_ g #D0D0D0", -": g #B2B2B2", -"< g #454545", -"[ g #E2E2E2", -"} g #292929", -"| g #0F0F0F", -"1 g #949494", -"2 g #E9E9E9", -"3 g #C3C3C3", -"4 g #1C1C1C", -"5 g #E1E1E1", -"6 g #272727", -"7 g #DEDEDE", -"8 g #B6B6B6", -"9 g #0C0C0C", -"0 g #262626", -"a g #1F1F1F", -"b g #616161", -"c g #5B5B5B", -"d g #232323", -"e g #111111", -"f g #181818", -"g g #3D3D3D", -"h g #636363", -"i g #545454", -"j g #2E2E2E", -"k g #242424", -"l g #070707", -"m g #DCDCDC", -"n g #D3D3D3", -"o g #C5C5C5", -"p g #C2C2C2", -"q g #BFBFBF", -"r g #B5B5B5", -"s g #696969", -"t g #ACACAC", -"u g #999999", -"v g #8F8F8F", -"w g #868686", -"x g #686868", -"y g #B1B1B1", -"z g #9A9A9A", -"A g #909090", -"B g #878787", -"C g #DBDBDB", -"D g #A6A6A6", -"E g #979797", -"F g #8A8A8A", -"G g #8D8D8D", -"H g #838383", -"I g #666666", -"J g #BBBBBB", -"K g #9F9F9F", -"L g #8B8B8B", -"M g #828282", -"N g #676767", -"O g #A3A3A3", -"P g #8E8E8E", -"Q g #888888", -"R g #8C8C8C", -"S g #BABABA", -"T g #818181", -"U g #757575", -"V g #DADADA", -"W g #AFAFAF", -"X g #848484", -"Y g #7F7F7F", -"Z g #7B7B7B", -"` g #B8B8B8", -" . g #D9D9D9", -".. g #ABABAB", -"+. g #929292", -"@. g #939393", -"#. g #808080", -"$. g #919191", -"%. g #ADADAD", -"&. g #969696", -"*. g #4A4A4A", -" ", -" ", -" . . . . . ", -" . + @ # $ % & * ", -" . = - # ; > , ' ) ! . ", -" ~ { ] ^ . . / ( _ : < ", -" . [ ' } . | ( % 1 . ", -" * 2 3 . 4 5 @ . ", -" 6 7 8 . . $ 8 . ", -" 9 0 a b c d e 6 a f a g h i j k l ", -" . 7 m ' ; n o p p p p q r r r s . ", -" . 7 p 8 : t t t t t t t u v w x . ", -" . m p 8 y t t t t t t t z A B s . ", -" . C p r D E E E E E E A F G H I . ", -" . , p 8 J t t t t t t t K L M N . ", -" . m p y O E E E E E E P Q R H ( . ", -" . m p r S t t t t t t t K L T U . ", -" . V p W & E E E E E E F X B Y Z . ", -" . C p y ` t t t t t t t K F B T . ", -" . .p W ..E E E E E E E +.G @.#.. ", -" . $.%.z &.A L F F G $.A A P X *.. ", -" . . . . . . . . . . . . . . . ", -" ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/save-aif.pbm b/xemacs-packages/gnus/etc/gnus/save-aif.pbm deleted file mode 100644 index 15829c289e79e517beacd54520e343298cd260ff..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 81 zcmWGA;W9E&Ff!p{00YL*00ssPMg|rJ1{*NR0wjSbG=_zPizR>oL52pfFfg&W28Qsz QS`mMMLH`wl{2h=H07hpDvj6}9 diff --git a/xemacs-packages/gnus/etc/gnus/save-aif.xpm b/xemacs-packages/gnus/etc/gnus/save-aif.xpm deleted file mode 100644 index f0325ac2..00000000 --- a/xemacs-packages/gnus/etc/gnus/save-aif.xpm +++ /dev/null @@ -1,33 +0,0 @@ -/* XPM */ -static char * save_aif_xpm[] = { -"24 24 6 1", -" c None", -". c #999999999999", -"X c #E1E1E0E0E0E0", -"o c #C7C7C6C6C6C6", -"O c #000000000000", -"+ c #FFFFFFFFFFFF", -" ", -" ", -" ............. ", -" .XXXXXXXXXX.X.. ", -" .XXXXXXXXXX.XX. ", -" .XXXXXXXXXX.... ", -" .XXXXXXXXXXooo. ", -" .XXXXXXXXXXXXX. ", -" .XXXXXXXXXXXXX. ", -" .XXXXXXXXXXXXX. ", -" OOOOOOOOOOOOOOXXXXXX. ", -" O..O+++++++O.OXXXXXX. ", -" O..O+++++++O.OXXXXXX. ", -" O..O+++++++O.OXXXXXX. ", -" O..O+++++++O.OXXXXXX. ", -" O..O+++++++O.OXXXXXX. ", -" O..OOOOOOOOO.OXXXXXX. ", -" O............OXXXXXX. ", -" O............OXXXXXX. ", -" O..OOOOOOOOO.O....... ", -" O..OoooooO++.O ", -" O..OoooooO++.O ", -" O.OoooooO++.O ", -" OOOOOOOOOOOO "}; diff --git a/xemacs-packages/gnus/etc/gnus/save-art.pbm b/xemacs-packages/gnus/etc/gnus/save-art.pbm deleted file mode 100644 index 68fe0cb309873313e4960a10b3acd43a730879ea..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 81 zcmWGA;W9E&Ff!p{00Y+0P&NiORtG^A11A c #E4E4E4", -", c #434343", -"' c #ACACAC", -") c #C8C8C8", -"! c #A0A0A0", -"~ c #D4D4D4", -"{ c #959595", -"] c #3E3E3E", -"^ c #4D4D4D", -"/ c #818181", -"( c #C6C6C6", -"_ c #6A6A6A", -": c #636363", -"< c #B9B9B9", -"[ c #737373", -"} c #010101", -"| c #AAAAAA", -"1 c #0B0B0B", -"2 c #0C0C0C", -"3 c #060606", -"4 c #E4E3E1", -"5 c #050505", -"6 c #B3B3B1", -"7 c #484641", -"8 c #9F9D96", -"9 c #888781", -"0 c #7C7C7C", -"a c #B0AFAD", -"b c #A8A7A1", -"c c #908E86", -"d c #97958E", -"e c #807D74", -"f c #969696", -"g c #090909", -"h c #595854", -"i c #605E57", -"j c #898883", -"k c #76746B", -"l c #43423F", -"m c #282724", -"n c #363430", -"o c #6D6B63", -"p c #E2E2E1", -"q c #B6B5AF", -"r c #21201E", -"s c #0A0908", -"t c #181816", -"u c #E6E6E4", -"v c #65635C", -"w c #161614", -"x c #8C8B89", -"y c #DFDEDC", -"z c #B0AFA9", -"A c #D5D4D1", -"B c #93918B", -"C c #D6D5D2", -"D c #ABA9A3", -"E c #5D5C55", -"F c #494943", -"G c #42413C", -" ", -" ................. ", -" .+@@@@@@@@@@@@@@@#. ", -" .$%&*&*=*&*&*=-&%;. ", -" .@>,&&&&&&&&&&&%'). ", -" .@&>%&&&&&&&&&,!~). ", -" .@*&>,&&&&&&&%{~>). ", -" .@&&&>]&&&&&^/(>>). ", -" .@*&&&_,&&&%_!>&>). ", -" .@&&&:<<%&%{([(}}}. ", -" .@*&:(&>~%'|12:345... ", -" .@&[~&&&&>>2>62787.9.. ", -" .@0~>>>>>>>1ab888cde7. ", -" .[+++++++++fg88hijek. ", -" ...........78ilmn8o7..", -" .pq8hrstuevi.", -" ..78jnwxyv7..", -" .zequABv. ", -" .CD8eekkE7. ", -" ..h.7k7.F.. ", -" .. .G. .. ", -" ... ", -" ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/save.xpm b/xemacs-packages/gnus/etc/gnus/save.xpm deleted file mode 100644 index 00017161..00000000 --- a/xemacs-packages/gnus/etc/gnus/save.xpm +++ /dev/null @@ -1,291 +0,0 @@ -/* XPM */ -static char * mail_save_xpm[] = { -"24 24 264 2", -" c None", -". c #000000", -"+ c #141414", -"@ c #262626", -"# c #212121", -"$ c #1F1F1F", -"% c #1E1E1E", -"& c #1D1D1D", -"* c #202020", -"= c #232323", -"- c #292929", -"; c #171717", -"> c #121212", -", c #B8B8B8", -"' c #FFFFFF", -") c #A8A8A8", -"! c #0E0E0E", -"~ c #595959", -"{ c #444444", -"] c #4F4F4F", -"^ c #050505", -"/ c #222222", -"( c #3D3D3D", -"_ c #FEFEFE", -": c #FCFCFC", -"< c #FDFDFD", -"[ c #CACACA", -"} c #191919", -"| c #B3B1B0", -"1 c #EEECEB", -"2 c #F0DCAA", -"3 c #E5C470", -"4 c #DFB84F", -"5 c #8A681F", -"6 c #100E09", -"7 c #FBFBFB", -"8 c #515151", -"9 c #F0F0F0", -"0 c #D6D6D6", -"a c #EEECE9", -"b c #E6D498", -"c c #EED682", -"d c #EED680", -"e c #E3C15E", -"f c #D29815", -"g c #976E15", -"h c #7F5B0A", -"i c #1C190F", -"j c #D9D9D9", -"k c #424242", -"l c #F1F1F1", -"m c #F3F3F3", -"n c #EBE9E5", -"o c #CBB771", -"p c #735817", -"q c #C6A546", -"r c #E3C05D", -"s c #BC8710", -"t c #AD7C10", -"u c #6B6B6B", -"v c #A0A0A0", -"w c #535353", -"x c #505050", -"y c #AE9C5C", -"z c #292928", -"A c #CECDCA", -"B c #CAC9C7", -"C c #1A1917", -"D c #9C7E2B", -"E c #AB7C12", -"F c #242012", -"G c #555555", -"H c #DEDEDE", -"I c #E8E8E8", -"J c #3B3B3B", -"K c #D7D6D6", -"L c #656462", -"M c #DAD9D7", -"N c #E1E0DF", -"O c #1A1A19", -"P c #3D351F", -"Q c #A37819", -"R c #231F13", -"S c #282828", -"T c #898989", -"U c #EFEFEF", -"V c #FAFAFA", -"W c #E8E7E6", -"X c #8B8B8A", -"Y c #0B0B06", -"Z c #A97C1A", -"` c #1B1B1B", -" . c #C9C9C9", -".. c #DFDFDF", -"+. c #EBEBEB", -"@. c #ECECEC", -"#. c #E1E1E1", -"$. c #221E11", -"%. c #EAE8E3", -"&. c #C58F13", -"*. c #B68411", -"=. c #826321", -"-. c #302C19", -";. c #131313", -">. c #1A1A1A", -",. c #161616", -"'. c #151515", -"). c #181818", -"!. c #1B1B1A", -"~. c #141413", -"{. c #363220", -"]. c #916F25", -"^. c #322F1E", -"/. c #98B4C8", -"(. c #25313B", -"_. c #A9CCE0", -":. c #545A68", -"<. c #BC6A60", -"[. c #AD5A51", -"}. c #A4574D", -"|. c #2B2719", -"1. c #353120", -"2. c #5A4D51", -"3. c #6E8DA2", -"4. c #0C1820", -"5. c #BAE5FF", -"6. c #696E6F", -"7. c #F9F9F9", -"8. c #EBEBEA", -"9. c #937025", -"0. c #CDCAC1", -"a. c #73726E", -"b. c #7496AF", -"c. c #0A131A", -"d. c #BAE0FD", -"e. c #6A6E71", -"f. c #ECEDEC", -"g. c #DEDFDF", -"h. c #DBDDDD", -"i. c #D8DBDB", -"j. c #CDCFCF", -"k. c #312E1B", -"l. c #2F2C19", -"m. c #B2B3B0", -"n. c #C0C0BE", -"o. c #6F6D6B", -"p. c #7C9FBB", -"q. c #050F15", -"r. c #B7DDFC", -"s. c #54575A", -"t. c #F4F4F3", -"u. c #ECECEB", -"v. c #F3F3F2", -"w. c #7F7D7A", -"x. c #7EA0BB", -"y. c #020A10", -"z. c #B1D7F7", -"A. c #FDFCFB", -"B. c #EFEFEE", -"C. c #EDEDEC", -"D. c #EBECEB", -"E. c #EBECEC", -"F. c #F7F7F6", -"G. c #7D7977", -"H. c #7F9FB9", -"I. c #050B0E", -"J. c #B3DDF7", -"K. c #685050", -"L. c #847F7C", -"M. c #7E9DB7", -"N. c #0A0B0C", -"O. c #A9D3F0", -"P. c #7B99AB", -"Q. c #6B6E70", -"R. c #63696C", -"S. c #60666B", -"T. c #5E6569", -"U. c #555E67", -"V. c #5D6267", -"W. c #61676B", -"X. c #64696D", -"Y. c #62666A", -"Z. c #6B747E", -"`. c #7D9CB4", -" + c #000508", -".+ c #A8CBED", -"++ c #7498B7", -"@+ c #6F92B0", -"#+ c #3F5160", -"$+ c #4A5E70", -"%+ c #566E82", -"&+ c #4D6779", -"*+ c #52697C", -"=+ c #52697A", -"-+ c #54687A", -";+ c #455E70", -">+ c #7697B4", -",+ c #92A9BC", -"'+ c #000205", -")+ c #A8CEEB", -"!+ c #7196B3", -"~+ c #4D5152", -"{+ c #D7D2CB", -"]+ c #F1EEEA", -"^+ c #FAF8F5", -"/+ c #F9F8F5", -"(+ c #E8E4DF", -"_+ c #D8D4CD", -":+ c #9D968B", -"<+ c #425563", -"[+ c #446783", -"}+ c #A7C4DA", -"|+ c #000101", -"1+ c #A5CDEA", -"2+ c #7196B1", -"3+ c #57595C", -"4+ c #534F46", -"5+ c #2E281F", -"6+ c #CAC7C2", -"7+ c #C9C4BD", -"8+ c #C2BBB1", -"9+ c #E3E0DC", -"0+ c #314353", -"a+ c #40647C", -"b+ c #B6C9DA", -"c+ c #A3CDEB", -"d+ c #7695B1", -"e+ c #525455", -"f+ c #474239", -"g+ c #3B372D", -"h+ c #C0BCB5", -"i+ c #C7C2BA", -"j+ c #E2DFD9", -"k+ c #F8F6F3", -"l+ c #344652", -"m+ c #406479", -"n+ c #A6C3DA", -"o+ c #010000", -"p+ c #708798", -"q+ c #6A8DA7", -"r+ c #4F5052", -"s+ c #F7F2EC", -"t+ c #59534B", -"u+ c #57524A", -"v+ c #C1BCB4", -"w+ c #EBE9E4", -"x+ c #FFFFFD", -"y+ c #30414E", -"z+ c #415C6F", -"A+ c #A2C4DC", -"B+ c #020000", -"C+ c #030406", -"D+ c #141A1F", -"E+ c #151718", -"F+ c #35332F", -"G+ c #393634", -"H+ c #41403E", -"I+ c #3F3E3D", -"J+ c #454344", -"K+ c #434241", -"L+ c #312F2C", -"M+ c #02070A", -"N+ c #070E12", -"O+ c #465A69", -". + @ # $ % & & & % * = - ; . ", -"> , ' ' ' ' ' ' ' ' ' ' ' ) ! ", -"@ ' ~ ' ' ' ' ' ' ' ' ' { ] ^ . . . ", -"/ ' ' ( ' _ : < < ' [ } | 1 2 3 4 5 . 6 ", -"* ' ' 7 8 9 < 7 _ 0 @ a b c d d e f g h i ", -"$ ' ' ' j k l : m $ n o . . . p q r s t i ", -"* ' ' ' u v w ' x . y z A B C D d f E F ", -"/ ' ' G H 7 I J , K > L M N O P d f Q R ", -"S ' T U ' ' ' _ V ' < W X Y . . . d f Z . . . ", -"` ...U +.+.+.@.@.+.@.+.#.$.%.d d d f &.*.=.-.. ", -". ;.>.; ,.'.'.'.'.'.,.).!.~.{.%.d d f f ].^./.(.", -" . _.:.<.[.}.|.%.d f ].1.2.3.4.", -" . 5.6.' ' 7.8.-.%.9.^.0.a.b.c.", -" . d.e.f.g.h.i.j.k.l.m.n.o.p.q.", -" . r.s.' ' ' ' ' ' t.u.v.w.x.y.", -" . z.6.A.B.C.D.+.E.C.U F.G.H.I.", -" . J.K.' ' ' ' ' ' ' ' ' L.M.N.", -" . O.P.Q.R.S.T.U.V.W.X.Y.Z.`. +", -" . .+++@+#+$+%+&+*+=+-+;+>+,+'+", -" . )+!+~+{+]+^+/+(+_+:+<+[+}+|+", -" . 1+2+3+' 4+5+6+7+8+9+0+a+b+. ", -" . c+d+e+' f+g+h+i+j+k+l+m+n+o+", -" . p+q+r+s+t+u+v+w+x+]+y+z+A+B+", -" C+D+E+F+G+H+I+J+K+L+M+N+O+. "}; diff --git a/xemacs-packages/gnus/etc/gnus/saveas.xpm b/xemacs-packages/gnus/etc/gnus/saveas.xpm deleted file mode 100644 index 2830b06c..00000000 --- a/xemacs-packages/gnus/etc/gnus/saveas.xpm +++ /dev/null @@ -1,289 +0,0 @@ -/* XPM */ -static char * saveas_xpm[] = { -"24 24 262 2", -" c None", -". c #000000", -"+ c #FBE73B", -"@ c #F2B64D", -"# c #FCEB3D", -"$ c #F7B544", -"% c #5D502C", -"& c #C3D7F4", -"* c #A9CDE5", -"= c #75757A", -"- c #EFC5BB", -"; c #F1C8BE", -"> c #F0C6BC", -", c #EEBCB2", -"' c #EEBEB5", -") c #EEC1B8", -"! c #EDBFB6", -"~ c #E8B6AC", -"{ c #FCE93B", -"] c #F7B545", -"^ c #6C5F34", -"/ c #434345", -"( c #92A7B9", -"_ c #96B1C7", -": c #BBD6E8", -"< c #8AAAC5", -"[ c #605F68", -"} c #E08D7E", -"| c #E0826E", -"1 c #E0806E", -"2 c #DC7A68", -"3 c #DC8171", -"4 c #DA7868", -"5 c #D38072", -"6 c #FAE43A", -"7 c #F4B244", -"8 c #615030", -"9 c #783E35", -"0 c #4D4C52", -"a c #7790A2", -"b c #526D82", -"c c #BAD5E9", -"d c #88A7C3", -"e c #686670", -"f c #C8817B", -"g c #CB7C74", -"h c #CB7A73", -"i c #CB7B73", -"j c #CC7C72", -"k c #CA7C72", -"l c #F9DF39", -"m c #F3AF42", -"n c #614F2F", -"o c #8F4941", -"p c #945554", -"q c #5B5A62", -"r c #7B97AE", -"s c #536F84", -"t c #B6D3E7", -"u c #87ABC1", -"v c #737373", -"w c #FFFFFF", -"x c #FEFEFE", -"y c #F9DC38", -"z c #EFB44D", -"A c #665A32", -"B c #BBBBBB", -"C c #CDCDCD", -"D c #E4E4E4", -"E c #6E6E6E", -"F c #819EB6", -"G c #526C80", -"H c #B9D3E7", -"I c #85A4BF", -"J c #F8D837", -"K c #F0A93F", -"L c #655930", -"M c #BABABA", -"N c #CCCCCC", -"O c #E5E5E5", -"P c #F7F7F7", -"Q c #727272", -"R c #83A0B8", -"S c #4F697C", -"T c #B9D3E6", -"U c #84A3BF", -"V c #CECECE", -"W c #F6D236", -"X c #EDA43E", -"Y c #5C5130", -"Z c #949494", -"` c #A3A3A3", -" . c #B7B7B7", -".. c #C6C6C6", -"+. c #BDBDBD", -"@. c #88A4BB", -"#. c #486276", -"$. c #B7D2E7", -"%. c #82A0BB", -"&. c #636363", -"*. c #FDFDFD", -"=. c #D7AE74", -"-. c #61562F", -";. c #465E70", -">. c #B5CAE5", -",. c #7FA2B9", -"'. c #4F4115", -"). c #87A3BA", -"!. c #455C6D", -"~. c #AECCE5", -"{. c #7DA0B6", -"]. c #CBCBCB", -"^. c #9B9B9B", -"/. c #9C9C9C", -"(. c #A7A7A7", -"_. c #B8B8B8", -":. c #C5C5C5", -"<. c #546069", -"[. c #B0D1E4", -"}. c #83A1B6", -"|. c #735B5B", -"1. c #F0F0F0", -"2. c #D9D9D9", -"3. c #D3D3D3", -"4. c #E1E1E1", -"5. c #EDEDED", -"6. c #F8F8F8", -"7. c #515C64", -"8. c #AACEE3", -"9. c #7B9BB2", -"0. c #7A8E9A", -"a. c #7A7A7A", -"b. c #707070", -"c. c #6C6C6C", -"d. c #6F6F6F", -"e. c #6A6E71", -"f. c #696969", -"g. c #6F777E", -"h. c #86A2B9", -"i. c #3A515D", -"j. c #A9C9E2", -"k. c #7494AF", -"l. c #7E9BB4", -"m. c #7D9AB3", -"n. c #7998B2", -"o. c #85A1B8", -"p. c #829FB7", -"q. c #8CA7BD", -"r. c #8AA5BB", -"s. c #364A59", -"t. c #ABC4E2", -"u. c #7294AD", -"v. c #6F90AC", -"w. c #7192AE", -"x. c #414A4E", -"y. c #424A51", -"z. c #525B63", -"A. c #626F79", -"B. c #5F6C76", -"C. c #5C6971", -"D. c #5A666F", -"E. c #58636B", -"F. c #57636A", -"G. c #3B5360", -"H. c #39424B", -"I. c #7897B3", -"J. c #A4B9CB", -"K. c #364853", -"L. c #AAC9E2", -"M. c #7091AA", -"N. c #6F8FA7", -"O. c #4A5359", -"P. c #97938C", -"Q. c #DFDDDA", -"R. c #E3E1DE", -"S. c #EBEAE8", -"T. c #EAE9E7", -"U. c #CFCEC9", -"V. c #C9C6C0", -"W. c #9B968E", -"X. c #566168", -"Y. c #4B657A", -"Z. c #54738C", -"`. c #AAC6DD", -" + c #34464E", -".+ c #AAC9E1", -"++ c #6C8EA6", -"@+ c #6C8CA4", -"#+ c #40474D", -"$+ c #DAD8D3", -"%+ c #E7E6E2", -"&+ c #67655E", -"*+ c #524F47", -"=+ c #D9D7D4", -"-+ c #C7C5BF", -";+ c #C0BCB5", -">+ c #B8B3AB", -",+ c #434C54", -"'+ c #4D697F", -")+ c #4F6F84", -"!+ c #B3CADC", -"~+ c #313E49", -"{+ c #A8C8E1", -"]+ c #6B8DA6", -"^+ c #728FA4", -"/+ c #E2E1DD", -"(+ c #F0EFEC", -"_+ c #CDCAC6", -":+ c #C2BFB9", -"<+ c #CAC6C0", -"[+ c #DCDAD7", -"}+ c #4B555D", -"|+ c #4E697F", -"1+ c #BACCDC", -"2+ c #A4C4DE", -"3+ c #698BA3", -"4+ c #708AA1", -"5+ c #383E43", -"6+ c #E0DEDA", -"7+ c #514E46", -"8+ c #4F4C44", -"9+ c #C7C4BE", -"0+ c #CBC8C2", -"a+ c #E1E0DC", -"b+ c #E9E8E6", -"c+ c #475158", -"d+ c #4E6879", -"e+ c #4D6C80", -"f+ c #A3C3DB", -"g+ c #383F43", -"h+ c #778999", -"i+ c #6E899E", -"j+ c #65859C", -"k+ c #33383C", -"l+ c #D7D4D0", -"m+ c #D6D4D0", -"n+ c #4E4A43", -"o+ c #4D4942", -"p+ c #D1CEC9", -"q+ c #E6E5E2", -"r+ c #EDECEA", -"s+ c #454F55", -"t+ c #486173", -"u+ c #4D6678", -"v+ c #A1C1DA", -"w+ c #373C40", -"x+ c #0C0D0F", -"y+ c #4E5E6A", -"z+ c #5B6E7C", -"A+ c #4F5B62", -"B+ c #A4A099", -"C+ c #CCC9C3", -"D+ c #D7D5D1", -"E+ c #E4E2E0", -"F+ c #DDDBD7", -"G+ c #B8B5B0", -"H+ c #3E474D", -"I+ c #4A6176", -"J+ c #4A6070", -"K+ c #9BC3D8", -"L+ c #363C41", -"M+ c #28323E", -" . . ", -" . + @ . ", -" . . . . . . . . . . . . . # $ % . . . ", -" . & * = - ; > , ' ) ! ~ . { ] ^ . / ( _ . ", -" . : < [ } | 1 2 3 4 5 . 6 7 8 . 9 0 a b . ", -" . c d e f g h i j k . l m n . o p q r s . ", -" . t u v w w w w x . y z A . B C D E F G . ", -" . H I v w w w x . J K L . M N O P Q R S . ", -" . T U v V C N . W X Y . Z ` ...+.v @.#.. ", -" . $.%.&.w w *.. =.-.. M N D P *.w v @.;.. ", -" . >.,.v w x . '.. . M N D P *.w w v ).!.. ", -" . ~.{.v V ].. . ^./.(._...].C C :.v ).<.. ", -" . [.}.|.w *.1.2.3.4.5.6.x w w w w v R 7.. ", -" . 8.9.0.a.Q b.c.c.d.e.E v v v v f.g.h.i.. ", -" . j.k.F R h.F l.m.F n.h.o.o.).p.q.R r.s.. ", -" . t.u.v.w.x.y.z.A.B.C.D.E.F.z.G.H.I.J.K.. ", -" . L.M.N.O.P.Q.R.S.S.T.Q.U.V.W.X.Y.Z.`. +. ", -" . .+++@+#+$+%+&+*+*+=+-+;+>+U.,+'+)+!+~+. ", -" . {+]+^+#+/+(+&+*+*+_+:+;+<+[+}+|+)+1+~+. ", -" . 2+3+4+5+6+S.7+8+8+9+;+0+a+b+c+d+e+f+g+. ", -" . h+i+j+k+l+m+n+o+o+;+p+q+r+q+s+t+u+v+w+. ", -" x+y+z+A+B+;+>+C+C+D+E+T.F+G+H+I+J+K+L+. ", -" . . . . . . . . . . . . . . . . M+. ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/search.xpm b/xemacs-packages/gnus/etc/gnus/search.xpm deleted file mode 100644 index ad630052..00000000 --- a/xemacs-packages/gnus/etc/gnus/search.xpm +++ /dev/null @@ -1,234 +0,0 @@ -/* XPM */ -static char * search_xpm[] = { -"24 24 207 2", -" c None", -". c #000000", -"+ c #D3D3D3", -"@ c #F6F6F6", -"# c #FFFFFF", -"$ c #F9F9F9", -"% c #DADADA", -"& c #585858", -"* c #C7C7C7", -"= c #D1D1D1", -"- c #D6D6D6", -"; c #FEFEFE", -"> c #FDFDFD", -", c #C0C0C0", -"' c #E1E1E1", -") c #F0F0F0", -"! c #9B9B9B", -"~ c #FCFCFB", -"{ c #FBFBFB", -"] c #AFAFAE", -"^ c #E9E9E9", -"/ c #DFDFDF", -"( c #8F8F8F", -"_ c #FAFAF9", -": c #F9F9F8", -"< c #A4A4A3", -"[ c #F4F4F4", -"} c #CFCFCF", -"| c #A2A2A2", -"1 c #B8B8B8", -"2 c #47473F", -"3 c #0A0A09", -"4 c #4B4B43", -"5 c #B4B4B3", -"6 c #F7F6F5", -"7 c #9E9E9E", -"8 c #A9A9A8", -"9 c #34342E", -"0 c #9D9D8D", -"a c #CFCFB9", -"b c #C4C4AF", -"c c #8D8D7F", -"d c #353530", -"e c #ACACAA", -"f c #F1F0EF", -"g c #DEDDDC", -"h c #D3D2D0", -"i c #B7B7B5", -"j c #9F9E9D", -"k c #706F6F", -"l c #65625A", -"m c #46463F", -"n c #9C9C8C", -"o c #E2E2D0", -"p c #EDEDE7", -"q c #C0C0AC", -"r c #B2B29F", -"s c #828274", -"t c #4C4C44", -"u c #E4E4E2", -"v c #E1E1DF", -"w c #DAD9D7", -"x c #D8D8D6", -"y c #CDCCCA", -"z c #AFAEAC", -"A c #88847B", -"B c #F8F8F7", -"C c #090908", -"D c #D5D5BF", -"E c #FBFBFA", -"F c #C3C3AE", -"G c #B5B5A2", -"H c #A6A695", -"I c #9C9C8F", -"J c #080807", -"K c #CFCFCD", -"L c #E3E2E0", -"M c #ECEBE9", -"N c #E9E8E6", -"O c #D5D4D3", -"P c #C4C3C2", -"Q c #8F8A81", -"R c #F6F5F4", -"S c #F3F3F1", -"T c #090909", -"U c #CACAB5", -"V c #DDDDD0", -"W c #B7B7A4", -"X c #AAAA98", -"Y c #9B9B8B", -"Z c #AEAEA3", -"` c #BBBAB9", -" . c #E8E7E5", -".. c #E5E4E2", -"+. c #E4E3E0", -"@. c #D2D1CE", -"#. c #8D887E", -"$. c #F4F3F2", -"%. c #F0EFEE", -"&. c #474740", -"*. c #929283", -"=. c #BABAA7", -"-. c #ADAD9B", -";. c #9F9F8E", -">. c #ACACA1", -",. c #CFCFCB", -"'. c #4C4C45", -"). c #B3B2B1", -"!. c #E2E1DE", -"~. c #E1DFDC", -"{. c #979288", -"]. c #949493", -"^. c #34342F", -"/. c #878779", -"(. c #A0A090", -"_. c #AEAEA2", -":. c #C3C3BE", -"<. c #010101", -"[. c #B1B0AF", -"}. c #D2D1CF", -"|. c #A49E93", -"1. c #F0F0EE", -"2. c #EDEDEB", -"3. c #DDDDDB", -"4. c #898988", -"5. c #414141", -"6. c #737271", -"7. c #A4A3A1", -"8. c #DFDEDB", -"9. c #E2E0DD", -"0. c #E1E0DC", -"a. c #E0DFDB", -"b. c #A19C90", -"c. c #E1E0DE", -"d. c #CBCAC9", -"e. c #B2B1B0", -"f. c #A3A2A1", -"g. c #9D9C9A", -"h. c #9E9D9C", -"i. c #9F9F9D", -"j. c #ABAAA7", -"k. c #DCDBD7", -"l. c #DEDDD9", -"m. c #DDDCD8", -"n. c #A19B90", -"o. c #EBEAE8", -"p. c #E6E5E3", -"q. c #C8C7C4", -"r. c #B6B6B3", -"s. c #B0AFAD", -"t. c #B3B2B0", -"u. c #747371", -"v. c #9D9C99", -"w. c #DAD9D5", -"x. c #E7E6E3", -"y. c #E6E5E2", -"z. c #E3E2DF", -"A. c #DBDAD7", -"B. c #D4D3D0", -"C. c #D0CFCB", -"D. c #D1CFCC", -"E. c #D1D0CC", -"F. c #C9C8C4", -"G. c #6B6B69", -"H. c #CECDC9", -"I. c #D6D4D0", -"J. c #9F998D", -"K. c #E3E2DE", -"L. c #E4E2DF", -"M. c #DFDEDA", -"N. c #D5D4D0", -"O. c #C0BFBC", -"P. c #7B7A78", -"Q. c #BCBAB6", -"R. c #CECCC8", -"S. c #9D978C", -"T. c #EDEDED", -"U. c #E1E0DD", -"V. c #E2E1DD", -"W. c #DBDAD6", -"X. c #BBB9B6", -"Y. c #A6A4A1", -"Z. c #9E9C99", -"`. c #ACABA7", -" + c #C7C5C2", -".+ c #9B9589", -"++ c #E1DFDB", -"@+ c #E0DEDA", -"#+ c #DEDCD8", -"$+ c #DAD8D4", -"%+ c #BDBCB8", -"&+ c #ACABA8", -"*+ c #B2B1AD", -"=+ c #C6C4C0", -"-+ c #999388", -";+ c #999891", -">+ c #A39E92", -",+ c #A39D92", -"'+ c #A39D91", -")+ c #A29C90", -"!+ c #A19B8F", -"~+ c #9D978B", -"{+ c #989286", -"]+ c #918C82", -"^+ c #938D83", -"/+ c #979286", -"(+ c #666258", -" ", -" . . . . . . . . . . . . . ", -" . + @ # # # # # # # # $ % & . ", -" . @ # # # # # # # # # # * = - . ", -" . # # # # # # # ; # ; > , ' ) ! . ", -" . # # # # # ; > ~ > ~ { ] ^ # / ( . ", -" . # # # ; > ~ { _ { _ : < ) # [ } | . ", -" . # ; > ~ 1 2 3 3 4 5 6 7 . . . . . . . ", -" . # ~ { 8 9 0 a b c d e f g h i j k l . ", -" . # _ : m n o p q r s t u v w x y z A . ", -" . # B 6 C D E F G H I J K L M N O P Q . ", -" . # R S T U V W X Y Z 3 ` w ...+.@.#.. ", -" . # $.%.&.*.=.-.;.>.,.'.).h !.+.!.~.{.. ", -" . # $.%.].^./.(._.:.<.<.[.}.!.+.!.~.|.. ", -" . # 1.2.3.4.4 3 3 5.6.<.<.7.8.9.0.a.b.. ", -" . # 2.M c.d.e.f.g.h.i.<.<.<.j.k.l.m.n.. ", -" . # o.N p.w q.r.z s.t.u.. <.<.v.w.k.n.. ", -" . # x.y.y.z.A.B.C.D.E.F.G.<.<.<.H.I.J.. ", -" . $ +.z.K.L.K.a.a.M.M.N.O.P.<.<.Q.R.S.. ", -" . T.U.~.0.a.V.a.0.a.0.W.E.X.Y.Z.`. +.+. ", -" . = ++@+M.l.a.l.@+l.@+#+$+R.%+&+*+=+-+. ", -" . ;+>+|.,+'+,+b.)+b.)+!+n.~+{+]+^+/+(+. ", -" . . . . . . . . . . . . . . . . . . ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/send.xpm b/xemacs-packages/gnus/etc/gnus/send.xpm deleted file mode 100644 index 44ee4935..00000000 --- a/xemacs-packages/gnus/etc/gnus/send.xpm +++ /dev/null @@ -1,85 +0,0 @@ -/* XPM */ -static char * stock_mail_send_xpm[] = { -"24 24 58 1", -" c None", -". c #4F3F0A", -"+ c #000000", -"@ c #F4E6B5", -"# c #F4E5B3", -"$ c #EDD684", -"% c #755F10", -"& c #EDD580", -"* c #EED685", -"= c #AF8D18", -"- c #EFD98C", -"; c #EED88B", -"> c #EDD582", -", c #EED889", -"' c #EFDA92", -") c #F0DB93", -"! c #735D10", -"~ c #535353", -"{ c #FFFFFF", -"] c #F0DC97", -"^ c #F6F6F6", -"/ c #F5F5F5", -"( c #F4F4F4", -"_ c #E3E3E3", -": c #EEEEEE", -"< c #4F4F4F", -"[ c #EDD37C", -"} c #EDEDED", -"| c #AEAEAE", -"1 c #E4E4E4", -"2 c #434343", -"3 c #FDFDFD", -"4 c #F3F3F3", -"5 c #E4BF3D", -"6 c #CBA41C", -"7 c #D1A81C", -"8 c #907413", -"9 c #7C6411", -"0 c #ACACAC", -"a c #C8C8C8", -"b c #FBFBFB", -"c c #A0A0A0", -"d c #D4D4D4", -"e c #F8F8F8", -"f c #F0F0F0", -"g c #EFEFEF", -"h c #ECECEC", -"i c #959595", -"j c #3E3E3E", -"k c #4D4D4D", -"l c #818181", -"m c #C6C6C6", -"n c #6A6A6A", -"o c #636363", -"p c #B9B9B9", -"q c #737373", -"r c #7C7C7C", -"s c #BCBCBC", -" ", -" . ", -" +@+ ", -" +#$%+ ", -" +#&*=%+ ", -" +#-;>==%+ ", -" +#,',>===%+ ", -" ++++++)$&=!++++++ ", -" +~{{{{+]$$=!+^/(_~+ ", -" +:<{/(+,[$=!+:}_<|+ ", -" +{1234+56789+}_<0a+ ", -" +{/1 c #7EA379", -", c #7DA377", -"' c #DDDFD3", -") c #7DA378", -"! c #C9D5C4", -"~ c #7EA378", -"{ c #7C7E73", -"] c #DFE7DE", -"^ c #CCDACA", -"/ c #90B08C", -"( c #76986D", -"_ c #6C855E", -": c #22231E", -"< c #3F443B", -"[ c #C8D8C7", -"} c #9DB89A", -"| c #76966B", -"1 c #3D4237", -"2 c #565B4E", -"3 c #9EBA9A", -"4 c #3C4237", -"5 c #5E6154", -" ", -" ", -" ", -" .... ", -" ..... .. .. ", -" .+@#. .. .. ", -" .$%&. ...... ", -" .$*&. .. .. ", -" .=-&. .. .. ", -" .;-&. ", -" .$*&. .. ", -" .$*&. .. ", -" .$>&. ", -" .$,&. .. ", -" .')&. .. ", -" ...!~&... ", -" .{]^/(_:. ...... ", -" .<[}|1. ... ", -" .234. ... ", -" .5. ... ", -" . ... ", -" ...... ", -" ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/sort-column-ascending.xpm b/xemacs-packages/gnus/etc/gnus/sort-column-ascending.xpm deleted file mode 100644 index 76d7f93e..00000000 --- a/xemacs-packages/gnus/etc/gnus/sort-column-ascending.xpm +++ /dev/null @@ -1,29 +0,0 @@ -/* XPM */ -static char * stock_sort_column_ascending_xpm[] = { -"24 24 2 1", -" c None", -". c #000000", -" ", -" ", -" ... ", -" . .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" ..... . ", -" ", -" . ", -" ", -" . ", -" .... ", -" .. .. ", -" .. .. ", -" .. .. ", -" ..... ", -" .. ", -" . ... ", -" ..... ", -" ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/sort-criteria.xpm b/xemacs-packages/gnus/etc/gnus/sort-criteria.xpm deleted file mode 100644 index d1c83b8f..00000000 --- a/xemacs-packages/gnus/etc/gnus/sort-criteria.xpm +++ /dev/null @@ -1,55 +0,0 @@ -/* XPM */ -static char * stock_sort_criteria_xpm[] = { -"24 24 28 1", -" c None", -". c #000000", -"+ c #FFFFFF", -"@ c #D3D3D3", -"# c #F2ECE1", -"$ c #F4EFE5", -"% c #DFDAD2", -"& c #C9C4BD", -"* c #74716E", -"= c #FAFAFA", -"- c #EADFC9", -"; c #ECE2CF", -"> c #EEE5D4", -", c #4C4B48", -"' c #F5F5F5", -") c #C9C9C9", -"! c #E2D2B1", -"~ c #CFC4B1", -"{ c #BFBFBF", -"] c #C0C0C0", -"^ c #C7B99C", -"/ c #F0F0F0", -"( c #B7B7B7", -"_ c #9A8F78", -": c #877E69", -"< c #AFA389", -"[ c #A09889", -"} c #314E6C", -" ", -" ", -" ...... ", -" ... ", -" ... ", -" ... ", -" ......... ... ", -" .+@.#$%&*. ...... ", -" .=@.-;;;>, ", -" .').!!!!.~. ", -" .{].^^!.^.~. ", -" ./(.._.^.:.~. ", -" .....<.:...[. ", -" .:.. .. ", -" .. ", -" ", -" }}}} ", -" }} }} ", -" }} }} ", -" }}}}}} ", -" }} }} ", -" }} }} ", -" ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/sort-descending.xpm b/xemacs-packages/gnus/etc/gnus/sort-descending.xpm deleted file mode 100644 index dddb6eda..00000000 --- a/xemacs-packages/gnus/etc/gnus/sort-descending.xpm +++ /dev/null @@ -1,62 +0,0 @@ -/* XPM */ -static char * sort_descending_xpm[] = { -"24 24 35 1", -" c None", -". c #000000", -"+ c #F8F0EE", -"@ c #E5B9BB", -"# c #895F63", -"$ c #E7BDBC", -"% c #C14B35", -"& c #922B34", -"* c #C24F3C", -"= c #942B32", -"- c #E8BFBE", -"; c #E8C2BF", -"> c #C34E3B", -", c #C24F3A", -"' c #C24D38", -") c #E5B8B9", -"! c #C24F38", -"~ c #E2B1AA", -"{ c #CC6B5A", -"] c #643C3E", -"^ c #E3B5AC", -"/ c #E3B3A9", -"( c #D07868", -"_ c #982E19", -": c #7E261F", -"< c #120C0F", -"[ c #2B1D1F", -"} c #DFAA9E", -"| c #D28575", -"1 c #7D2617", -"2 c #321C23", -"3 c #3B262E", -"4 c #D68A7A", -"5 c #321C21", -"6 c #3F2A35", -" ", -" ", -" ", -" ...... ", -" ..... ... ", -" .+@#. ... ", -" .$%&. ... ", -" .$*=. ... ", -" .-*=. ...... ", -" .;>=. ", -" .$*=. .. ", -" .$*=. .. ", -" .$,=. ", -" .$'=. .. ", -" .)!=. .. ", -" ...~{=... ", -" .]^/(_:<. .... ", -" .[}|12. .. .. ", -" .345. .. .. ", -" .6. ...... ", -" . .. .. ", -" .. .. ", -" ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/sort-row-ascending.xpm b/xemacs-packages/gnus/etc/gnus/sort-row-ascending.xpm deleted file mode 100644 index 5200b973..00000000 --- a/xemacs-packages/gnus/etc/gnus/sort-row-ascending.xpm +++ /dev/null @@ -1,22 +0,0 @@ -/* XPM */ -static char * stock_sort_row_ascending_xpm[] = { -"21 17 2 1", -" c None", -". c #000000", -" ", -" ", -" ", -" ", -" ... .... ", -" . .. .. .. ", -" .. .. .. ", -" .. .. .. ", -" .. ..... ", -" .. .. ", -" .. . .. ", -" ..... . . . ..... ", -" ", -" ", -" ", -" ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/spam.xpm b/xemacs-packages/gnus/etc/gnus/spam.xpm deleted file mode 100644 index aee83831..00000000 --- a/xemacs-packages/gnus/etc/gnus/spam.xpm +++ /dev/null @@ -1,217 +0,0 @@ -/* XPM */ -static char * stock_spam_xpm[] = { -"24 24 190 2", -" c None", -". c #1D1E1E", -"+ c #333839", -"@ c #393F40", -"# c #171819", -"$ c #B2B8B9", -"% c #D5E3E7", -"& c #AABABD", -"* c #64696A", -"= c #0C0D0D", -"- c #929C9E", -"; c #E7F0F3", -"> c #EDF0F1", -", c #E5EDEF", -"' c #C5D9DD", -") c #2E3132", -"! c #3F4343", -"~ c #1F2121", -"{ c #DFEBEE", -"] c #B7C4C8", -"^ c #D2D9DA", -"/ c #E1EFF2", -"( c #B6CBCF", -"_ c #3C4547", -": c #1E2223", -"< c #191E1F", -"[ c #2D2E2F", -"} c #191A1A", -"| c #252829", -"1 c #7E8E92", -"2 c #B7C2C3", -"3 c #C3D9DD", -"4 c #9CACB0", -"5 c #C3CDCE", -"6 c #C7E1E7", -"7 c #668F97", -"8 c #90ACB2", -"9 c #CDDDE1", -"0 c #485559", -"a c #88A6AC", -"b c #1F2223", -"c c #3F4545", -"d c #242728", -"e c #313B3E", -"f c #A8C2C8", -"g c #B2BDC0", -"h c #CFE5E9", -"i c #C2D9DE", -"j c #81989C", -"k c #A2C0C5", -"l c #85A9B1", -"m c #E5ECEE", -"n c #E7F2F4", -"o c #9BAEB3", -"p c #C8E1E7", -"q c #3A3E3F", -"r c #0C0E0E", -"s c #000000", -"t c #333737", -"u c #B3C2C5", -"v c #DDEDF0", -"w c #D8E4E6", -"x c #DAECEF", -"y c #D5E9ED", -"z c #D2E7EC", -"A c #95ADB2", -"B c #DBE2E2", -"C c #EDEFF0", -"D c #A2B1B3", -"E c #8FA4A8", -"F c #D7E2E5", -"G c #798F94", -"H c #151819", -"I c #F3B5A7", -"J c #865E55", -"K c #AFB9BB", -"L c #F1F8F9", -"M c #F7FBFB", -"N c #D9EBEF", -"O c #ECF4F6", -"P c #F3F7F7", -"Q c #E9F2F4", -"R c #EEF2F3", -"S c #E9EDEE", -"T c #C5C8C9", -"U c #C2C6C8", -"V c #E0E7E7", -"W c #DDEAED", -"X c #7A9DA5", -"Y c #EB8169", -"Z c #B83618", -"` c #924E3C", -" . c #9FA5A6", -".. c #E3EEF0", -"+. c #ECF5F7", -"@. c #D6EAED", -"#. c #CBE4E9", -"$. c #D9E7E9", -"%. c #E1EBED", -"&. c #B8CBD0", -"*. c #BDCBCF", -"=. c #ABB3B5", -"-. c #E3E5E5", -";. c #DCEBEF", -">. c #6A979F", -",. c #131819", -"'. c #B43518", -"). c #E76A4D", -"!. c #B53F24", -"~. c #CB705A", -"{. c #C4D8DB", -"]. c #D2E6E9", -"^. c #CAE3E8", -"/. c #A9C8CF", -"(. c #7FA4AA", -"_. c #82B4BE", -":. c #E2EFF0", -"<. c #D3E7EA", -"[. c #AFD5DE", -"}. c #C7E2E7", -"|. c #E7F1F2", -"1. c #97C3CB", -"2. c #637F86", -"3. c #191311", -"4. c #EF9985", -"5. c #F1A897", -"6. c #E76547", -"7. c #C58B7D", -"8. c #A8ABAC", -"9. c #70A1AB", -"0. c #88B5BE", -"a. c #95C7D1", -"b. c #ADD4DC", -"c. c #DCEAEF", -"d. c #B5D8E0", -"e. c #CAE4E9", -"f. c #95BEC6", -"g. c #6696A0", -"h. c #585857", -"i. c #51190C", -"j. c #D9401D", -"k. c #EC8A74", -"l. c #E17055", -"m. c #DD8D7A", -"n. c #D8E7EA", -"o. c #D8E9ED", -"p. c #D6EAEE", -"q. c #D9EBEE", -"r. c #E4F0F3", -"s. c #CFE3E8", -"t. c #5B94A0", -"u. c #5C7E85", -"v. c #3D221D", -"w. c #782310", -"x. c #EA7A60", -"y. c #E5A293", -"z. c #EBD9D5", -"A. c #C6D3D6", -"B. c #799FA8", -"C. c #558C98", -"D. c #45686E", -"E. c #27201F", -"F. c #5D3228", -"G. c #B86F5D", -"H. c #F1A593", -"I. c #E58D78", -"J. c #C0C0C1", -"K. c #32464B", -"L. c #4A6E75", -"M. c #282121", -"N. c #4A2E27", -"O. c #C6968B", -"P. c #DDA89B", -"Q. c #5F1C0D", -"R. c #F2AFA0", -"S. c #A36F63", -"T. c #341C17", -"U. c #301A15", -"V. c #674C45", -"W. c #E4AEA1", -"X. c #8D2A13", -"Y. c #030505", -"Z. c #A2432E", -"`. c #E4A799", -" + c #D97C67", -".+ c #B66A59", -"++ c #B26C5C", -"@+ c #882812", -"#+ c #DB411D", -"$+ c #F4BAAC", -" ", -" ", -" ", -" ", -" . + @ ", -" # $ % & * . ", -" = - ; > , ' ) ! ", -" ~ { ] ^ / ( _ : < [ } ", -" | 1 2 3 4 5 6 7 8 9 0 a b ", -" c d e f g h i j k l m n o p q r ", -" s t u v w / x y z A B C D E F G H ", -" s s I J K L M N O P Q R S T U V W X < ", -"s I Y Z ` ...+.@.#.$.%.h &.*.=.-.;.>.,.s ", -"s '.).Y !.~.{.].^./.(._.:.<.[.}.|.1.2.3.4.s ", -"s '.'.'.).5.6.7.8.9.0.a.b.c.d.e.f.g.h.i.j.k.s ", -"s '.'.'.'.'.).5.l.m.n.o.p.q.r.s.t.u.v.w.j.x.s ", -" s s '.'.'.'.'.).5.6.y.z.A.B.C.D.E.F.G.H.4.s ", -" s s '.'.'.'.'.).5.I.J.K.L.M.N.O.P.Q.s ", -" s s '.'.'.'.'.R.S.T.U.V.W.X.s s ", -" Y.s s Z.'.'.`. +.+++@+s s ", -" s s s '.#+$+s s s ", -" s s s s s ", -" ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/spell.xpm b/xemacs-packages/gnus/etc/gnus/spell.xpm deleted file mode 100644 index b53f4510..00000000 --- a/xemacs-packages/gnus/etc/gnus/spell.xpm +++ /dev/null @@ -1,64 +0,0 @@ -/* XPM */ -static char * spell_xpm[] = { -"24 24 37 1", -" c None", -". c #000000", -"+ c #8BBB8C", -"@ c #ABD0AC", -"# c #1A3B1A", -"$ c #8ABA88", -"% c #B4D5B4", -"& c #70A770", -"* c #132C13", -"= c #77A676", -"- c #2D2D2D", -"; c #CBDFCB", -"> c #6FAE6E", -", c #A8CBA6", -"' c #6D9D6C", -") c #D0E4D0", -"! c #6FAF6F", -"~ c #587055", -"{ c #B8D6B8", -"] c #5B9159", -"^ c #D4E4D4", -"/ c #67AF67", -"( c #5D905B", -"_ c #9FC59D", -": c #93BE92", -"< c #B5D1B5", -"[ c #67AF68", -"} c #63A261", -"| c #BBD6BA", -"1 c #82B881", -"2 c #75AF74", -"3 c #6B8868", -"4 c #9DC39D", -"5 c #7DB17B", -"6 c #6BA368", -"7 c #485C46", -"8 c #89BA88", -" ", -" ", -" ", -" ", -" ... .... ... ", -" .. . .. . .. . ", -" .. . .... .. ", -" ..... .. . .. ", -" .. . .. . .. . . ", -" .. . .... ... ... ", -" .+. ", -" .. .@# ", -" .$. .%&. ", -" *=. -;>. ", -" .,'. .)!~. ", -" .{].^/(. ", -" ._:<[}~. ", -" .|123. ", -" .4567. ", -" .83. ", -" .37. ", -" .. ", -" ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/subscribe.pbm b/xemacs-packages/gnus/etc/gnus/subscribe.pbm deleted file mode 100644 index fe6b3920d36d01ddc4967f741443ed1930a5181a..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 81 zcmWGA;W9E&Ff!o^6%AEjVsaI6)c=1vR4|ZJU_q?lSG^4!q5*=M6Qq3wL^%W);tK>d j1PojS1T`jbg$4+62?)f1#5qI+1oi*Fb`1$-U|;|M?wb*{ diff --git a/xemacs-packages/gnus/etc/gnus/subscribe.xpm b/xemacs-packages/gnus/etc/gnus/subscribe.xpm deleted file mode 100644 index ff193a9e..00000000 --- a/xemacs-packages/gnus/etc/gnus/subscribe.xpm +++ /dev/null @@ -1,32 +0,0 @@ -/* XPM */ -static char * subscribe_xpm[] = { -"24 24 5 1", -" c None", -". c #A5A5A5A59595", -"X c #E1E1E0E0E0E0", -"o c #C7C7C6C6C6C6", -"O c #8686ADAD7D7D", -" ", -" ", -" ", -" ... ", -" ..XXX..... ", -"...XXXXX..XXX. ... ", -".X.XX...XXXX...XXX. ", -".XX.X.X.XX...XXXXX. ", -".XX...XX.X.X.XXXXXX. ", -".XX.o.XX...XX.XXXXXX. ", -".X.oo.XX.o.XX..XXXXXX. ", -"o.ooo.X.oo.XX.XXXOXXX. ", -"o.oXXo.ooo.X.oXXOXXXXX. ", -" o.XXo.oXXo.ooXXOXXXXX. ", -" o.XXXo.XXo.oXXXOXXXXXX.", -" o.XXo.XXXo.XOOOOXXXXX.", -" o.XXoo.XXo.XXXOOXXXXX.", -" o.XXo.XXXo.XXXXXXX...", -" o.XX.o.XXo.XXXXXX.oo ", -" o..oo.XX.o.XXX..o ", -" oo o..oo.XX.oo ", -" oo o..o ", -" oo ", -" "}; diff --git a/xemacs-packages/gnus/etc/gnus/toggle-subscription.xpm b/xemacs-packages/gnus/etc/gnus/toggle-subscription.xpm deleted file mode 100644 index c0674681..00000000 --- a/xemacs-packages/gnus/etc/gnus/toggle-subscription.xpm +++ /dev/null @@ -1,58 +0,0 @@ -/* XPM */ -static char * stock_task_recurring_xpm[] = { -"24 24 31 1", -" c None", -". c #000000", -"+ c #FFFFFF", -"@ c #F4E2BC", -"# c #F4D597", -"$ c #434343", -"% c #F0CC84", -"& c #EBB13D", -"* c #4B4B4B", -"= c #535353", -"- c #C8C8C8", -"; c #7D7D7D", -"> c #7C7C7C", -", c #858585", -"' c #5C5C5C", -") c #949494", -"! c #F2F2F2", -"~ c #B6B6B6", -"{ c #BDBDBD", -"] c #818181", -"^ c #878787", -"/ c #B2B2B2", -"( c #FDFDFD", -"_ c #DBDBDB", -": c #CCCCCC", -"< c #ECECEC", -"[ c #7F7F99", -"} c #333366", -"| c #8F8FA9", -"1 c #59597F", -"2 c #EEEEEE", -" ", -" . . . . . . . ", -" .+.+.+.+.+.+.+. ", -" .@.#.#.#.#.#.#. ", -" .$%$&*&*&=&=&$&*. ", -" .-*;*>*>*>*>=,'). ", -" .!>~>{]{]{]{]{^/. ", -" .(_:::::::::::_/. ", -" .+<<<<<<<<<<<<cO_`yA;v!DD!a)aaEN*1Zgt8_!JlJn zQy{krIX;|WWA(00d@FKNK33yeum0fNwe04b#2=+Y_ONlciTjNsKc;=XB>!H*8bXu; zf;f%eH~mWD3QLmz|v? z#E&8#9~9skaUz{oexlra5r+aWJ>!^u2QS1!I7}t~fkIvgREq7B$m7J3AGJTl^>HhQ z%zLDRBt(!f_&t6h08&Rfoem)Bqda8pcbWtXh`YdAlfOecd-{7EP5-BGA|$~As5ZQk zKan;q3Rr8>9kWxr(r>hca##3AK6Z2JZ_D`v7K7i zN?6$({eSKc*-mJ~5+|LWo&&_etuz`>kLDY{+Z)e zhh`?nDm^NuA$ei1kBq`mezHNk!{Y3MiRS~-CZ0IENi7{=KmMB9bI?{WIMhLW_216g zEmd?-j#lzIC|`+Rp7A^NxYBMd&KMM4+Az(+6NWRac$x*r*5`(^O#!PZw4}*#Ru-rB zDS?-9sAX=?`3(InzU1$*IJf6K4tZ|RIj07%;jF3l=YIFN*fev)GhK7fZJXyHnOx(t zIAhnG?aJ5{r!*ZHueo)Q(ixnRIj&*6nfXR;y~XiB3RqM72i&SX*4O+1&W3kYeDKqe z9I@sG$@KoKIbKjEzs4JKW5n6ug+zH!$K3c{NPJFJn)DBvH#k$TIHU>BE(Ye>x_Qt@AQ?|^!x2qb|DV8C>2V>`CxlI~23^D>i}dnfZ|Zj1q&A_*1L z3r&DJRUnWA*rpf9!6h~}PBN2VC!S<7$=uwRDZGPo@9+Kb)*ox_bN08^+IyY7kIvS| z`PGG2pL^~(;&ad8D1hDb+;fD2pDmyP*?A@(oCicElhvI7)cF@>yO+Bnd+|Kb|K9oY z=VWJr)|)@0|40Ajr=1JuUzYvi+4cLsc^&YT$dwYBH zvw!`t{QzieZ~pnyTaRwv_(@iGQuabkMRj#uU3GQ!v6ueiov$}HH#hEWezf-S+QxTh zWru*ipQWU*u&}tKqzF)l{V;2N~_jILm`nk zN;)QfZw!Rk`r(HkHd-9Fu*^5VL(%kH+ z@K==dEE2E@F%bNpO>%{y_c%U{$$W2?or(cR$0Dij%gt>~9mB?fs{RE80ulwraXZ`F z)uuraokq{D<usNE`+Qa_o;AW|z1@wq^_{c)JA_Dfe9F54`Yd7qPngvP`qVrSHHd3$#$jX=nG zSj(rtRLh+~%M&3+qZCtxP5WS9E-fUMKi>}qllGXyq%AO zMDLA8u@xUS)i>JA<~c_X7oQRp6%Sufw_Is6pGw7`nYU**vQY{9_QvBLU%7bsVrx%F zSIFWgV-xnpB;dQ1EzRu%LL3S&TA4dSN{QR^d`hadzOk|1*r^NotYQKpdOs*hVvskt z8dj)iBu#dIITtAC-WW7pS>Jr=a*xsSx9&a$DJ3cv3?J3Vo8|TkBqS#5?#xsc3KF#^ z0aw)A&|I%@>Rq?3!E`b>DjtHjtJ|8@t|B}FFL@ANpd-Q0?@hu@G+w?^Z|K$C2$@RL zDRI#d2vZN>3?otuf>iRK;~Qy+guVMfG-o+&+<^DGgji5+R2X3XK681#Fah6LhjSamvgV<-G zr4gcI6BAEqR4uKx>lsKSqvF${(|APO-WU|V<5F8=liO^{b=e6-bW~hQN<^h@ZR`IR z3x>?ByXC9IA>;Od&}qs`Z4H1CFih>kwV_N5GG-4LO>b#vtCx>-xW(o$hM5?Z z1jAa|+gmgXxp*l4^^Kq>0|SlPn~bYyYHY1<_iKX!>roUH9F+nm8kEXb-F+SbhOd5q zW|)PA?cbAx&cEE$TCa4ehVrb3P;^K%3_&!ut6Fu}gakOQq-K4LjYGxkfuQNFjcxU< zUQKVdJ%S>qL?xopJ*p15YP6J!z({4E59Z;qpgkZIMte!#(AcLlX81j5EG9Z0gZNmj zRmi(v=3)@+6V-!PNolZsF(~w4eM|F2eOLP(iJb{gPl!RHXnK{p&3K1Tfa4DotPKKB zDSkf$MUXcsfx>95>Hc8^9v=fCpaSh33WckHiGp)puJweeEL2o95`LzsOs~fg@7~o`QB?xQEFUFGL$TDRo1ulE4x|!As7K2 z1tB0ul{$soDa}Ntu<~+zldJ-Id`t?QplH!tY8_Ks8D19xPly2%QK8+`{rOxJlqL}l zk7P(W;3x1Vz_EB7MGrhc-S2WJ$>_YSuLoo~XNaKKloU!^oAP2?x5CaE2qocBQHiOT zL4{VSaAmPk$;^Dde>|%?FDV8Bhg(_&>Mdltg&e{a)@SGa(k9f>X$WebukD zaQX*fI801pI?k)qs+2Ac8w+C}%o`ieEI9y+fuNwBS9DhzyNzmbO%D#58Xrd>3e~C( zm8FnDhT)1uXS~O9ACN#GWKw3UMp>`zQM$9bjwIt!qM_-;9%Y9{JHY}LWadHP#4Nj% z2aZ9)vGO)UL)*C4%oy~-(b!lBg*@1<(RB3jSR@qnT>k1%!NC)V=tNYK?TYbAW4}RD zw9rLB5J2&S)bF&~j*iYsCJjq07ne^R;2#2(3pQo2S>MvwW7AYtbd%u31Q0&GR;SVG z?7ybd@pw^zc=~W|6+Q-pf_&a=k~egBtJW%Q95@jihfNn70ibP}$w%_~y6&@tV z#p9t{O&WQE%K3kT?wKfKjW}cScwY5}sElU4103q=I5mNtrEL}IjKk2j@gJ+UUW|P^K;+oe^ev_3D z4ND@lw5cw(`#PLl&n-AQISxTNW$w_J{8OxSHknylUiHf#o=B3SVK7WvtL~C=-sH#} zoJ1fJ<6xBA8elS!`@&QXiz*aJYu19NVf(--P-UaKp(S9oih@22G$}5bdP}S6&_9$N zAY=&XIU>oyrNM{rC@>TzZ_+ll{-MX3A9mrA6G2dJK;2<5e)G?5Mvj2WU z2SJln4cg1C-whbU<8CZC9)!$w%5`=dFK3>YDWxX~{UL)N7xr5rFq3 z=2BHnHk;mJFj#It;u66~i)o|N_s?Fl{RD-Og7-RyM#3TzWDg{lscAB5+jZ^wzDLQi zDF{?=XK_z|u)EvIM-$M5(7^cTk%$2Kd@PG6RYy-ore#ad{l#&6 zpg9?eEA|1iqRkSJg7#rc7!!jpUU#WAlMiWdym+a&aQ@hOuLrXyTJ(jtRpTGgU6uzc z2r&sK)_L5FaKNhQ;!;Tz)_>ihuopb8p^~^gNbj)C?Djia8*MZaGLad6KOOn9$)YpK z2x&E+a2Rw(vA5GF!AC_&I$eEZev78*$}}2}BjxiLD41WVvv{hrb7yA=Nb--PK4*{% ztPB6Zw12ust7w!9Ff=BIiNnIt_IAs_{PIT491o6QP7Ke5zRp2KC(L>u4o}+D%BI%C zsoZQH5rKuHx;1w1jLTQOl?j8<0+UrwZyhItqBESEfpEWCd!@-qV+s$@U`RyrLA|Lr z;;~JvSK?vV8vjeevI{lHs1(=GwP0AUZEuj*(Q`gKgHA%HAbpl@f5>bdyUxX;)8}qv za`HEY;Qgsx!(&T+tx?|4QOgvJzYI@7rr-iS{p<4vljjDTfTP^|kxAihiy%>0yK``1 zRBKSe+OM)Q{UJ;e0*Vv|T$5*PhMo}#ih1&PI^imK0F_t@+sk!!zvp;RoQlQV@B2#DabJI>uS>j1R2 zPmmj);h>XYSPY&ctpql*xjz_QUVFK?kex=$65tac(oTzC>eT^1YVC#~w`}Y_8J2{^ zV+kzL%WH!+i!->qwqDE6W>HzWJWPDbrp+=g^5|4brN$ItR|VF{DG($nHI18J^B`a| zJ6GTMX7*9OfK8(F4^R_8qDQlTd2X`{}o}^42zu(U*15J7_ zYe+WmRn}tY@jUXHgV3lbbfg*yMbn2(8vT#dkkuN&V;OmOSA-lQXg}7VokF427aLmj z4vW3tGMTtP1{3Bd#N)qmciF8YIbM@96NUROBFSd*ZqQ=)aXZWc=x>_po7?nelc%>6 z7af%>ktD_uMh5zQF30+`eTsx3u6pybN{;ybxaXrb6gEmyr2bNyrrT=lu`hx5gNsMg zL6AXh*9V++>p<{JJesrSJAkioI0n|zV)xMHJt>d``^780gZ2(h?{!8ZgzsX3!IE|Z zJ^iNLyvAUri+t~r)6W?#<${~D==~_o3IsOP&~jivskH_Enwtz}kDy|aUfn2KWa$|z z1a^1MeG2xAzAleAWDn4yVoh2^GFy4ku%Ojh4CASAXwDcimT0w4F!<)Ku_Y{i@eK~1 z;IiKx_Ye0^okHwE%4gyboeeGAfo7epmx{z^uVP}*`fhsGoW+u#FQTl!j!rENcm>mX z&wG>Ma?t)Rbwa|ZqIICAO*w4#A#gSMsCcBc4=e2S3`}w>GX-@BZ0Kfwam3Uw8g;Hy zqT{qC5ZtD0bBwg;oF;0b^b1@Pgl9cTaN7L6@9>v$MGRC`gk2Hpv#maHT`NZJh0BF; zr5#GuwDF3~){7(!QxlVjz93d=a!yRCXiA;7J`&`4&sA`iSS}}ppHl-mHj)u!0GjbCOykidU+mLZCjnRHbsR(wT zK&{RsgHxZ*WwC6wg2>8-n}OqUis|V-_spo@F|;);Oo_>DMI_j?X8VXz9dPDhR*J#N zq8AD>`6lx}NAAzMaRdop%9J=F%fnvB)8hG>)L3MzFm6m^GJ87YeXfbL@8`f^k%Ys~ zu$x79-}|pV8ooxHmCkd99}GLYHzm_QaUn4-Wdc&Gvv&8icFg&*>4TV9(hVkuF{NM3 z8{3)?Ao5poXv`7c$*`+utSB53<6uk=^qyX%Rz6Jtzj`8-oo6#~|K?tM znobLg>8#J)pFDQkyAK^0+~8nAnAY4lm(tcZ*50=Kiv`YRRy@YfA{2&AgXHm%M*{4D zNoKmx9TbI~1K0SE#%stJFjC2i=~wnTJxXO>&6uc?4WV|Y;h*@;-_aezLR#8KpQKT@ zeNPJfJ)S2o1|tL(69-}|5J@VP%hN5_NrHp?vQ)^yFpL^<_j3h3xA+Xk0*{b6Ia2u2 zfHU}u8{>B*TtWh+6$jC({2qIooHtZTk(0U@#W8jLv-7|l3m|DMIkyG>6!8~I6${~+c-XUCaROe8kB_nY1;KY#hi2d92EZI?N+L>#G;_?2m*~!3inW&H) z57n^ay5v4@mr_---F-5f3gu5jiT+SfT4{?(5K6sLjzp#+SopNt&j09H?iKT>it{jo9Ha_h) zx0&+1{laWK{3AA`*e&~78t9R*58TVcFd|jV3g_sd$k6-;HC4GOV3Q40r0|7o8u@U! zJ&?ggl0q<~H+1}q-}d@AqQy-H@vTs1#<*+!k#Fd4)qj^!!5BFkWK*B;Ta}uUS^Gb@ zWQ4R9Lhn6RCYyCsWqon7n9TTNDOWr)QXBHjoP71mJRJBHRU*8-v#8IguxC5_GMRYX za$4e5SN@rAJOdozjTdv%B*8rHrhDe7-+iz8)6HBQB%>oaQDrJ~7!;Nqw_U_Uu z@AdI(mc7pG+@+&gB;JC6b>BO4*6+G`;P$eZ2*zp%@g_yN-=yd$8a2NIoFCrGgK&Ct zv+s@c<n7e$1faL;^6iD~B7&E_Vv~ zk>7Aq^QSqCRsUA4&$(T)x}2X5!Dt9^R)t{H*xpeyWVp+s5e{WTm<}duX3SffH80~) zId}QgcZU{E54tvv&d(npCF0ejctd-R+tA)|&SU<7MNh5eLO2dOXJXVZ76cA**;zXo ztksFz?+kgK)Gp5!(cv(?Gj6f1@~}yx4&5+MFqy>cVhFZZL<$AGi=1oW96EPPOnG(q z#?cAq?2*ODIpFx)V~?ZD5AiHI&Cm;0KZix+9D^czUm`|^hgY(e76lyclY{i*6D!9< z&hY!w;Xmf0llppNcx|T(O**yrhS?*?OwaxrhIW+UuT2D}#9u~ASgcPEP>LfPMS%prg@kES1VOF}JJO$(CW9NcHbF9fx4n21xgHRVaQW177S6rWY zj|GR@g0bP2{0D%Ge^@^z$RHQwB;mX){KWY6<=SgkE3S zM*l6SQ^6S58+5~7)3i8)TFZn`{Did8>Bz52{OjDDqH}cG{acbl6GJbZoVr@WMPhXa z;_PbTq~2(l@S0XcIn**5gf>b@_upKatr(5)a?4M!nOj?;bHTs|kAk5``B;qUUaY?z zx2Ch`eI7&TU>UoNolNzn5`61hk@N2H+_G=q&fv^{mG{ng;Nd5M&{H8E-TCSMfD->m zXEgyXlLfEx3Ry7bG!{4hLc#K{{MUHr{-cb;-8{&ZO)tE1XMDM~kN|gIit2^R9L^Z+v2k8 z);}ICE}^6Ig;3Tcl^0r^{@;I_IwC2lKF%vx|KP|Mp=&R!{sBj{2tfuT(q-`22d$>k zDSv(;16Rs`N^TNF<3IfM-N>A%>hwX8;MJE4jz8FX@8zX(97~UdbjV0}L!Za(?3ga@ zTFa@VvWqd45h^9HF1xGf}x{Gc)wJV)al^jZv=A+wM> z%Vu(Lc~V^7HDOj{u%Kq}kAf3xC4#4aDmwV_&FZ%VgvmScegibD3Xk_2x>>@xHFeSdV4+AGRU-)Kv;A zmz_q=B~c2q`QI+Scq{y1efiPv{_yvzDu7G*;ZafERyk{WQ9SM+3Aj54gFPeFQ+Kkt zIb1T0$6)Y^qy~ z98Lx$l}078_CVP&+1uO4tN-x$tJS4rf`U5npCWceKYjes-~YV%+S#qmkLTwWKamQKNJR7D#Zjlr)$Qgq!>*(cFP2m86XCC z<=xY=<3KWC5OsA&0rdYbXLkcU!|wcLm-*ZNnE(Xr&o_78-UR>z;w$IR9R&g%-_7_6 yz)AwpTs0;R7Pi+aUMXy5JCt+q%6v6tBbb}IOqdDj7c031m}TKMHH1G z#vmd=%A%|;tIO&G4*GzD{jN6G^}nC{xj(|Y%QVgI)oZW4hTmFyHyx4d|8@M=fBn}R z1Pwm_pa1%=y57H^aD;~3h@z+`+KoF%hGkjTto5tSL9$hnaFHZKJ<}wPBZj6*B}CE> zgs@$;0!;lSo_hZU<9@9qlF?lS4jb^iM1CY$+H zd@MtIL1@-Ep&jW}DHRHZvR~(5OWDLxBp3=uBa!G)EF6l&BH_c}afUJVO1oPHyq1>c zrlw{=w;DeW?yj$S*1T(LUccY#@p$})k;rF7n@G^q*iio#TK#)r_lPyQxwg8z@crA5 zAK$+%EUs^QkLf9CM_bF=H-FnZVehauwZFc$y7c|q{I_r476YD5ie@w&(k7tb7`+qs zju{yGW@mY6={vNAbx(jIaksv$NAwSyMx}+VGEarb%F@EO`FW4mSK{<+YFD?tsjK7o zh>eJ>A>>Z1{s4ldHBXqKUl>Ny)BTpa4g?m`jez1|V+o}A5%BI(G+jfOMDdTTJdF#z z(DVzvwLCvR|IO#!y#|{RpTrX3s}yxY2biGx!lJ`f7-Ig1fBk?H0`Hde)V~VRps*qr zNjR|`;J{6FYkND7&~!(;2&Cl1c-N-K-3Z-nEPng8u<#Aocz5wj9D_yB>inWVxP49yibO4MfXCZ+&{~v6#2k3O&42%~w6eIovbOwVadZ2?!WT6E zl@<8BtrsgS=e{Knb^iOp^3rO+x4g2t=-ZtXiJL*3*Tz|(p*7_Pop4iH__6F+U0w4o z|Me1oNY>Ku_8m7e{Civ9EOPr- zR~Em2`@XoewCW9PhfdCZJyz0Z@hjT-QPJMk%5Q3VUtizYBI?rO>`iDp;PXfrc$}hrsI*|Su%c!2&=TUUCe80eE+_QClGh34b|9=-{)EJfOq;gc7owZG!{EL zil3yc7R#Vi+S4KA3wYqi@0(kteHtba+ye(*U0wBf{aXj&vuvKWnjO;)I$xTxnY6uX zm8@GV6!7_?wob+1r2Qom4TtwOH(_>L`-j0$^yv6Fadnlwx%pW{pN(S!YDG_HtB}v* z3ENuR<%46!V(egd!v~?_S@Zd~c7w62n+MYAz-)FLH)=+DmCA0hfD0~xxI;c{CNkmO zP5-)Y4X8J^_ru4Dbmk^|UoMt%H?-rcVL;g>7C<02HZ}{yol4zfJiG-nSXtpLvmV&o z2}UB3lXxPTDb3jwVm|mUI7NL!6JIPb(5dJa1l!`m!jB(|t82cE!*KNE;_5ign9LF$ z|J6OflKc+Y__T>lp2qe9K)$>Hv|j)A;o(7We`hmtVeaZ|;LQ210nngZJtmjy_11JG z=m*zWUR?%LanoH~+6vjFt*uuIaXk`I1#=FdU_&(e?Y3(%IAmll6~TRm_Z zJGm&}+M5QEqFXXHFgS648a?!U{{b=kV_|V&adBaOxgvd0yn77=pnS*c5Q*g~sU{JN zZ7o7jab61HyEs3;Y8>B^)W7|Q=bI+M`=&0DcqkL!^ek{b|JuI8(Q8YeHvKzv-J7QR zH}8e5+p(I^MDU)=DMP9-)XY=vIllI_t&47U{@PfU3s!1wXp)u5RM_{goZr5C0-O8sV3ptA-rfR8Q1_;h#}f!U@ZjFgM!>h~3wYNL z1A)NCRfYaEpjImshVrzfN}#iImd5-0Z6v0Ws8mvstcTyOP#bJ>khy|;!Dz_0xU}$N zX?fM}Uk^SKtg5M=gFe9Uca4orEplffx(c2Lf;|cj*V6E={vBt{cMb0aBWGJ)pMP~>ap}h*PgxhTp&D-`n4bB~DoL z7rnN-<$Xil+eRK=*5A=%F@4$Fjf6J5Yb&0`AImF?ORLLE5Z3E~aN!QKwDVhEarxbQ zQM*vwhwH7e3v0+9@Iv_fSXx;2tSl_7EU$-lHp#Y@F8(XrzHJ8U3&d?*V3hS%EMBJc0u%iEh+9DT9kT4Ge>*cO~ z^ZR!|`?kJS+RT5_2qX>xgtX2wkoE0suPv{6mY0_oSJ!`pMid26b8~ak`$pl2gkQN- z$Wwh1^YgHnUY72p=vz(>tcH|b`0nj z+1%K4>vs-|odT0gAQZK=D^6)8aU48;N``S=Vn2Ej4+LVdz2nN|!A?{^vQ0AmO>!B8 z6ar?{BbZd3-wgK-?)hY05u=bNQ%c&0E{;uMe_(gj>+v4% zEFT1+MS^Lixpo%pG~)G*jr9$Dxk|3?>Q>3E^oQ%cfN$-e0QPSBcB0W>Fhj9R0rJ0@~%xFXom#Z^!|NgLt`^vBoMW$O*5(R z*7_2Matq)P3!cqnG*q+=4EHD$9pY9I7CVY4h3Wt6T|Gbh*bQ+avbbNSF_xtz+r4FN^i&FHDVVbaxI?$M0 zCKk1~cgxk-#rb(;V{>n7W8Le6bP?F!JYvZ{KJR@a2-++ZiaUhD9>wU>)d5gI)OjIA zuPm+jH#ee#I(6SbU$PJJ@Pp1ISe?EW)0=sG?L`n*e=NxrRCQ39c+#?HpK^&+8g3`qvNMOnyYJf&JT zI1`JkaZ$&$(D`1dqp{(AeM3WiV?#qd}N#Y6}TEi%Cj|(hZ}i*F-W&{b%D-=Jl8IME)Ph1=7T?~0 zT*Ebelc1%A*D7w|cYpNmZ7na)``x@Yq40gvD1g)7wr=N8vA*%`yQT(yXbY_^1(r@* z+9YC8_ueaLz;Fx85wKsTw%ub#LP<%Zp1M&+^L3g0H>1L)_8X-6QE3nO_h2%U3G?E7ALhgMj~PcXh?P z{5`7R(kawlJaZTd0$+d~QE^}8CMp#T?`Qq%fWIkZX=tdcfA^Nh>&wUH7tWT)#3K@I z@1Nk$-Syvo&*O&QyR>2*8|-=mS+ud?U3Y9qzE(It6}0qUsbqUwN8aG!(sCxSyuQAk zG&w&`@*ssO-kC2SPrhK$3yDBn6bdYlr{~r1;^H!tEo%!a`)Z{+j}J7wY33DAABThL zj$f2PS}*AAvlNq|!1oo;{L1FK#}f^I60{2i6Qg7Oh&LWRk_*~GQpe2|Qhg0xTxYAg z)gMcH>$}IA>8D`rP~9nMlMeUhJ)X*SFx(?(<2SV7iY+MlS(54&Daq_$V8gc_Df>4Q z{*9k1w?w1{^H&Z470x>vV194kb_}BR)zy_+_h+@RcYNLB4QvGVhKJ}asQBWvyh9-B zQLDNO>-$+<%bR9c+({5RUH>+}vlF^Z8kzWccyo7aeZ`Z$_nkglg>5QPeN$^&OQ&NK z%D@oRwnDKu8{XsA5Z=vTI+X6y{!C}ju7?$aLmKPDZn>jPChu%lnNI_&-{-%FKB*n| zGHGA*+c*F2-r1)X0aI2AWzG{^E=lg4pYE@%Q6G#CsmwFA1}mJ{rCn0rAZzbOxy`*i zRD+U!mHWhGXY`+9n}_QFgx}AO;udAUYBaF05K=?w46D7-t-#1cg~#vEX@WoIe=G)) zw(ddm`5u%f8TF8kzzMYSeNAT)HMBG~3gSzF-LVcRWg3K=UVr%T*ND-Qd3E2dcnMH}$-m4AIH0716`?GK9`bK1W-%{5sx%>#Wj=vJ{g}T)Cj0YgXu_LhTfZ5bcFh zA}mu;7lEQY7fkq3AC;Z#7!y0v*5)QDhJu_B^pnTiz__%xBu2srgyBp*t^_vE@nrPzaBbe~w!8<|XAP&KMYkU}i! zkhRv;b!u3V5TSf%mD9`8K0?~=?TkR(Z&nSyYw5c&pnZvk1Auo86KHSsVrl-z{GxAZ zK_}9D)t*sr`q1Fh`g$e8f1tscYbwnZM@_Z)Pn z&FX%McoWv(t7uTem2QoCg!Yb7`$NqlwOl4_>Pe=qKXxDQY{C*}Y2Dh*Zv>*|$j-k#>BvYYF}BNqMB1dp%1l$&4fVpH96g+bgp829)#w!(=L@Y`AU`?fS9^^m5e zdpH}_59JTh!5up+mqJPV^=4yfeP`z|s2#;)ruSV64Xj31f6OmLMIxD`e@K7gUt9_o zLkE`j7NJZ~*ECV}c*6Pfi=;|)zq_-WA0XowS3Aq!e{3Dw6nw?N*_zkurBcleE$^BJ z2AuI{f`GI)R*Hq!<`)9{n%-elJ_HZ^ljF9ogti@@XAh8^TMc2*y#jWvdoM!>-1Nu7 zbbq@T_kCZ^pbD!O^HoqWk@auun)&Zk89=RzvF;vzoiMVpyx>QO?U$_oSO~~RzxJh7 z>9sh641BVUIYF7FxJ@T&Y!;pQ=f4H4vR>4?5%7LLN63D5GGTL~r?W2p*^Rvr3dh1x zfkJ>#CV-bqXJOCM)^<{*kcroiC+ePR?y0OFW#;xV2$hjwgt`cGQ4?R7_bkP^GcT;#knEHPU?Kl;n6ui%Vt|dw zomhmsy0Wsi8HBTS4S^Z2e#EAR`c-E`GUc$M8a2oUgU!c$_U> zq;o^VBk8pWiiR?0up>twEQNqT(4m?@Sx@p8(#YjUH*o!;qTgQfA_SGNVH|{9*#sbI zY?1)9?69FLG@*=y{cvm7WGS$Efa1Y{QKbZh*S6NsD6gfxr3v{0%3Fk*J3dDi4p5da zFtPrH@7^HJC_>%Bwnk+_^=oHf3@Kp2(S;__T8P>^ zpwBMGVvEbMlbl8TR#ZxPzt8U{OZ`KFx}E`p`(9%mlYI)}2pvbUVf544KZQz9>}_Pn zh@SCW$iLn%V{dyz4U%+x-FvQsH1)Q=UJ&#ytnQ5Uj~NR+%FK?BZE72wS@TB|2tuRo ztvJ52u)28(JCjZA_H;2AbmIJXqZ5se|L8~-7gmQs73+@u3@E!*D>jb zl}u2jg3PkNwsdipk%{Gyo+6%*QramN$Pz1nPx99GHYygAU&rH=O0>JSzP^%9pIqFd zefnZpA{2IL(wPgL#BA#mw44XlUoC zbs%~Nss|Y=IHVM#O5FG~Ovfg%nr*shAtoW@rQJWe} zg+hDL;H6PTZpMPE%SqU?X=;+M{a9Q$>H$!xdvoD|#CKG)OWPqOcsg2l_jX87Byf5Xd)`lMCIX%fr9jHl5~>Z4Z$4NLnnT{JUcr(1MixI7tw|J!+w># zL$~LHb>Ol9oJTmY273t`LMVLr0`HP*`ClDkY!_Uab?A`RTA@>>l@gE`K8U^Nn^`i{5+@3JRs%YfqO)0D ziFkd*rbd2qgA!`J?>=#3eX}~_onP^rc@1qM$Ljq0Syw0Qp2>X6^WRy1b7OrY=~-Ab zw09VdN+>xcwjnKR|u${IA%T&B-$Q*pJzaD<8cHySr?%6SiRlz7dqgJZ;mY!cNh}f%bW9%kch@)A&JKA; zx1+dGyehC~&!Yy%So-(=mVYm%kxKaQn_7pCgF$TM&d{fv5F0*!K75I6Zu++)Bi#ai zNA_WPC7@A>VI3q_j{n;Cf9O|8$n?%?AU@b`Qlhh!wVkt)0al7FCxOM7u!S$^!h<_| zmRU4AHj+?cwhk$JXSQ+Lt!S1dsY`$+Xo=D`ME6oOL4UDWg!w%5D|8ZP)y4}=w@RO#i~w^gn~rW&oG^{tzl8S(1s+fih3@f1~# z!oV4b$F83u7dGRbX9K>en`bqKs4tnfpmta|D#yJmkvObB)D&DS1+z#rAd9W7Y+VG8 zL@g3ccyZ}cgH1smkUIR!0h}k)eC<`6&`~0IDi5qIE&o`8T?N6LX7%~Hub9bP^Bd|! zUtrhA?>{W&h5(5&W16mxRoJuMiL8f^ys3v}7nk-@^{w@FZ~5hbC$PGXtR1|;aCAKs zx@g<-cy_v*yAaChr09BQ-K0Xp+MrMc(&cjpUIrcmDG*}XjSr!fA3G;zEoyC_oE*2Z zbEu>|xdbvEB+{P?t4qatK|`b1GU?r^Sli8!ll=rroT3St{O~%PYo5Evq)$=lL?aU@ zS0no&0Z%<3lVP6J&9GGJKe#yX?L0T~p@R6axDNZbJQ=!Oj|_K+1e5B%s6Q^@)sKLw zz3XRLVFUk9Igu^=LdIb;gw?53)X`k`zK!tDFCVwn)xVcm5nA?#Mh%AZWQXE#4xP>n z*Icd}bhnG7AE)=@*B3w22hW;6$aZxCTSV*OE61p;seBs? zcvEKv>&N^cJfJM@{7OuW$F*i+E_)PDoL)~7Hsi;^7wqyh8jVM86&kyycoE;&I!;{T z_E_+^hLK8DCOiIcU685!h6g_!MfV~ZmPr;2{Wj~<*+w`q+BI`$&E}Cco4PU0j@YNv z9i79&rigFt@K`^J>Bq)C?5qXYR{q$G4Z8}5?#e7}&OB_DAGjwfDS#D=O^z4j*@^ zPaRDXzju9Gre!dbXTkdwwz})H-sM$fRSMrVDtumVRBx^@KbP0SNK{wX&IQAosq+xKuq1!qeWXQH*?)}Z{bPkmS)O?&~PLeSn)gM z@DTOW!Th&~_`Om%+&2KvpaP~2VducnMnK!u*xYyFhuZ4b=t#?(UZZa(+1>p1y~DE= z*q3A~eAU_J(z<^Wfa}fV;g9WeNxK9o{h_^ix42athB|kU+sEn%uFiW^cuPa$fM?#D z(RTDQ%HdBkrTAULo%Q=N8Eko9|30=dzwFQP`ETEL9<2Lf9qmm9*S`0JfW45yUi@@J zA#JK}G)Ly=uc>zao2E?Y+h*uO$`>@s9{fky(RMLnzXo^rkz6QJAbQt}CR>_$UjiOK z0}s~u@!-nBzC!}rYQh89zLN9m`IFV%Vye*5!s{mokAr0-e8)%Z;tn&`(lq8oNYe#d z4`$^-6veyx5gGy*7;9=d--c?Z4zBF`7LFU58ajNd8~t?(q}S`WmgaZ4Dphmi+3th= zas7>F!&rLJckorK^9#Fhg{LX(Z_37WgHfo2Zv>()6&pE?#f`>+`qKzHq^B?KM~Cr? zbgQsS+Mk}GHqYbR*8RP%p7GN9j;yVzGaUJfRPCo9(z_DD*OGU=TiBt@ohT(DW!MYL zc)3a-9vB=fWfFl5JW(Ca1b25Vc&4`O{uBMc&N0sA3dzKiKIhU;Z#ui zVM6{n>A3O-B81u?kyZ5i<3BgFj_B;JJl^cZPj(M;s&0v*^8yQ8yr!o zX9fy%DjC0XPFQaWI<4*eED|(ycXp0h4*kABBy>qvZNme~0rDo7DzN1TIu^;~{veYs z910#(jGv?;y+C5AR!IL;;bU*I+Vo(k0$IZ`i$PiI>Vn8A3r;1w}(b+y}dv7lD zSdJ%8%ElfwUUXOPvZ*{iTDyrK9-b7(HI?()psY)}8^Go87*jdB?_EETwu;q}z&6w0 z)4(&F!o$#rL7}c*oPU%Bb+BAU0o>RH=l}d z$IjDkUbAL@;ajkc-=-Gxf~)Hn0-it`TC^#LhxZrOOagvi8tH!RMg}@0mOi8JSN!mC zYwui8*R1shMp|WtowOyN-}7lljM1&#W98e9*~@FG#&{bjj>@#Y0E6}4?S&H8Qc^2; zFR;ZI4j&}20YcoAOJqJ*H0Y6BBZEQjx_GuJ1vbD2~%VeRZqB`(P^UGK287rCCb zEM@5-*gs|YL@;FOMf|aRms8{fzT>VOIt|vP?ZJD5ND?ZZECQ)Z(!@rGK;=sR86Dp-H zwiil^#X5WRxHodd{2|l3p;JoTo5mEf*3P4yt&M?!qx0~6PfsOxoaq?p?9mkq+lTi@ z-QB5MDlZ?1pTx3VU0s8h;p2m&t3yK8JJ2H=ENmPQld{$Ub3Pdj@0}(eRoy1txV?6n zoG}=sW68^4ba$uHFYoSjWiO9WR;?VG{CWkC(L!mYP^fxs#q)6PF0GQOC-SlQ)#XuQ zP9pCgDUg>t;Y5*8O4T}3CVrYojsvy9I-3Y=S7yw;61l>X+}TafNF_@7Tqd@=|7&mz zE7gojEKT2A_vD)QwHxhrTs$7)zcg8s72l zzIiXCqCtFu@hvQG_O(h=QMIwRcY8-C?GPLLl=Rxt%7swa-WQG>?0D9qqK0Ns*S-J1 zANe8^w-*AwK#EKr?e@tO3d;eb8WF4T{wr7?g<-?*%i(^on7@imH8=5klD=)dqQ_a$ zm0&l$$md)4x2!`l@nBz9F-K_H6~5K=R7@0M+e_$N5-kcxn_(%RjbBDOwuD!h2 z@#~enmrE(7KrptjIojSNl1R?IE4%VKe&5!@o?6^R#gF6E*HPKy-tM*JLoRg*8|Uel z39Zs#Ax|>bHy_E-idEgtrD2*+bPkvWxoT#u6bfp`bMOBeDx#hRH&6u*un3nN%n zm%hoe-6KSg3`09X;xZDum5IBxk-%0)A~za_$<$T&sHhmHy4&rC{y@52qQdOgvGbmp z@+drntz1VBj-Cd^@Z@{n7qANi(m7&4pNK|-`F^FU&74T=Ua32}wHer8oEW!7z1uZe zm%LKENwGH8rqIMg*4%9-5Vfim9sQrpk>J&!R1)6J7moM$CREDw{vW-5C=rtgx~IK? zEB$1CL^+oAZl09-q(+;rUj;wzGo*}0jW!yL>t)mUb@HmBhaz?;9mz13&wt_%_@rJp zlPx?W(wQ?s7V5b^J=!W3MmiLekw}oDE}R-wn^Jv#bjip@9GT3;*)`TTG>)HN-DHPG zlyZsdWNW*ml=t-*yTaJ*CgU)cq^IRdeg5*KqU(~X zhi!?&(6vS-k@RSiTbmh0d#5y=P8{Z(m4TifY0vr2)?V4x*Co>*?;a9zbzgUnYVvS* zC!-^Vy7c5xFke)5X+KTQnBv>}wSMI^1^e!0_zl_k^`+6IHYfLwviKa->e+1OT05cB zcAIVH;>pQLo}{TKGLwwgMn~lGi__DX7E4vmPOpwglgVIu(M#o~r&ydRI4!ws>erC! zBXN5&CX=Y$kw`c`VYRwW2&H^Hxf?O`%G8y_W&FB!Q@Od&Df!{YKn=mH!!)Mmf{=tDkM>-rS z8Hd!G57zTY__uw0+(cAvlGmw+q2Wob`SLh?ST>F8aGJjST`~>#8?>XA)Jgc}#WXl- z!=4fs=JC;?&!Yw^6%HLejA&fx+amL6Qlru6r|F;3(}zjzr+oH?u~{6Wn!zFBHXXhw zx=`*Sb(2jdC#2mSU(SO^nHRgkaI<%Cm?vy%)#!jZ5-$yP4~`Sj_1zfOBND1Z+xw?l zm1Ka-?XUX}Dcz_UsbL$te1;i}M(U!Rh2lLv2jtdDBAyDzKUp-rWSTJaN;G;V8j75nCNy~TF!Erre8wLu zgAM}wd6lDR>iU;)l*~rMSE>%#;Be~V>`XU0*85OElT;>c*G!u~v*mc4we)|@jSjOp z_R59-EIZB;p<72^m+Fz)PpIJs%D)oP<7Co2I;v7W?jIyZrRvGslT3=yClguisNOis zT%KK}C#_@32`0T?R>`%h9$9L4>%iF21EqIxXJ@KME|uHk;foYAXt{n=f6B#ACP(!8 z&zJXhvpsFUidXN`q;{w`fAL`YLXfQE*@f9|qDQ&WfuTEcREI}{l)V3Q>G-m6eR820 zF<_Oe#L@I1{AlC)D0+5z{XwqK!w=Vz+5!FKgdrEXM}4Z^3VD?-{B})_k5ProTkD`| zVBmKqOOClPqYlrelcZs6!e(c#uQIxU{=wmRG?H+PsWlcTvQA3y1JOZ^^DJ?0(kK;% z*j^+zK0cwhnLb}9&ng2-g{B;eT)i07gWAc{<7l*`*T8OhJ{&!p9MXHo;Us$tql zPBIjoE2H!m;Hr8|M32tyKdSor*yG5RL9JF#(3vYHmB9_8BiTs!1lNv@VmG-;U+ua? zR`T()rwXRCQ>6>`Q{V9D9G*JOmOmL$C4G{)aZG-ioR~6|&QjNiNT$$TeHQaWF9*mPf}%2XwP?)!lph?m>jl;mwsN+2H3;9DU$YSJ8m`TC#{#M z`xo-=Dt*gVAFpmlmCD|1EPBNdnBgNGkA||k9@#L8C+}R^K}8=r+}X`&m5P3yrF3#a z4X8%xcr0|9tC~lKOyFfsh59D%Mge7}LmJ#MMeoP+j?r9|wxfYT@nl$%GN3mq&qC7W={kcwGr!we+ zcElb%ELpU}6Y;Fws(CD#z9vHlg|5yn^-(xW4@-xJ*u#TMd%xalzq?JHXD9ml?n2?y zg7sqsOTpi>I(S%8@QVqj1AnV|;9)CQGoLTfb?U!uv>hjCSi7}>ldV<@Dsq2gCaIJt_ zCvBIfXX67S!!yZPepEX#JT%5eBUiQoWv{(jIj1Y+h*DQfL~bUA^&cHs_~C#}Gd|2* zB{7rX3zj)4+3n^(DTJFRZOk0zq%Rr6v^#xQ0a&BT1Yq=PCSWcCv3G z6N%6|l{U*-t-oTaxzUMo<=6F76`3c-r!!ZV`SHR2Vf-wSc+xYZV`i%S;;@=^L>?!> z(+PuV(wWU(=RZ#9b&mVHa+$Gx($3D_WT=-}3_SKOo@K^Ib-KsQ$DCgca7|m;~Fyr{U57|CG14$Dph%Q7~QNJ+5XUs%L4BrB#Xw6#*a+l zH)}Oaenj~^GiS5Tu-S`?hZ)mnGhIdQ*-9>#`BVCd2$HBg6JLzB0_89molFUWdX9ae z9rlS2Q_M4>XX)xwE|q2NIscQz_H=!OWrpi(*PLQ-4y*#2n6ic#h zmwm?JU`kK4gCJ%smdbUZOgZf&W^p{0%2gX(hLV~@6lt;|7CB9Jnx%<3c;Uq|>td^f zjVxSei!Q5U&f=ojQoiz#uf8yt#Xg0xv~?QM5A2-MJ0d#?$=*n&3_aD2BoSh+W<0nY>@uMkSve(S^8N+S#YIZ`UvObbU z0&`9bv&rL2-Jlk`y11cOhf!b4q;7~xGC|lTCo)OaG+}fzSpKs7$Ixd-*|L5}YeD2~ z=3#C`L#E=Dfqre~G?BOHjONGG<&9l8;kZo~DEbC7P8is9)@3tTEMK3`E*Z0Sl+I*n zyZNL3qrI5TR-V~nj&WhGC)!4``BbK8G8#=p3C6FI@N0_~J3eEB-{*sm)GW5o7H2V? zH)%f+PbKCN84Zrx#AQwUahhavS*K%`xXu>tAjC!;HT*7DbXyEII{yexZFsuL-i_<+ z_802u9&nMw(HG`A=Ww}<(_|rAeEzD%37aGLVAon`inTbM$mzhD^0=0y*;zYTt(0hp zeFK(0yCf#{X0np2Kqj-5b8H2hbrEznKc}C>nHu#}W2^ScJ!$%Chx(8tX~z7K$mJQ^ z6!zx^X2B3vN9ETa79$bMOgkzSmW5wKRIw>|dky>IDBl-Y0!FaTl~VUKGSe?4vfHc< ztXyJQn~h>I``0;^$rV}jMQAS5g1>mJjSZ#Ld`u+jg?ABRC%-}>R`-l8$vQFddOXY>BJRt}i2yP1Ihe5bAEJe}J z1Q+rQ^8(c!K5ZwQOu145NCN?@Bvmd~3D>Nn#;^bf&kSL=&*3hbVJbC1I}Dpcl~U!I zp>a?n0>uNm)rdJzI1LYl-1xN3;-o4?@Fknwfs?56P@zD%3~ry<%s6ozCjie7`%;DB@fX$!24fjF4xLrP zVRbweat}29Oe46RD$tnSO5PTqNe4!dv#3@>F9e1or`_f(JyuwpWQt`p=lC)?;VA#Q zF4Hg}_`@G^xj!t0%r>k2CR1c^to&57!%v}Ju&)-IvqHK{caOA1Z-Qi2f@FZK))@k3 z1smvhrpXUx`nvK&F@GwU8FQ0(#o=^eBw?$TXcjYBTrg#dE-|xqhpSS0r2pLJ5P*jz zmm_BM=7-80j$>wrV}c79(uHug!V)HH4I-a58v(=rkPfzx%@)7d@VU}GZJ)tjDx`%h zKNqJbwGN8;WT^d4|1nNX;P=1Etlcz=mmeVgfd3(r1uy0b6llN+l`?W#&4__a05LM_ zn8nyf0yK%+tdI%_FlObp@c6+r5x}plDn!z$f7K_vi_545^;H@I|55>$8q|-Xh zmTLs&0?;>4vyb;^+J?Urs4Aif5|U`COrqyn+BAzLd#9ok-U@K*I)?&jd&{1Rmya3!<0U;pk(a2$+b5`z{ zxfwfMqH#M_thh`zwtV~On5F4i3r=V67ziKSO)v~qp`5q_N8pccyz)#}A@SO+pB*oM zDimRJJ7xeS01pt(Fc7gA=7f-AizOB}L9O&yC_YhW$~xm>L6gro?f~ZHC)N(|P+^<| z0XDbe)k3alW)$cG{%EQ=Lmi)EInaX#Zne%aEW`o>9%{8#ip4TXx-r`{h8~Jl7w&>EV9WOuX@LO% zj^N!`2MCT6RN;|y*l~Cb`56idD0vXeJku--RTTuF4QE~eyPzDva9AHvFD_0PhO9Cy zLPV`nD$y}Z;*VKW#3rwl|1!W^WFeSR#`1i@(<3J3~77I%QtF`#w=Coxbx!&E7k6F>uA z9)5nVKpz1zFi#BY#%D1M-rEL9MdTdjf+JKR)C)@jxs!yd>lq*eU>QACo)HED15P}b zpK&;aIWv{=6M}g%3|nPhNWzU*pTP@A0>~hd0*rzQaff3LQBMr_COC4jP+@`xlPnDZ z!yqS40H{KPEl>b|5}*y^k|d;%DkKqy6PSQF4D>rmx>T&fE8;|jVi2r-j9(FzE4gge zSps)~ZxGWq=Su-{q|@F86 z%vqxznV09X6T@f0Q<0mr+5tPV1&8s2i3P2~mMI3A9&nPRK)7iu7~`P?{%M_NZgXYG zSWd_x`9H+;S4)*bFO{0Z^40NJWZf7>AhJqxD@d7b-Irn*)c?rAY@YMmWGC2^bx)m#bpHPl(zJ>%vKbts#m=R~ss)2Wb z>wu&nqZ`T@s>Ir-9MqpOWNc#24jVNOfCGTtn7dM>!1Zt^dMPu6W6nvvKuJZwT9-x(MeS1OrtgNiZhK zJc8#!fZ8 zCg5`Au~Gvp!(4RbiNR+<`2a2eO*Pm$aX4!gs31tL+~BG+DBU25aGG#BxcUOH3iRfL zn1clq7xZ9rhIG40$R9Oq&WXDzD1rb9<{*+OH=qOg^1?u7hm{&oKqmvbhgt%Fgadl` z18{aDSB-;`8h{0YN(u6u6R*-Bhznqzfo?YgaN@)W7Xl_O&?Dpt(nW&9v7lBb3=e<= zrvwSZfGu5MV~8TaOZZ<6Tp%+-HBNLAbk9@)6XBGA4nP|q=KhNbxC~YY20($_Zny$& z0WQOGoZ$qp3BZkoF>nAhI0x1+9-O^^tHUU4mF6Z2cL3(F;7TsQXBZZwfqUQ|N|C9BjEv zp}83wY}ZgMI42J5sb{F(xcctt2`YXds!`<%EQ+~k;(Vk1_f{H&!PKDg|I^!q``6E{e8$XPr#IO6~fH|0^_*L&4T;W zpgHtRxgnoBApPP~HisQOA=YWb>=;#kq_JtMjVW@gOdO{1g5Y*gT@B=h9ZAAPK`NM@ z#^yLrs6p{;#h=Oy33c%c#d!%N4c0b|ljQ;=csuxbg?a(=0Q$dBl`4pXRRPxVnQ0q> zIvQdTcf%*=6D|h45cCaB2D74RFm#Q1fdUI$1+pQG4cUYX9t4F5=QN}fJeuZ8VTdvs zDsoUDBpo+U0+PT4odo!QwaQr-Jf9(Ephke=n4AMAfvSM4aZUtkhq!UWk#NO0s*na zvEc-Mbz1mzK_{mT@I}tKIsXJRL1X}Y0`fuWQiE!PD^a*vg4W0y_z>I;YDN$X5UdV^?X&?4Lo4Y~+8gL5}0a+Q9Sm{YEk z>nB04T+{&sK(PmBaLeD|go|JssJm;B_FwM@(10(TSlkprlGmw$M!61PN4j65l;k*8 zxxs-F#(`cI$hj|^nB0JXJRl2b2W$<5+!5f&sZi> zfGbA^BXa`72RBhJ?!d~xfct|U?(om~U%J{W_3MFS!Ci%${-J{}93SxPzr@@r{6laP zr`mrgVHmCxXkQQi7wPM`9A~%#q z<<>Y=Lg@y(Vl~bWfZ^Y2j0MjC`@$`7CnOb4U`P!dF)Uy~m#^d2suV+jc_F$Wy>bc$ zpaMSN>);a{a&lGxAAMEhUu6Pk#s$&EJ_BmwsLEZ0>JiqxoO{Cjz@y>l;zk4sU&ny} zqgjY-5^7>dxz!p0LjgEI>R|vwAU`v7mBa`ZY6cfqTf)sXC>vNXE^J4_L}2{@W3W&F zaj`)_!lzjTVz94c;4X*+E=IVSaU%acz{KHJ1Z+SxHI5eqCrlCcSwSogLtZUV1A0!Q z&|nS_JHUfdi??vu}%oAb=j+~gBp+LaDZVO`}F1Nu&m^jA| zF8!6AJNc(UKjbv-3pmQ_C-8uYaXlQL*L(hYEqLJTHIVIf7;en}wAWM6F4w^wUhm@$ z|Il!5$W7>P|No$X{#UZsYyXNt*8cM0Zi2smW&6wFFVBBE;S2l9;`P9B{#O7FMu78c zaQ_|umE?aM{*~nKT|mVF4f!hd-{b$F=Dxi0d}Rw_y$<)kNdAA-0WJoy!sP|db^x#N z#|6r(X2G@GTr{zeX8=?<#elK?<2Y;$sJN6tzV-qse8RniizDUy@;`>>Zsi&vRSl8~ zpbvM?>o6?G{;!X6B7it>ClLL2;{@W?>JXwZHpD~?)qw7G7!HHD(f&rwf8T?Eh%+;| zJcGhV=mT7C_!SDa=VNI@7CXdRk(c>`m15eK*f5+>i%>-DW=%3H1 znaky|R`y+&GnwZ`5B)gGNbw_3`_ZtD-DB4@Rb4kt*L7`E*Hv*k?2nhS>BgaBz8eK7 zh-XO{dTY-M!YEOkYO~zxVbGd?eb=_~Zx}iOQI%y;)ty#plB7u(_`c`)K@=-_ChTNG zTUT{E3XQ#xXKb3JX%a_az!7nrq-r7qvQ!#-zUPOjGLWy~P^J`Uff8$38aj`E&1N4y z-7VHZrop?sTrOvxvTh+9($nC6CeN2;tlRQ(*lpk5-uA~ccs49i>l=Cd*CI51bvYgP zhr{VowmtlY(8yn}18@0oKVLdWD9EZR{CUP5ym z#|qZ>UDs4FWK8|#V&SaUYZw{jeSO-#ZQpkLQ!ym&;_mkDaj{se*1j66({{JrpUci9 zq313a%lTsE2Ps=F`|aD|+*p;wVH9|)h2w---(HUU-RV-d+Nw14oW*>;bp2F!RZ+DN z0fz^hg<%k9BJeR!(#)EnN2)NjElx#kqc}=4qhb$wOmjY-%3ftT95?BD?zpM0%SLl( zrkh^JKAdjL)49=6nC7M(^YzN}ZF4*nV-$sIsQb)YF4w9(pDUAie%?2ON}N@os^jj| z$9|Y~b!&pf(o@xbch-R)=55iY?qcrgYQL{-;3s)qbg46U!{M|$*4a8tblZ;p|VIJGKDP1l)h?YN<- zj^|n>i5iC128%^x+XA?0l-Z_H(ZUJTP;4(v5~;Bn^2Bw#R9}v#8Y9)10YrLmb`pf>(U_;0zSuedT(e>$E^jN3P zvuN#xi1l(jG`Yt7#>AUDq3X-yvF=w=G51Y-VNaH*XKmR$q zv+&~d&t`K*g#vYpxy7~{`>!lYeLq%TnDLuVcT8;bou36RGq=pxJu^SBfN{mltT~xX zW;X6D>#_UUOr4Z!WTyX;*jQ$~%itF>Q$IcqOPL9a&U=xW?}^jN>9e~b8lPq6YiqCG z;l@!%nc!(;1$LZL%03sb^p(9$g=gF zyL@mT)o?88w>?T6tim|T)~aa(U1m)eM|Bq@gpr~sbKM1xZsLS`Y>I7B44uwGXCA2a zM^l)pt?HL5jUtt()DTEkSru7qenXDl2Mh%$kysH%Dt#glh=KEcvt3cx_LYsAY)IHacim=IBr)-CPGrXOH%(z)}8|`!y4X4YvPRlm*{IN0q z@KnWWRN38aE)KT%v9p|*xo#$$O5(JP@*y0{JkWRmn^n6os*HCp9x+U|#|GEk>xXqc zuJOiY=vTd;W=JQD3IcLgp3`M#;`w|Ee$7*zXZRKGzB?PgEW30;pvW9^sBGF*O|mwp zWS;k9cH@-;4)eIzQQGKqi-TA!XP(`T^+oLF}_?XvDrU@z1`&{S=kE{4)un7(V2x*Q{4D?8?@>ISv^7&kX* zXLLtqo2!Qw@(7=#@Z>j`FP3mbas1j)bHn^odGB+cPa6#GN6^1SuRt#);DD!XttADz#(I(%=dAN!CL zAe`UnQ+L^3_9b}?Ki;rCk>H$+vm&cn*nQK!y_{S3%Y(c46ja;8asRT-maE|5c5Z%D z{p;U_{cF}Ivt`q4PDG4s87$rTY_U`y3Hnh(T2#&VKf1ATKwYi$8swcQ2bCL>2A*^(U!l8c%Vi zs5=Ra_wKr4>Gy9tIKkui<+S%?Kgq|B={1%-hf}y&d+GGHC?tf=ZmysV1={;HDMjelPrz0IcF4#9CfOBT1$O|@xtodqK_VjBHM8%V<7P0MeD=8foGkU`soi{! z51(dg_CbAdzZIuVb9r9+@u#IT?~BX!b=MLp*Wn_J17rVczvoeLK3S68$Z`8N%Bs^~ zPRD`VEfdilk{e?BrY^RN*`s^6FxBRDzj?KGxo~HX!7Tp!eE#S8d%XamFZcNC^N(-G z^JR#f2giSO{Ezh}wwrU)huS{kt;l^Z&tvhTW925nqyK5PDQBBgz6sN(a5lOh&&$K6 zFE>q}&k}bQ#~=Ok>r3_YwGJJ}yS)ob($gQiVXR`;U72KMyNAVaNs?+?r>YsfRoo{2 zaIUp^-sMeURv&JWb$L#<2)>SbbZU_%k}DO*=YD>7A1-f(Hd(fRmu_=v!&O@b!B`ZL zJ~v@#x4k+a#&op?$k}|_Z2sPi>9a$=ca!AR=7>#X@xuab8BdOmw>YZF5!Nb$)&+NWqi2n+^%(Nw3Fk;@MsY z(U4M!&fUJZ$NjO&##{N+c4i=HxY;l{KFnjI0f%>6`L z@-0m%@7=D>W;h)7CK=)d^{}>=}{8Bc_g48>tl06V(r~!jOpl$0eSzs{BrTX!De%Y7t+*{rGFoPm&i~@JL z3@Xrh?W}wEcyphr{_XAgFqr6mu?X`1xIGqw4Ht`bY^t}n-9?29e1@Y;^Uqsx>Ep*+ z*AMk&cPOgCTPkh&EdIjZRp)EG4=AauSXL&jvMC}`aGCC5&3qN zQYcEL6a5{Exoz;(Sa35u=YHJcqONS<+fl$#r$!UV5Nv6AV z-8M8VT(W^!A>pnZX!fW$)gwI_+Ch09C-iMhF^ne??R6Bbl9usC z{;7*YqeG?RP>n-N-5N*hh_ekvKdq;X(merV>1XB2f{3BE?{(elAq!$ROtKNJmvA@p1sqjCKKKyygY@`j`+(f&?Gb_w1#t zriP&%Lw`?Sn}2$wN2i-{!0$v+M4bc`0J76c5akW6JOQeWbm3Y$RdEytah&Ab|Ag0$VHHmJ3u8I8`ZkWYgUJUF`(M2WVX3>Xmw)eKuH@n|Ok0h(cI6vZjMk%kr^ ztqh?`v_?Qnd(|QvZOOgCt%GJ%I<9 zbVgfQ?#I|`Q@6BMqSz)0*2#L*ndOSf4(Kt4(A6CcW8Xvnl`J3gh;B|oL$mK&fsW{4 z7beQ`EN|KxdrQ_~q*O--ne2;tHBl|C(r(Pq;xskQfMI1>l&6+PvCgdP1R~l@v^$P?5j4X6^rNY>!RolEz>m;IPIvp z!zHa`HC&Dtk~V+23eDIaj}@i2>wurGFDWEA0B~_E6}_RNYh8u$>wzRWz2;Ee$J;aXlq(0y-mV|eq~bw zJWYZGk6^_4B?+0cM*VA)EJ!qbD_iVZpp1rDo5qPx@EgYo7u+Mp($tO4Qa{9!nsbTc zPq+fW^Iixgc)Ey69nEHI7)6%0c1?elWGBV%kQCsieD)4~N&A^%99B-tp)|nxa8FSa zNkTuSpG>&Jh(j;310D8G1uFCu3B*YCh)bn+-PKJ!WGQ|y8n{%TT`CbUR3Og-smFdUo z(&N};a3BidGi(}!NSRfAsv_(WtE;L8Zxh30{20W`)lL)>cf@;QkIN26(N=A0!_W^9 zR$a9{jKhK25$zi4j1)FWutxEODeX1*+>v2V83>Q4&TP2Lq zxa_U!8j~wZ4Uk3$iBzOHG0tfyz}&`opCKhk5QK7a8i`C24ozl24fRdA{DLuLz>3sJ zA`#I*k`L+Z1;w8v9b~m+C@83?4^R|wlXxwxOv4DLJC;aWHfE!; z4F{4T;{Aw?RudOt5bA-J6Pdsl)r7)`3mIz~i8PW8fFv1=J5n9qyoP1$kB~_+ z(qUX#6dE#(n(M19O#!cQf8EQ#1>DwoA*JW&L z1TDGcB6l!YIQEBprZkCz8K6qwt_aL^%|+AbWjf&ss!RLUV5y2uCMMHctWsgnl15q- zK{8A+W5U0P*N~x)9nE7nPwq%!h%JE=%z?9b0W?ud!iMj~n$d<)l4>~^6++!{6(Jcm z#cVGfYq^n>)QYQMu;)q&LlmP2kffm8eNTY+ly{xAy^T_A6S1IZkVC#K$BMT?XC?o| zV4+v8&@eQ^W_I#W{u?e0Gjd8YUmO!GCBbG9>H}_)_=zEj(IEfp7?%qcvU`Lm{FP*+ zSiI~Y3_>(JWGuU7EH#1bmXpaVu}k)IBTL>&ZU>vhC18|TJDveYi7T3Jx~Uwd9pVw? z?j1)UfOz01%qPxHoI;bi>tqjvQy3T-=cp<^Q}(c3eAVQBI2r_am*t)1hA&G=O{pD} z!pblMQGZMX8-imp7M~^K34Qrm0f);M0{}ybFm^VEK3K0aI4<N)VsM1d(Yh@5rb}k_jm!!3?=!hnLjZs4*x^Dh;Kwh5wUartK3S1q}fp7)&hX7y7|HnKS}K zC{~0b2g7M-68qw?$q1&y1%Pb60uYqMzw;#ulVDajNk9qTgbq|4b_&DLjNfpVu^=a` z6`{y)F>Bb-4umg1dOoeogGqnG8BGD+{R&c2vrjqL4r(!gaZao z%oG5)l&d-;6HyVthDThB5F;2(jNz`HLNn`oiYJWBqHEGaz)#^x@lO*supjL7r*?n> zz(hJg;7p`K%}Ov3Dl)t;c@>$CnBLXIL@JOmF$P5Bna0;41X*xFA5Cl1mb#dbOT4FO zLk@=IPYy&qB&>*a{ZtRchS!>$<&_jB;Doq2yaD>bTG1OhM#dZ=Nb^xNg6H?~b!M8q z;zwIZD}&w1eRPKSNICGrXfBev5{B|X*j3__cqFQTkMt1;#bYPQDk%kYNWDXdM02J< zB_V>1u#q`1{OP!$L#z-)MNaT+!kS}6X*)%olT3UTrG+D)g=2>}L?Ch&E&ItG_VNQk zK*DjfM)lp1_BFU}L2vh+WiY!Ph6^{c}!X4lWXi+1^_$R(fC8n2=S>s{{ z5sTy_@b$_XST@BQ&;Z6HD#7SV*}p`J{3b*Nr7L<9Vv2f-gc@x}iBMHdj!3gdBsnRO zNRaigOXM-JOSTK{89^i?&q~lEHc8(}P!PrmEf@w{00RA!0Dtj(5}>e$_h3Asb4BIT| zI$0z7IE5=Y8fm^$DTp!T&xF!%LuQaVi2!W|>20C0sc5DoazZmN#q9wJW(ps!u8!#| za#!Lddm;eq6#n5);2+8cucTC)BBvPbM2j%!r$I8FWGFbi^G`5*A5JS7Bc-bq(^nD( zqFv;;f(u%Aby)O3Ig9ah)-~J1my1Tpw7?grpzuC~V!SyGERito`C3?uR}+GTO7Uvb zE@7N#$Q3Q784HFo{S!rj%0bkplO!+<4xn^F1t)(vIdY*@pj;vR1o|!tgoQ;HfA zF`f6$G4U?&k+*_9j|}AGU&Cq4HhEaf8Ne0t4EipPM|43L@ecSGA^)n-LiSlY!L;GDh!Qt0c;kL#!$iVQmi>e-tdLEDto;6MD0A<#*P*=s{b7eJ z7fMj*>o<9^PdOGw%E7;moWTEreccD_=|}6f&jce6YQTK{>xthGA&~_>Npa4@Qvu+qy%DcycQwz`l`;q>EeIq zCKSAb|M{1XzYVW1e;zsslYo^?ttqN2)Ct#v7vVr*vpDK2ev^j%OWZG<{|n3hJ?g(5 fDeI<9lP=_0D-|G)c_84EC{E;YB0rO0-%tAggoprA diff --git a/xemacs-packages/gnus/etc/sounds/Snicker.au b/xemacs-packages/gnus/etc/sounds/Snicker.au deleted file mode 100644 index 61a4e3c88c3a3f659e4798b1842e25c4e180edb9..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 7349 zcmYLOcT|(vwx74wd+V;bGk5NtVx^6O(u)-k1OX8NlPDn};Y%R|I3%PXARYbxz5DJo z+aN`U-bX=4kRmEbM+F7^NJ0?~9YsZKoVUL?cfGS%IbYwW{Pu7E_Qoku6ZP3=pMC$? zXQt<%|Buf;vpDprhhJ#RM7KgFCg&nJLK1rlrwQbEg(R;Mt%ygVmv4}i&E|5|M92w0 z7RW^?I&As5P?U(K#w77LCgkKh1HC{9iBm4)_;{}02LQV^~Vv0&eu?gY@DMdw253TSN3O*S$$oL;VvQC7q(v*U*?n(+(J3h;<{^<7p_jTuuKdkNZ=C%7 zvO+Ff*JFG-IAj&$A-y&epNb{(1H;oqO;#{g$EYUyp2}FqDOkp2oO%Lco<@0NX_e4zzQ)Y=+$mL3q z0#A|28A%Euin#$yKa)(;8r9$uiD1bW)I`Y%Rwz&sY%=`{z1Guo!tp>BUp*JflE5|c z@$th1SuDxEv4Gqm5>!Ia8{I}D8er|p4pLr&K+fe?m^V4Q#^_L2qH=1}> zmR|hztN+@3``k}WTfTM3Kc5?HX5Cu&$o^8!7k_u`JAd9~(?++8zg)H4yrcADk>e(d zH&th|zxu+i;$P=2zTT+);iorSH~Hjb-?ZAYud?)9;g{b@uKX+CWP^Ft582LJ%o;A{ z2AXW0zLcXkGtD_?vfbAA$6xO3+`Rw%`C6MTyYh4Dc5dBUo>y&ezUO-3bw{h+y(K?* zePP{q>8GB}rn_^`)o(L(x{_VLV~b;H-gR3Or>jLxHWvG@mo?j4y56Yhcd+rgQ8Daf z=hbv|XrHaKZ*I;8ligjH3hlqQe0ZsBpOsB#VV&y^+xGH5d~6-MYnr?q_H|rq3D|Y; z{?#_mz25CNx&qvTI&O6Zc(A&f`T{)IJuUq#KdPr~gdMDS*f~P6mEG-6WZ{vIyGNtL zUi5T4I)y%tboI{>w9-59N+zCtI2j`d*BI#60=6`rXhdA;2mCIILWE?1D?sCMxm@VD z+)!zToZ|B3?=en6>-4iZGE38=c#SNNKAD&y^Yj=d1dqdYLKZN7n|6|%LMS3C4P`}A zloUlVUt|23qSPc4iNy&7!To43hLSTQ;1>}Uv;Tx3v0@oM#K-NVv9+}!rM@hG-b(A(Tac|>2U zuK(b9c&V#*0zWXg?XV84ukJqN!!^{m^fWx^Y}>adsOMVi(Zk!#xivRGID7Uq-yR*P zt?#*`^ON*-u5eu4JOU3#XSv!P8R>q|K6|>R;l!!VG5ol9M7_uQPSdUsyPY>%bORnf z4MjEDgGV3Vtb5?PCn$Bn%frjrRd?)gyTLh?d89k zd~}@S6xejNlie8{SU-J0D4}H!S^M`K5lIi9@bez+@(j8yifRgyH}yTC0zM4Akc4|4 zn+RbUyuC*5kNEqZq5IoYCG_wB{pcAr-?zX&`DjYA0t_`5or(2>i{kMCdSqahkY_^! z6A>s&w-ipHWD<|UxhPRgg|WpF02GjxSi&EZcm*hyaihTi zQHBdL@N2w8ARy2aAD5MsY!x*#;q7biPlmdP$mytNR z9KtU-Bcp_@kT`N0{0(J75YUkHc;?&8%EZ7zBQX_`#l%~s`2DCJoKC5nnqE+4L0pXh z5{MD7VHv?+BY08`oWt@mFB9-v@ZVJg%NMr@=kqAz4aRV!MQ`+@WPT}(OUYn{=~8wC zL1{Ri8wGoc*SLZhBk`w8sn@TOW^PeRsZ=pi@Lx)DDoZn$KxG=gpDG1AA26QRh}48U z$0sT3`k&qVv&Mb(h7(b)w1r;nea5Dv3YHmr2l3=FM zC}9RBE{J?KzODvir{*>ADcBC8K9h*3uyC!OUW|j~ee;rxPr~w|M7$V>;vsm?$S7u% z6f7r-C&_3X0s$d%_&7l)V}(L6qRT)k;Ak?(EH7Lq8l+wT;*TSsnWDmA#t2D5rRiW& z!UY#1iwuC4-;+f;5tM`i_844f859NVZFE=^k&BEd2Em3>i8d1i8>|eKo-BdA6n_}i zP}2*1CHQ6J$0emw6N>b6%*te842%T+NyxN8Do%)frKhLE!V+TTDk==34@Jo-q+bRr zAo2+8seFD`D+2V6)6hdiTG7pEGZzSwQ2-d&tSI@f}!$zVH# z!mNlW5*?#beHf!*nJEoDO(4Wg(D0UcjwTDKf|I}tWUQ^V-*1njqkG@=x|U_C<$8Vd z5DQw6kC%_vQA&EdxbnzXf3Z9NzvtY({I>d^|C6(AgLV0(65EXyqm6A3ciEk|^C;Ne ztEHwmFZa8@SQh^JYs+`vhFi^%SP7= zd8X#JUila9n_GI9W|!Mr*z{Z}@!Mt{TwS5HwI@fMA61kVyL@e~$v%Gov!o#pj!pV_$NUw-Ri=iHW4U~YP}?s9(MR{Ms+D}+^7RXxtOhi_i(adYyyd!zHv-b39DTHgTHL?6d@sP)5veLm$!%>4|pH)@>i z!rL1_qXpb+8S>q8r0vdRkegrcy_vv+{&c%O*oW1Be^|m5(w$EL^M;6n&_vQY zfv!v7&mU=N57gIM+f>vF9!c$~+WQ)bC;vlpsQ=;6*5)w3qnw9#;{5_+hx;P~j*3Sg zrn5NF&*=3NVSw5c3AhNLQk;kqApk_jsUh?slwk}23~G%oW7JZBW;k6OT>^F^lM~E6 zGDB1%lm-VN*qA1wA|U`o$xtMp3D$5f2eN>3rlrp_`~pUS6kY<7@gz+z61+_22?#sz z-xTI47!1=f4ZfRzfJ5bx;6ls=3G*YR&?&|?h(+cH;w+HF3yfdHM#`BB|KAo#rdA1W zfI5sva%K?G%%I?7kWc|hfLeqRNx%*)EAv_$%y{(`bEHMaXaii#oH2w?RPYXC9L1hQ z35QGJ5SyB_tf8C zcd`}KG#+C=3AS=5&%5qm<=6a>{rX;?o8wf?ox>hpz1KU~{;b|^4!8TbXV1-kKYNd= zY8KCPXKT>|m-+6w)n_|YXl-{(72MLY-~GNweDj#YU`2qiSAXNU zbHI%XKkK?G=l-UB`)Ud!Eq0gI_>BxZxK)=uw(!d9bL!SujpWO1?zOo*ymt72UZcBn z(4%$o;7HRER!8SFhu68_b^K9R>-2v6M>mgA5|_Xx%^_c}m1g99oKg)6eKpTH5%Qq< zPU-O&e%2_&Rc+<~4xOVR&Z-t?h(XT)XxgAr8{UJ0K#QN!4h?7|5~;~DrWXJVK{)Iv zP<6uQLQaDL0D$7e)2Wzo6@r(HwFr10m|sCf z&LpIQd{L1skbHueQ&3|-Z(o3tfSgBTm_CIF0BZ>+f$n8;oJffG(Rd{mbTG&y0zC+{ zI0A7L1lt=-U{KNwh&l+Z(reIbnD`2MRdy0*@%So?*T7i9$S5I6R60G81%A3Ts(%f# zM7cDIU&DJZhaion!jfnhtxWt}H?IlhYo_VfAuR4GeWr-Z1|1AhJ~~2xa6Bjvt{9Ai z3oX+af_$t__YyvW;%5oTqN1i|m=Gvk(mhwG)S~fc@EjEhSsaLH*#g`H8M6q35R2dA z1r<5T%#itb61YqxCCb7uLyGz^HU&LYVeor+T|Ey45TW1{6Ys!+rTI9N8RNGO0*5?lw)puVKd_@w+1NX+FbI&QZ^UA)C=ND&DRLQ?lVBQZ5{%2tYWN}xt|1OJ*K^aZF#r00((DgP{l0)ioqzPArQ<#g7PVu5hQT{tPCog z$poaFk2Ek7PXNTAh2R{eYi{fjn*GB*|3db_#;=1e{+P3CvqkIWLb18Yfr_$bH!J5` zWxqf0boOm1&bwIp*S~5mT*%$^*Ke-={7b3HKX#T~DslMMWcl*tLG!InwO1-Vb~-&M zDd}_E*Hmz+@{7OnFZ}$g#~0t#{Pa_?+1ERZF68gtU^1MW(`2z_XH9Mqcl&m9CBN<% zJGc4sZ>n>$FYNl#wD{~#1!mv56lE8;Y};g4o%`E?t>*sa`Aw!WiUip`6 z11;_93L89a9b1d8A9Qq{sHr{b>}IIDrgwE+tZ$g~JD5~g@9cQ9s`(z@*{?j$<{Qs~ zva&`Cv%1`pIeRPhm9k)a2T?_3xRX=RAHPRCIdhsD=JxO7Hr)<8;6dGQ<9T{ZA9TvR zeZrpVLw$pz@uD;^Q2Y2j%l~ND@@TLJyK7Jw?Clj^R<(6wTVZ_%&)liF2)Vi(xKYyY zyjxOV)#>JLsBbWMd5<(Sy$A>zZfc42KGApgehM3Px6v|oR8PmEC~|CoR#D2qegnmg zd^&(5DFpXfcOQI;% z0!=@IR1)LSCGaRnp5eN&+&4{60g5psR80Jvn8a8|j{{nvh6vXoBR3K{BmS5QIFJRP z`rnN~FC#UX1`j}{9tP)`j5O5Iv5OGc+Si;5dkNI=w`kJoc!lUjkScZaJa-6{nQ|87#p)B2;Q6{ zu_^+L1hU20@RK*bteby`5AkQQeu2%>_tGbhrq(xkyA9o)5=8_bGxQ1qq3j;CKcu$F z!%c)=VxCt>x8Bo>?$8EuQfL~n=7z$Khz9${P8=UF!AJ^6zYT;_WTI z+ZeSssBM(R34iq7jaAp>;@S5$qrTh4`B*|ntMC5tUbd#?p@&yXgU_yyw*uYo-eMi0 z*xd~*_w?BCu5izungJ)zTMeNHyXyHtlpC%Y4Dj`QUmM}n-{^b)y1ifS%deMyvfWsm zyUU@!u6ft7qM&WHWmboZ_t}(I?$~qfu}>H$tns0zZy&p{b?2_?j-A{}>F(vbPj+)k zownsxn^|A0N)R1%sH@nsyP@4-@SbCRnU!N+<<5Sd*>6`i+vW}1mEYRk7HD5l>gdp3 zcRS`l!XMKwTSNSZ9yT`lIW-j@a=F=c_))u$s)s!t7u;cR>$%~7N}hpUbVK25Vj zaTsq3i?uIdm%^cT0ig{V$dvW*XJmSCOpS-1V))P1A~xVDdK&OCMq|U^lf~)br%?V| zSb$OxegUt5jDa9;d^=UjM4fm5f-%9O7?%UAFfL)Nxr-6>Y^ew^bDR|l{>u0zL=UK{ zFa;1~97H-|Y7|VHg@Ps4Jso~Wph}9tKWQ3DKr}NLWA&6w&`>1>m(j0gX6XRUFbAl* zXb>Y9Ajl&DTZBYV2Vt?GHv%=B6GD%l7O;6#Dpv@DU~}0VE)*$v5t(u*{XmKdsUq`o z#2jRCM%{~FgHedD@IL@>B~8{MZS)pQPco!IgK_elabuMhe!ywfV=$<=MUbLKbqH?D z<%EOZGBb|R@>v`%KmLOJFSh{{gf~K?wi= diff --git a/xemacs-packages/gnus/etc/sounds/Tuxedomoon.Jingle4.au b/xemacs-packages/gnus/etc/sounds/Tuxedomoon.Jingle4.au deleted file mode 100644 index f38b9e2305684d96a800feb7fa1789579a4e3cbd..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 84777 zcmdSBM~~y$wyk;ZF?*kF((QB+8Q#lF5ClOG1OaNOAylcQrdkhpctUkvH6E&e+}$=a zBEuVb?5pr4`omhzlicqpKrsp=HB$&3gE&Ei^fjXB1cGw@&j z^MCx8fBBcgfBDz{8n5d@#}BC zd-nYG=El2M&!0Vivm2i_%cXL)QhvC(`1tG3fBVay|NP^}i}Q~^|NXCj{o9W}|MJT( zKmGXQPe1?i+o$u3%bWYBa-%D0Rv{Vop6>5%ZEl?$Z2$1h?|=8Z-~ImE7jIv``2Jf? z|Kf)?Z#mv=eAwFAJ38|QqsdIcvF6jssNX0)J(jASZmWEMb#Z=v{z;tok{kc{+ixE) zu5RzHFFyYA^G`qj`r9XQeEj(Fw~yzS59MaJ)2vn-{i&0V27RadJ3Bjj`$tDd`@1_I z-oN?b<%{RfzW@HaZ@=aG&!0d0?(0AN{`X&f^X!MW@810I>W4R*yQjfKc4bY6?OLT$ z@e{Z5+b=)={PQor@)h6t_19nc>-p#F+q?U_+nej_n>%sv z)gw>PQ>}a^lg;Nc@u2HyZ*O;ZcV~NR>%)f+o0}UO@87@Q*x1ohQ_6GxA zXt&krji<)KHfNJzuiNVnN26h{-KbVdrBbC{uh+`r^Oa_AG#(E*bEn(w_QZd^KF44% z97_{rI@9N>qFL$S+0ltNlFFo_{TX6G~MyseG9&3dEBlT?b2x7U}KSJ$`q_l)xO)z!`I z{o_+n{8O$rn(glTzIg6-uRoeh=jLL$vYmXwcd)g&@nP@8<2yUv+u7MYIQ55P@dTI4 z77C7SnT9^s&4uka_QIO8*5|rm%+xVMP;a(-y>7c%uawJ`dUvc$6=~3^SDSrF)u!^e z&nQ)Ejm|()q%p%LO?A7F%cK%KXDq^V@|gZWFcgkPBav7%9*t(WrByoY^ZH{sOHbICeWpPx>r6SY$kr6Mgzrjl=*SNxDG8RKEb9?%HrpdCR>P|M9NTza2i`!pi zGvbMswrN;SKAlV^Gr5A}tO^W#CY#IU^0{m_l}@IT$#gbbSUC>6mb0)lRh~?ZWiGoi zlzxk`?heMoL5~|+-_Cmaa8KMtrCM*a+TDJa86s=C&2X_}IQdK}9_PKLGwF0J=ySVx zn+YzN=5eF(WOixkM6$VQF{tv0DK{MRETcic*Xy*q?XH-H!y!N5e`7)ubFkeRs)n;# zEoRbaFqD~`3ve8f)9*fgx*5i|H;FDq6i>JKItlTM@Am-%MBbbozwU+${YVfEqa>aJKHjQh<> zu~@G4^tdm)8dn}4o+_<&vs$SSW;W;ahGNlJ&~+fT3V$pfJl*-Qwd+pi^69AG?N6I> zr#I0G5nmu_N$p0fI~>#=*hH@GnbMDUSD!y$-91*Cjq>B|&3&n@n5?>~#+ozca=*d5 z=*p{z&le2%JjeSx+dF$FrzeMdyW8742ku}j7V@7S9D37QuRB!ibS%!4U#<#;d|{yt zYQ@K=O1smkGF*3$#Y(lpQhH+M)`%Yjvu0nlY<*C^zrMbEs&)t6cB|D_7ui_QABx6e zVeirI&fY1P_M9B-@t1HSLoiMy)2oHK$j7|LCxPsI)E|r_MV<6&rN@Vdr*genD?i=e zJrt|WCR;$U+#F6#W2TIH?RKX>mIh3>dQU4vgV9W(kcph_ZEb$o-S@^KkYdS)=rC31Rwm#+^@iigu+M#T;tIyoEdOMfD3rIF_~FQ5!I9Nh|hJn zf8>b}Ux;-6NX9l9uuL+Yb99;Yt}Y5IYtpKgDz)BN9=3VSHTI(ZfPcpF)Lf@)TwW0_+0&lQ5@G8K&_Qu(DZ*JktibSe!8Lusl_N9}s8)*ca8MR4bpv3Ja- zV|KW)GS{_1i#G|py z($Z$ef*73VqpC8UTg#67T+nhQcv852t)p3`tnlYB8QLj~RGZ5?Tg&X8mnmQvQ z5e036yRK-uMbvW^rsL$&Y%>WWtYI#5$wUS)qE0!ry_l;Ld7`Kqv3JU7Ny^-us}kGw zXhi635$Yu~1-z-Mz4w6nRnxwW%@bm}@i^RD_mbs6=Z z9iRDPSyLHxTh00!d_CN7TnoS|5Z1%`cw|A&Qt{Qee0OzqO$_2P%>fsQg@Tc2#DBKG z_3rJ)hwZ(+y`8NOTibibZf_`Snoc_GIXOB!ad|_@f}xE2Ob9kbfr-Iwx3{-9Ads6o zalUe?(pDFaKB_)&@ynYB0j}6>W=mP_`r0C$VL^S9VqV~YjR0Fa#FxB{i+YkxQ=c_A`s;#r1&o>}r z#`ZJcWge~9-sAoKW2rfwnWjEf)VZBaM8aV;aWeX0$mQ4eU*6Vg!%oz}3r#}?aN5JBySeD%M z!`(e^n9W#BYnIOaqd>Sk2&4E=ECYObE@onx-vR2kyF?^5KiyoTJGS<0IvI~~&1@l` z@*i%Ck@1DY0T)BLf9wfH;~+e6uzVd-(YAoE))IT}A9<;xx1WJ`>z~ zy-aKytN#z(fs&yU^}t2=U^+ibk|0APx(>0aA2Nge840p6!d>O_eY>KLrJiN3T5iYixZD}X zvCL%j@a)~@`?HPr?!CZvG?#3fl}i2g`tIWV>eJ`j^P7v}b!k#*b{E>HU1?mGn8LkO z)OWVGy?eU%@?c|Y`)I?PUD`(9>37X(xzNa)`QSY5EZlKpsaEx2S??w6ti4Dt($Tzb z>YCCU6uZUitMiLb51+2jukWs&dL?z148{_P)FQmfdb~SZyIXs^hsQhqNTCpqFXN8o z%ti~PZw$xnabqm?YvYOG=*nQ+DV81wwdEomPX%l}DUZ7_5cfsa+D-AX)m7{B{&XZ8 zbKA`NBdJtup46>m?sRu&XPcYf-Z^!L0{NxctCnxCZm#bLIn}4mV`W%ujg5Rkp7%RNkxWC61 zAe>yeJCety#idPSI+F(K#7qTQTPN6^Q7AXzjv(Zterk*oRvhZa#$M396 z8{9Xyb!Y%kyJP2;?03WwyRa~QL@=s+_7>Yu8(YR&&?_Gs$o+ zFe8KhP%>>RleM$Uf>{t5Dgct?Rks&*KAXuW^67Lgx5{R7>6~FJonfujmu7~u%$deQ z)f8nSgTbn`a<$y(w0omId&y*=fU|W{XjPM?=@{^rNk*a}e!T|*+ z%Dk|Qrz3(1A$&&?@dOBGHV5x&rshm_XvwikMn35Fn*xu5{Tkiwa6DiVsLE`Pv| ziA-(*#v!?~^a8w)C5Qty7Pbn;Okdj22Ts9uz|k{9hccC53&``vBSluH%5*x>0OY)c zsX78f_f(QrJLlL1&a>WV;E=eUYO*XBb8BXZ>&`TFHkH9c@_0N|fX&cMGp74oBfU`N z!JyM4nd4)O3M-G<0-4TZK{Bbj0P%*U0}^K%$)H9mC{I+uI`JcBi!rwh!TOLKs4%+| zeFg)R2Z|Y%U}Y?U#025XDC_*LGMx~o_@F9F%6KHh2dK~}44^)TFXB`@z=Ru>_&li_ z|1l8!g!5|}cLV{hTe>l474V!qD<@W9Q}{f|3F!nA*Z(FD6$4BnlN^ zt^pPlm0#v*IfEjSDZW%lGGt|dT*_0#bP{AfMcJhgZ}W)!bke1vHs9>`!a zi+AzQ6Y+6gqxkfCIdE$3ijT_-D#IskN1SMV@Jhtn(B@2v_2`Qe@t?R2aZ7v%!vISs$St7RO;jOHC0;#I6K!A#b~r@t%&lJNC&a#=BU>(TqiBZ=n{ z55X^pR{%96UYB@|FPHdoN8*;&XA}eZkAp|!@9Uct_rVQ|`{y*gHC{jShmp3J6r7KF zU@c=F-%_8ByDdVQ0IY)A8Zw^lhgA$B45uc=7c zJFOZ?RT<_4wsw7hYGD{56SUZAz#0IJ;TW6UF~GYZ@~J=|0K2ujwN3=UDeKgVWYZVQ zjB0%&?e}>6VKOXzD)rhVgd}SZBJ}{@UwnoHza|B|C4D1nZfe<#HLSp^9q>YAlg{yzWyjfY?HQyDvs47>*_jghpfm2=rV=%z+XoWN4)SFn!$9DON2?W4*sF#Y{6(AqId+Oh&6M|Suwd%X%40t9KEAK zf(pLm@r%d-XTc>HsB)#j$sp0S$!JK5i4Ft5*lx9l>l{DebsZn9Q%iw*$&1cBfk-lE z&xoov>}X*r5+ee!cnCNEafOGq1V!F>DPF5kQ92_<#1VmKIM9LC$7E_2Qi9q)J3d4k zBQMv_btRGF7@SAAT!2u3$y10|@#PRo#yZmz+ZHiU!~wCw1??w3ljnet zv&2q8ED{MSbR|n$u$jbf4k8_qM`0+1h9%T2mj0N{M#MRS4>6hDSZrqE^dg4vX?{&) zrH;T3XbueM`V;HO$!04gnRPfMOc8=Ph4}H8=p&?8@na$jKjMetr~F)8L7aOXn%Q-@ zxpm+q{BVekoFQ0$M0`eU3}3?SKZC6Z&j>hTIAI-lj`q{_#ceUW^XmC~k2!2fDgPu+r4I&g=f z&YanJ&9GfxL#M2z?~6;Z%&$KacF`0dfG#huZXe6FW}`|Y%3;HiDB-&`ua|*MVp>2LuXE(tkUgx7u#l@6wwO*137ngro8$37Ph!m%cJfW-9d?FI(824x}80PT1pc3|uTp=-^GXguAxJkN*^_+{{Qfx;64xUdOJR^#XggOq; zwwDDlr=sGOMc9N+4iAsd{6bckg+%hflwqKaJ9nW#j7n z)74Xby3qTj+ndMQG_Ze?9+n;|T5M-y%VR5&RtW8FZftvVb5+l~c6QvWVYS-R^6|9M zt0Flz`m!>t0nYAs7(pjY1YNavK9b;5^xJ9Z5i`e9)fuszuOdf6yTeJ_?PpKkPP`o6V8FM2H#P;?4_+}=_vOMfGK?Nge*g{)*Bv6hA4aA^|P~?=};o93h@+Tos5@8l!Vl6>9xtu*6G!Z|^^~Vj+843?#jkvF3wXNv$NwO!iYAkZnBVOQrI*$M@j8-RlHN0a$r~ATCUm6(rCNnILsgdKF~OzL9>}^4 zj?@Tu*+>9vo5!u=J~{G%atrBnJQ9dzc>2+JZs(U;U(A8#a5QYyxUXWV*6AVe!H#!l z*1~`U5F$}Ln#!z}g>)=%$_hz23p*Wjodr^+GM48SG=;7rBG;P(N$9ia!F2*|V=Xlg z$d80J)sv<~-b}&NX8E}L=!gllT;&oWkB5vx#3jUHUP>QTf=p_wj70Hl=1sF8$Ub=Y8;u~J7um3rdg zc#WMFUYwykcM5>*iK4G~Q@kiRAhMn)++7yQI39^-7wV9x<18J03?i?$2e^*v3>Wv+ zm&QH(2DRRVJw+v{*9?MqCYLKP*t|P`JhxaZ8Fyb;uwUxjSlTvHZI>N!EXzY)Jg99P+yT@$3pWP9g#sn+GlGW+96!XVhgnBJlUy09f2T zFwWc{uWX`e@}S*pkC3wgr=;_X0-lFpG_``mOTtD1xEBPhe6|3t5qusLkTCavtR)Fy zjL2PYBiN5c=o2#=28Zou=Hy~w(7Hgr1Yfq#Jo90d&gL8g*f}FvolD(D9c(3y2V!W@ z`UjY0hQu~#tvQHY&-5 z>2I^uA1csgpm8MUMIo2Z$^1^!eRiiYbXOsrOzPPR~{ zJqoxf2nC{!06OFkzzSGN@)u_bSV`v{gm%C`gpr6l2;ky(dG*yM952I;Er}hMn-zo= zx;z`Wa8VVq_`Se81#T;w;;vu?g!ya!6fuW{9=waq-@b2*R2-pLir!&~38w;TZ z$A$GPpG~o8#*$2NF-VZuFmNKfAzldghRD7IUi!yrpxt?5kRVS7O~@#b%zw^N-&=d--PP=x}%Q-TQ6#sz-VOrEz_Ej$ibrzyIYgfBo?nG~8eQ z?Qehm>%aZ<>u)$Vh0qG_E>+tD{Ax}X)O9EX%Z+z$-|p;uc=O#?zyIAIzkUAZJtoxe zzax2hzqPx6bRyDV;nE~%G4yR>FDU8}7+kEjI?eI}>aGw=*J|nK3z5ZK-l3gdUtkmc z^hIDL=eWGMx-0kCUM9VEXEa+Sf_{hyzXwHGNT!?bg(dXWOO6)^rq7?hc)z*v=Gix2 zfBo(Ax7!DYBvJ2$B`eJmfHIm8&B44v%q5{Bfw)|c8n)1zo2$=a`~=A(#9U--H0;kH zV;Ah3B3mdex z`TqUp*6y(zt^-#L^966o46<4z{DVFTh48fEVi3`0jW%m_QnWQK0UPmusk!U);vY}4 zPR#^8vd;ElzrbEZ1_7Lzcxxn=1N;f2UN{s^X3{Z_@Ivhz`=bE!(}TVJ6HiD0^;A-* zx!jZBEWYHyz+tFXJDN#E5`}5yX;`h9otfM4zRM+cRaZ8z#iD)tu|524dRZzf=k?0{ zr-%N>r)p7cSBlk-?O#53iv83$m)(!HYH8Cstba=Lo| z{=4VzwqL$}_HOIVi(OAh@1?IB)${Am_n)Vvv{!f6q+@s0()GjT&96_FZewg`knrAK2&sbUdYCC8852o*0JZ{{qigpHWOuSG?C3zA(jm7gT=9FAACsr zV_8E_Iqqd@=}CvBiZ|D#+o#f`->G$^Qt<}FxC+L6 zVb_VveHwB5re?eOP`#}bOWk2pb0plH^YFs&JAqs}_J&VF9`E-4*4Ezk&i=`E1R+tg z6}i~Ctu{-&!Bicp7&{x?iKUsd+PG3Br>zbeaAF+=O|b_XfyI)QRxa{S=cz3wPNmUn zPgY3uiC7|Q*`btYYjf-E1}5Qcbm=X(-=A^pfisc}si&z8;f9^|7EDGEkGdApTj*x0cyyq6=$ZS!60olRefsXB1|k2xe%C<1Pd88h2w7- z%Z2l4cRCtP6k;BCI>e@r2%~9E&>uVz=q8h1W>zy9N`>U)GoFz*;Oflrorx3iC zc?+ss>d9TGgMO4�bl8J->0O^(LXo{9v#iMCK*k;n9Xdo7`bB3h%b!e}p zsn0-fGU_k(&|2}S^Z?NcoG;b7HQ3H-lPwb%)vi7w**B0ymo{;0!N!}(*g4&n5GO3% z(Njx@L~2!V3W-7@n+CRK7a~CV@c@P4B*6VK5SFP8+CyU0YzT-3s0|5Kh-^xG#Dk%m z_j^;!u&qwL!>(Jems_yOuoty9A#ysCvD9f!8a*1owZMQ-$cBUXZBM*Dzt2rhp9o}= z`cl^y+Ct3>6;GWoGiF>tLUr#}(Er$hRc$<(q0PajNc}+r{7c@^Z?UaULDOR}=Rz?D z3iM=WD(gnZ$|I+t#W|plRn}f>kj^p%a7>VV6w;{>{0pZ0If94d-rNdj?HRccaG^D< z_G{frx89M4Q)M}Wt`S0!$y+lF=*0;X61UNKtSCkX1tEg()tXOQO#*+d(;%9!;WTJ( zz$9r^_%=!R#8B*lYwswfl4Moz@U(h;dA2a~>Bz|`+anbv8=LPpHn(??DXXH z)Dwthok6)ew({|8Zf*`HqZSfOnN$k{-Df=hgb;SXOR@8jH8m=Y7GkMd2%dP7^9F3z z?R}*+B$LbI2k;-V|HG>9v4NnZY=79^-90{nQVB&(C_73upF^3f4A#pEYNbmP1+`c`Z41qN8?oI3#c8-^Oe1uu=7$?KdhYhy}wGmrj+W9Yv=nky+u|V>bZEg^ zYh-4@lM`9;xCePe_K6mSB$%lmpAe+5Z=o8%wg|DK-UW{0zhLH)MRz+rZmHXsnW${% z%*mk7bB3{Pn;~PzdqJ83nkMDZf$Z1|L`j5Tgh`xXgoHe|W{bcT zq(KwJP*IJ6$yzXqq_V;X4O$h{K!~yukJk(N7{MHdhg;;Futod{bs&g9fPdB|wInkq zjap|5%wD0{5ofxs-f-N=ABz>SdP;~DB5db712fH3!+K^>oQEgP=Kd0 zI=eK+pUqz&I>BaZ_Si-YiF@QQ`Ll!(XUq?b7D(O5~8 zxZAaJkLMENsW9=0%n#00=+)v;krP<(nDHnF;oCy<IyM6MMr^2Y@?NZh!Vri=D`u@VZ{1f>t|?Uk zedA9PDRc`5I^-q)Fu}gCp|Fqej$#T7%z$q>2KVAp7wI(_Z#EST2fQBd8Qi@PZAB55 z&^(b;5pBbEyJIB0r>AZ|S^Q$IphLnR2@Ud2Bo7zo7sv-f^kfGo>QK1hq?S?@A@l}A zSEV%&JWp2e<$egat&MkYh?whZh)W!vy8Ky9(a~)2j)9R8hQ(SWfro!7!tP&RaeATJ z-b0}a9<^K@VsA4>)yG>D#5?4Q4lsO1eVO2!$(+P95G#o?c#^?lzEB#c#wr!W$STg!SUubWF4)S7JpHF(DwPhN+F4r3aE2Y^GR=5pBnsDcr!ZFx6Iv2b}xV z?Zu`PiN#YZron8n%7{qd7U3E041+w2o#a>;xS@c>%?o!Cc|&iArzHo&r;W)ii3B2W zkxd|XrXrNPoe8~jt!f{gdIMNl6B!4y%33Kzk3>-wrx&@rF!Bny6Z!g!WD5o-3=(fC zAHX3nh4~krRT0Gm6C%%-$q0$mkq~Mqz#{^$1yym!?1(0QXVw%^jVy({zhF+~9z`I+ zo{OT&HN;!y5`x7Z5NIJUSWjpkur-{&g`G{aa*0R)E$CosNyw-VY*L|71!Y2p`#MzKxUB6%=zq$(c4f`Rs7IwB?!Itoz5 z1ZHPm>uAofGZzyWfHnuT;3%*=_6 zNebC&0?j0eDm;DM?wiZUQeQGEUAZOSJ>A??68rDoxt60=-wp;nC)?Yqq-*o1Y85x} z!##!&%Bd)*x__(@uuFBT+zGw<>Z{-V>(^gXy7~>0>sQ}AfBpW$5yeLd&xbv0)~(!~ zU)@)X&fWR1KmMK4T$Eh=^1uH0x4-@TS@T@h#-fAHR9=6218~rMY|5!NHpM5hSWb0`Jw$ zITn7Ruwa;|$o+{b+)q^FQj7bM5q!A2LKG#2A*xUoh6_bVxAo@OmPRs$_7=uOtY*`G zqftj_ovHW+5nJ&)6f*u}-`OcjSt!U6IM^py-PzgReEsa(Z=XH?fk6I&O5&F~%C&B@--8{-pen{%MLSLAOsJ58l~3hTR6~W*&dRxLK4iJ=j zwyv97cyOzg+m3zh?jLZ>Vm>Vxo3YuI)^C>6l~21 zf7OvO8v^lc+dzK6(X@6Rld$N}->ySqCs4ukW7w>M1oy76xj#>Hq z>9QUCuyZ=U`t{S37TP(q`wtfv553jt`|V}t^T(@3VRv&g+`PZ3>dCzww||8(cd-h* z-3YCy0FW~jmiPzdVol5Wy-|BWL0WY%^SkZN1ZG{!)Rh7$8< z%weSr^z)tWrqp3yDe#6Ofjl=jT^;YbBYL@1?Q3c8NqW*MR;c1;PHBAs+Z1~$w*@CP zQsaRo8EJc>Q>zk(-0Tn4j6W1!>e7&8@MP;KotyP|g+?Y4%^HJhM>DiJsuHU3Y?jXm zrLx}YjVHOhKB$(f2p#F%6nSQ3W&*C9EjCbDTLw;i@s&B8FBe&?ZNlf8PsFrQj{^U$ zMCHM1QY}4FooP;|BUWEWT_u1zgC@l|Ryq=lFM0!#!E`#Aw&n{&e0NeaJA*|g=Pamb=}iV~Co6rT%Cl8G<>UtS zuF3CYBTnmY$ zWxyrM{Y45_zbUKfTq=?qq0Q3oBAbb2=T!4{TZ#t#htdX!)J^R3ElGjE%f*+ZWO7%@ z+qukapyDCSW~kop&de!x#!zP7s*altVUQ(8lAAg?%E{NNmYL5RO1si(w#?<+adf7L zzQ`i?Gx9S7S}?wvFwLadGC_(VDs#nb6n1o7)A5vQ4a_bb1t!zMf;bq@&5oirxCCr}OcouUM;$Gwnj= zwg)6AD@$f_X+wf}SgJlkqP9w@6sG`FPkcY&W0%ez^rk|M9{>1aByz=zAjQmHpFvl%0oq_#=z z%$?<8r85I6r3OV&Rxyq0#o*ep;S*eP37XtUGgj)_;%bc|+Dk{*R0!UJrGf0J; z>1ZrQcEEnWg*Ao@P9(c!%FWhpxpL_a4EsRRRRax_o6ScH z1}2!<6x6Jpqq&C96{Fbt)N|@xAnqrU1(@gj3dR*zaJAU(p>6=fD%Bg|zyx96K2>T( zs>^6m`T4`WeEQ+-mOEE|80Qb)zkT-s$LC(s z76mG`ig-{Y$8zibq24F#C8Mr0Q2(=U|Mb5qT^`%i#x;Tfd@nA6jjL)P;V zkJop65)GVfKNnqvzJHB4NKq_E8i^Ns_WsG459*j9SSsY~qd~R!RB6=kj6XG1>YYmW zpy#Jbw_7cP{_assuS?x_rTj>(>GdtPpf+1cyHi0#)+4DET?**ILdf;Gyzw}5hw|J# zL{W&Hx0^d#n{R)3{bpnH?b~-dC&xRl=>YWX^@kH2ZD)8zL%9r9;lgbIWlwGGKd1#P zqo1#Yc6@$Gwc#yt_$RsmVN?B#czYqLg-O?h?VUy#B=E&*z1qNiLG{}}n^OuIO(Sv& z66WCe_~1~Otv5Hf@z=wkZ=vPB|3G!_>({TTREAbZ&VBac-Oj=B3FVqQbj84X0OA(K zKZNSF(~oo>e@~IhzxzAvv9PGPqJ*hdKv+Roti7ttmMSdH7fyjh1M?~aDO^wZwVSv^ znn=wG#fr4SSQYFnxjrh2-{bYW&S3NpPLClL+(FkqrS$K&Xh%fp!O`x)(ZNX~6-z=o zF=ugW*e2d}iaQ6`%Q23$1|7u)Q%pJ!SEN5hxiYCw3A@W_F10&83{^+kZLxZe?YDI) zmG92ayB}}s_m6-Do}_+$Rljb`34(Sc3MIDb-*ssO7Kx{RMSLW6@<;N8}% zt#IMA9;^82ClK6tMHU(Gc>~dWLY}uO*)rTeGbN2&KTSdoUUDlI24S{{3i?WKR`H1N`Q z;@XO&CaZG!PPu%jj%H4^HD6URiADBeJAey1;$&ARyT>Q#)Jbxc3J{(Qw9_i6-7sjkv z!79kBaOUtZ1W7)dq@=D@@7AzBeE#^`#Yeb?>kB|^rCaFbG4Z&~^hE9VWGCZ^)TiqG)7{m@b>$p7vWU)5A#_uZ z>!wcE#0hVk=&7F5oRy!u0`XvhG^Is2`b?LwzHpY2+sOK;Hnb`KG;Ke^4!Lg}#o`@c$X1zN#*mUxFogP8~7p!R9a`cJam+g!%>bKc0Y^08QmryEVz};i@ zzS1Z@)*-RYk+2;XbZb%@)3+xTbO(~bI0iw*!Ni;-(H#^k-SVI{8cGX#JJ4ojI%CiM(!)Ywf42OUPGHDh1At0jdBD($*oLHM%Rq%CE9U-pod_ zsKv%$RI3%M_t&7zS{c2vEh}~SA-rx$AnCNE&}1Wr6a4@>FaizWf-Kblc&agzXl*jZ z39_IZL!*5NsK_dn<%*Uu>1>jXL>x0aTREyZACDie7$^1}EW9?PqmW4^2%EI5DUr%6 zimgJ0QvpeNF%7Gf;ka1sRnWVXMQ({Td4&#cM|~@Az%sIhY%Js!>;Z@?Ek3;Xs?^6{LLNhV{i-2)i% zlYQ^0_sF;JI>St*TA9gYo?0$4b7wJ|wkbDOhLr|lCToK%PVF?h@~o})s6?F5a^T_W z@%FY@?9|6di+y?qb$W}*xH0U*KNlgLfHS50V%k_{D6Vp!MbCn# zu02;S8X(IU4GW=U^eo`=yK@M>8Q*e|%OmrT1{#9raSwcI?@C`Rdiij?Z_R5KU@= zhnZX;bh;lj=|ti>@g7tBPYV>!{%OKaq(i=WrA4yQtq7Yt%})f8E_%Ctf~EU}`j0%@ zXcq6-FYg6Xq}=@T#~Y&2?e$Ytc&%FlTGvP@w8@+XnSoh6u(Ny2w*BJ8n^O$_o=8Tw zGtr=nf_5;(*6xSx)6-M_vVG!@p0Zb^D1S~B=r%Mru;r0M_nBVw3&4zpuyS*E%c#_m zzA>lXlpe0>TJ=~eW9DI+K?i}N>VrySIGA9+Tv_aNsc6W~`+diId)sc;k;@xSM9~SO z@o)kMjsNsm6vF$DfqpT+2d4n$(-Z>Me1fpqtq!D~=plk7Q)s!5VuJ=JJY0d{9*VVA z1CF=VsxlD`BZt)OZ&|;}o0Yj-UUGIGO@P7L^NDr+*#E&Rq z5|k_wRL{{7GdlqP7stU6Ns{-|`zO^DEhDwT|;qaiFk>1e>0 z&c{QiyGL=4Cy|X~p^Rn2Q5rm%2BuQg9MJNjA!ZvdqIge}0q)}S6#X#|s4jUlq)@sv4D=ZA0^@FAL$T8mUV zt`1opFVlHZK~k8}lngn7Zc#L>$}WdfN3Zs$dNw^%^A4=Vm_}KuqW7^qQPhnf*6bjk zFF}3Oyw_k0^UK7d=Vq>$VD6tmuOZ zqVAl&Pv!!x&KgV02{~#u>r4=7EP|Sf$rh`rj4hk@ZBH7rMKUGSW~#htd)A#=m{cfS zndmgk8q+>(3g%OcURxhGk#V?WA&n6jPA|2fsg^dPd>=I&9#iOc%NaH+6x&sPW6BEKFbV}|nHUfI)0uEVb#zIZ%}P}|RT%WCYFBH$%44VgG#WHU>@oe>)J!`OcS6_5 zLMr9!$LcMUR4|E1pE0smZzL1(pPoj&z9{~Xyx2%%DaT&w&b)qe-!8Q&6V7I&MP@df zLTgpZ?E#^0fbWm$gxd8}2X1UAob&DJqz2V83!ZIl?Po{Kl&SDLWYghroQ`rCcRcFb z+jsBoAhzy;l24-a>I4{f{PXysi zlSZ{lM^*ZII&g3l-{0IIHF^8`-P<=WUj6Xu#j7`TTlugVkL>TcJubR(kjGd`e@as} z;Z#u?!2N3Vp(Lse1X8-8T@iB3#mCRLw^vwkMAe=Usj-Ucc-1E?>f#*@$0!0ZvF*e| z{zTyPbZ=|l{bB2f;yJpB9PR9$9_~{R9Lc03cH1(?wDrhQj};9S9D@0}ET~PC#;}a* z5<3hvGf0~vgC}%9K$TKT18+0y(gd~Ft2GAQE}9Dc2C`Hvk%EbW;N1_$uHF6p?VZ4h zJ4l{LoMH)!mXj2SvTPI3l~y{7fr|DVWBQc{cQG}9_jg!$?;frQR<#yRIbn?#7yWsvuPqnoCV=>qP1 z7Jc`g47(0tA{2j8eb6v=0{Xg8)k%=%B{qej0=YryHi*)Cvr97o9C}VJ5rj%(4Ft(~ zy(gJPBuXU2f;l-L?CWeWF|3NNN+I zYgMX0*bJ~FQtVPfo9a>PAd38|V$Z6PZi_B|h_~RpiM33}(hfm5$x5JKV9*NyWjkaq zJUdRN{cc|%MJYuzn#I_c&8_G|;VhLi+`_1xi9dXE%hNBB5N^eGnqCgW zQ?uObb>OP`tYRWP(+68>66i$=EiVjCejKt)XNv|7N>8ZNJeYk)D zu?vYb&X5%{pPf&ob(%QPpMZ`$P`)%@T_{3Vv{q9((#()JXnxENXiaBOn37^Fr!oys zFk$GXVXyGq@ni_gnm!%~XPiW{wRtYeE}x%G0C4E_>WZo?3YDmz!`2P7Yxd}2)ENM| zp?tfTT=BqTk<*3>dHH-Hsg#xJqi&xzqv)@uHKGQmC(XxwjLO=$)gBEL+?bXrOMEq< z@Yg`en9B+`loQN>wMyHxGA-yC3Tp7IA+$v(()H3jj9Ygy7EP!MEAnl$5sL~QZLH(7 z8EXTcKol-Y^ch{|GK;*vq@K>qFEpyL^7I|Eu=5A0tP^MLjwq%T^^r=i-fpzVq76+?_d+Rpbc z&iWT0uX>5CjT60iaemjc&-Q%Nr|a|cn_75#E84w1zwIwhw+`ZCs{hMI=wK(cY=J52 zx!rgBIf;G%lVyCBpF<0`Cu+{?p!?lDwv^DR-=cF~WjxD9Gx`{l^kly9cxX2 zM&(IFBRQIP(HhowR#;31(?ubAdKerunn+M9yoxz}(C)R=q%S42otApzd@^UXDNmZH zM$XRL6FSjiFACDSq|{QCTqK&JVsbch3dvx^5nEteDg&liB3q(@$ersaIy~k*)H9_!ZVzH&Ly3((TB3lC^fTW~j zcAZY>gV`cYUJ3B+tFx6qnorL9J&Eu6C{e`6g*_t_%9u(=o6qS9p2s*KpwV(pA$)U0 zrje!HA#t}kak6=POuM(Cw#cSBEo|pgEuSf5EE=BmrK~7pMWj_wiwne=2C655onZmR z8?r;|*~PF@L13|H>c}8cmWG^(WJ)t%dNijTg93EZuwsRwBF*v?iuqFZ6pme4kr^-4 zQM)TiM!_Irb^DWX-m|OaY+I*acWNe+fg1TNP z=;{&|ue!*>i_vV$B%h-Mc1Xh_Muw)w6B;4+6&op8p$14rN2I=Sg!_*EXYg`UrK4zB z+%H-~TR16dJPKy7CCT#~cd?M@I#-^rX86K-be&pYA!lvjSemb#F>Q}Q%=|J12s9+p zv_u-S$GFs+tr8TAItG(rx-@Xq&6to2d13b!yiEP zDpII!B=cBKMpd)mB)LQS11!@t;4|77e-(Q*R74;ePHYuB0Gjn=;H)U9FiItw8fEjA zZNUI&mgZ1Zr%8DD#>D8{tUH`f5#K0LX*cJ#GF?rpIHfi0#rTe9oobtI>iGp_ox>tG zYiH+pthHs-uHReD(`ER%X9NqhdBU=+8k3DbsLpU7jXxkm1${+Ph;30Yb(lN%vJrW zqA|G~6??1I9B(jZpiBYH^|41~q#4sx7^%>1opejOsp_$abcH4H_>94JJdZ)j7s&1N z@*=MzTA?lN76vFo6@*7~Dt&rCxgq$6d9?-KZZz%=xEZSa!r8KfHUt7*qd%SN+IWr1 zU1ejsoU+p@JeMms&ox+*oQKqSNR0M->Jtp@S*8+z@+M7r2WV*t0#R0YAS`ilO)z|{ zXcbUDblOW;ihQh_1eTx0nj*qwBjhUcHQF9-U2cxFXi)}j{iKgSCwn}F& z-4U3yfa={Yr;YM!m(vi*s$d5e7b*oHcf0WoXWI$P&K&>%)rNg{QUR7zy0(H zY3G0a<*$GJ`%k~Tr?fn`BKZ7pp4rUWj3L@6P3n!(cXX4q63^9V(O~@ZUxK#$=WoCL zhKTg*kEi<|AY9Pxsnk9RFtT`ZPR=}G>&Kt||GywfWk&G%&CmS2IiR(^LTMKbC*bG_ zS68c3r9gkgMtAe=`}eyS#G`k@@haj1N+@Ar*0McC$A?WwFus4_F0Rz7$myT&pG#mz z*PMaF-W+vO(Blb&QJ}l6XIB>MIaU0J&wLW7L%4H)ee>)4qfejS{`|MU{`b%CKZ7PZ zc=sL`@}(nyL`E`DTCw?N0L*xoDqUcFSR}K(y`z+e2SU4nWE9T#_b*@n;6t;+W^?+V zF618B0$Ae*+WrD;C0J}A2>RT01Y(o@NiKpz!0mKgpP$>9E?|CUtIJn(jGO2jh3zlD zyk(GbesX}N_?Rvv5CzaC7&9sAXGEM#?h$w{XFRW1#B~~sI|UaA^&eAU5!50~Iq0{k zOIo#O-n%dXu>wYgE7-BnmPsq%z!qyAVf{zt(4A1*QZ3_LLZA&4J;{_IwW-{it zTaJ%TtsdsrewW>5v)jGgEBDDbwle}lxLpgxA6|~Nfv^kNyuR5XAJqpy;>Jb2(Tj}N z!BKFV_r$E*<9$M{dV)c>U}4L$M5_7-OWq25}(d3UHLM6nAC!n zy)(+TuT*~M+*kXR{8N2et_K(OW52e_=BiEfrKjExS06vAzg{1m$Id1xTe7Y-n&sN^ zd+&Dpu=zeM)iy7imD}YX$4l#*%Dm_Ge02Wob$+@${^gRU^Ma{ejV9wOZ)NH`{fi;?K#Zj`?(7 zSvhtN?|F88m`z+v{IhYMHt^x;d*SZ3OzZvdFf4T|&Fy9v^9*crHf6FVg-@*KwzGGR z<17FB#7Sb8o0W%y8pKX1)~y&?Nt~`iktyHZ?f09)-OJ!^ zR_&$Lba=PS_L(TRQt7Kq_B?HKtZiwWCUN$G80bn!XUmY48uL=SSDV)qtvbq2n`j>8 zXf~I&C3B8VD1!<*AWe2kqkdniPP@i(zgaKHKiJGZ32bl5{B}4U_^@Yu-Dy5c7_9PtsmtwPAp*^iP zOLbN@4MlHvW%6kr9$U0uqr3*a8SDi&UcIwibQ=$)TBU3BJ0l9ATr%g$gaX9zC^LPs z$|WQI6xkfftkxarX{kRjhmEIN8$8I&2di*=jt)zlwAGgjJ*?pz<`va{W$3)Dy` z|548*63%EOmqiPvl}K<#-uwQRq>k}fM;_O z!a;@<7;5^myfsq0WXwz|YpT(762J3^k#oH{sCGsqYjC+V8_yNI0<~VP%~n*9;}K=i z9h$OgqVY5b)qW9RcdbFRhcQ#B#m3tlBg2fgnJL>@XKtc@lM)Ku7jz0xLZTjDU+G&%GcAa%2k;^ruzV`LiRnrfmE20DmI4E9ELTVem1SP5PULlc zfF0e`Oq3a!<$i}KGsp-QZ_cDv;*L4w2qe_8XvR%Ajvz|btc;MVui8qk(S%;6#?rIi ztlL0*^n(1Lg;ToO9)Yyk18m#sISqrMypr;fL@1jJM$*ZkFRlT#(PjuHrW*umYQKt+ ztUd;}-BhN_Hk|U_1WMCl$WCUkN3Uh0=>TkHzLWXKCc3OsFZa0||5ywVuFd9`LRrMOp(Wutt zHxi$Lw!coNQywA}_sme6IT+gR;RrW;ecYSQn)tOl%;?Isaf@bo z-onHU2H2cq#%8GkVMbria$9XrPsIw4N1@}wCXy9MmAk}y1&-v>N)(7IYO_bs^=)JE zoQ8uJ`V(jAK9Sc$FiDE*2Z-0(?Ay4c;kV9ggc zo6=(mUqKt?{*)!;pu}m1H4tuMp)$lRkBc8eeSchQO#th?lv=FXk;(SBb{8Xb8S@3y z0s61are~P5En#?gC*v{v4BlWU74e{BvY|V}E_mn&pf$4+P8ZJRrBrHd>=<8VH-w8N zGrKfpHUe6h-MkU8DTK$v)&gs2K4VN4`CX^6(9=5l^hp;RajS-Vr1Z?Jy1-7o*s9zW znmwp!Gnr8p%4NWU<$kS3pMrl@%S;-ehw{wF6m;d-nSsT{C7CFN4=ei@ylbE#064e;Jn_QNHqY0A6@gK06S zj2IyEz*5EvQhrpXM+iE}DJc03dubSV19;hMNU_<_H3rhLvX{)U}pP% zp9O!0ha4O;BP!vT#V>_?H;O|d9gWRp9-RitbwkIMh$sqQASra>+oxe2)k-6Xjo>rz zu;57$Ibp!3_M0^Q?be*(n@~0koLMF?bKzdw6E{&NCnHc{TC+i)2yYt8;kZpv*dlFl ztusUBK7r4%-lw&cnU*8|gdb1u%l{KM5ps&zh&vyIPNWsc&e4SD1XwOF=3V(TzUf$S zwFHk5jHJS0%v!1BdWaNZhdyBsh*HZ*SYlCJ^ZS@Y&Q@JA5Kwfn-`Z+I>&_#uIbs$; z$OT}g?Q}hn_o_(NqDZVRR*f=S2JER&ZczYqM&qVz)~XwoN%CT}-eFgm8u$Qkq_6Y6 zB1>akTg>&HrgP41wK~>2L+V!$imKYI$8eD+7|;tM8dsZ){0xVWCxR)(urqD4NyZI( zBO1t0Q`nbNdmiZfI5q@962i^7TQw=)1XUlmgR-46A(OFXAgSws&RH@9Qsr$H-34}$ z`36_gpouge-qd1+5oEzne~z1fwOQ2L+i9guoq!n=P~)yQ#o-3^Bo~gSHsj7=irA=tW zYSJaX4So&A{_(E<+^j68ETNbB5_150!+EdE8G$LM%Pp{j$WS$<^*R?dM_VG^Q2k=y zWSxO;LX(Eo0kW0ca-Gl2R7N3@oU(+kHrXb#+l`Ux*Kl$81AE=bw+Cw;4R~J{08b&) z?X-QIvB!v^%4n$@15U;~-*SF2puhx|(Hd&?@{oDE%4xjmp)pYx-405HDI**-6MA~w z;0~#+1`}=3gML6wh=O=RwJJ>Fvd*?+wlsHGXDEDl1n>mft_H{g7;mk%JUqw)N|_4= zgF2&e82d}ZT$*?+bclznMIiQ3LCC5A>NAu^hfikXoNY6Y&k-YMWD(VB?Cj%vYraSS zy^h%|$Crei?$|Fcn+#XTnI-O(j8{e^H+L^ps+0kUulpCma&gE02WtG`fbjuL6r0>`{5k&*cV0$j8_53Ns8$lngWY>qY8eAdi$C?TMI_v)@CO z>jD%kk{JaN0YTm22gqwb{o^MwW#JS59U2>)@YBOjpTLh@2M~Fs7#^b`=r!uB7zIQ? zEOHA^AQA{{BNFa)uJZtqp&-(=zPu*qBAWF8(bw#3C>_S@bU3k_Ay{5z>9$bWF9eOJ zJ)Y;dwnyEr%(8JzkZotcLJOxB9@9QoI&>y~G#rnM4wkT+98NwS$HAnz@6$S(Qci}y z3YMeImsKAxW?fPS#B>Q^U{yeCisdGIA6#76beXhj+JG-Z9!&?!G|IvV{VRMCqA5(4 z4pU?>U0kv_f@Q)9K`65R!2mZKZ{rCsbJTPkdMe6uxHe?PK)(!m(fkB`Y~(Lo!C07# z;~1#N4TKnN4#~I4q^HINuwDVRU8tcT#lXlJLQmQ2mCFspiIv85y_N-o6{F4o6B*8{ zX8EpA8*vNR2+B-{HIR(7Wh)QM-F1Sexgk8T6LpI$OYmZ~wGp)Y{cdk8Lt+ylz7dxN z7MVAI<>>12^3oso`a}7=$UDZG2eu&siI><~@@(f_Qdc`IFddx{WxT{d9h@a37skDH z_Fs)ck6*o>Fv_5y$7PJH0nP^Sx9$>o5cdOyo>kPC5Q#vC)&|CIjk`#0j;RJV#un;} zA`1Qt#%`B~I3p>d>G7b=?uzX9F$a!}Kq!$F2IM_N=meIzbT;N9K+!KknB$RXGLqh} z2{_WH25lm4!ZCRSBK%4$QU4}a_|#7v{`%IUb*lBu*}FHN z0;5_>Rrkkl4^C5*f?mtPhlBID+^Nn}muHTA_wlZbFCou-Scrd1cu?03CRm+>$C0kw zedE^nqq5$yT`XWDo5$^!K1t~->72)6b%wQ(5%t@mXvox7V{CY?UE#FZ>86$LO_(+2-!9gbO?7%Pwlq z-@ZOpMhcF&V!1Ko_KxIf$08>PO2E5=E*fx$yjRE;L7hR=VKWvBxh^fXWEeCnmj7)k znO)PZl6uu-$WNyLzDEf^cHM}$=a-sKCa&{ z)^Hw|zJGtJbdW6wp-z25CW>`=(`rWxXTY;j}!0rxLTWrd6*5`zzq!1cf)53m!jM41c6HAHa8+xf%r8w-UW_L!iRqg$oZ-)JJ{C&NKAOqWE6;1JhpO!QMpqPvi?xq)Lhw4w|iA;6_YhHrU zHelgd7%W%Q=4`X7(%7zb9YzNo9bc2QrOGyTi&VhRy%!ngo?bD9BfQ%q=$u)W-lTl% zFH>=hcLS86sBT224D2LDR@(P+`mLnF9(ep9*s5r>eZ@=c6PWSP$Zk>V`*Hh z)T;AAr8GBiqqF!U`FymZ@sV_py~8EY1z9p%*u=qo87ed2W*f1!#z$H0%y}X{lMQHA zh+2S9&6f$kR-XVZe|h>*>^zlwh)3W(YbeVh-TFzuyZWQdbBb2vkmIBLbyQ!DV$?vvO~J zdGh|9*dCoBR=scrVabD+7;JgwJ>eao6sZW7$U||q9akQ{{rTr_U;g;=nk-Cn17P`-S`5`yj*|& zfzpoCTu8&vp{%n=pG9l{7M=@gFPGElg7g}9TTcMavQfNr`MK{9^$q-hDHcmMhND&1 zd-#289j?&glL*ova|4djb9scOAi?Sk;ak|o$|fM>&yet7$=MJ%L*P2XaOgoCD9x%o zh{z^j4#QhSXe>5`uVE1Vsu0)-vMzz1WF{c+!pE58S?;?I$wn$*wSsRCztXoZ$O}2W z@Fp@+JV}D(rxusl#K%wmB4K>vP6c!rI&}1gMd4Qc^Q%x)!pK25$`6ZP zj3!i4`nx3A&6kc2_+{PnN@`1SpV4<7~Q25IVv)h$HCOlry5ThD|f zns1~^wTPbUtAOxO*^@%^`|tn$?Kj9n;t#)k`BTV8Z(cEC2o6id=GcH&f_a=H%G6F^ zo(~RCn{!^iBQxdgTfDiTjX!?;j5^c?7Z%>`+ha=*H8s-KYdfMJWY0KNAa}DUt+84L znk4T3lrGe-h%jM#BDsAjJ|P+)Dn;;icrUaYWXjMQfd~5f$5)ad{=;JC$%oXL1rq_` zz}hlK+#9rA!k|HV`T662sL$}9aS8tf02(0l$2UL!;~zi2J+e4`9v*mcW#lX|&3%ISvA2CH89-ld`Pmgg(9i3RN z+!4e9Oi$>SH}n-th7<~8O(FawEtpq~KiXgiDNV zGUeT46M*bPbz9l5P$NIl%}uMdcvG8t0lp=?i-D~mE0xvlP3d2EH`VXsdNKQLaa&>l zX^%&StHktqn2mToo}Iq`c;!1i|3y1H&z(tWHLQ$k`Pz=a#oD%2?dO-;bvC|i8(b!j z$~LN`PP9Y}dz{rw7*}ek{_-+HB5+&kJbZ85Bc`1{OxJ~8U1W`O^ z>pGI0X(kU9Xu8GHtU7KkDwDcAEmQIFV6HaGYCCP1*ZFI&K1=F}L4GpXb8a?n9v*L5 zUiF7B3mkvUCi_||pQ1-0d!(_dwu{Xo()Dt!Q0hOIiesg+ zn~gdhQek(UMb;LK2c6O2)j>SNt|EqhyxM*#+}H4*j#~R3D)#*_7u@yCU?27SaK8?D zQWOcf{d6}S8u<}D^sw|?EL1_7F?kxYHq2~9;8QeI(HjfN5pr}<4fmN1N%FPd7%=$VFVxyL!hRCy`sA%AqA zaO^KEu7u4O$%BxH?QM?hNIWE5n%$~8kh`pT?(bioXdJreX$$3cdD01jei$mn7S_4- zHsnZz_C{XYC9}BWcB9g4P#Y;T8M68Wv57j4W)>+JF~s3A5KVa_*`S2R#_vo-H80kn z4iolL>lvi4|$))x7ZoHW+?rqX9(3w{UbR5-OB4`$sVb}5oY7mv@CmsX{#O_y}o zEY2q3q>mT?xRb5gB56IlzVc-9agUQ^5MVcReOPVGG-d0vDKgeMi{Q7w+S~!5Sdho>3WmSPq-JA z8r4CUeR~lzO21m|8kuneP)hT$Jj)}LqBk)oC@)Pl+v8rDQEIz2U1zeh#c;S zni-2Ea_nOl5rYK>{xx}8ua2iX_WFRWRSL@m0=Qzc_VCATy|vn}jk&RCsrzJ7Ljs!# zt_x^3m(VhSBV#8%tyvtiIXV)Vs}xJXVej!v$;9#<|G2xTNjOxOpF zS!tR_q|7~lDtGkw?WNS1cCc<>Jt^@t#Kt7@&u+@YYEK34vS62%-Hl7%>2YwPcBHW5 z$}8`Dwxd%!HrtDX&lXg=j)Mb1f{5CznG9-99Fb;z$*w^RnJ`(7SL&eg@b#h8Zk6wD z?)V7x$8TTn(8s*o{&*=3I*dDedYr^CaQme;O>GM!Kqlf1TzkAAN-W-J--g+Qn%hEJduGU3rc?ru!h8q{KmF5)_=ks5bvSsr zgT5opnIlzD1S?pb$Gc==Gh3zIp@c7l4I5w9=>>jfdm@t4GjwR_M1I`Qh3vKvMk13E2xLZ3V|!t=ki|?P4#n`&-uQ%4%N21=8qYc5Y9)rq4lzoN}L@ z#<#J6<;>=T%oej#+a}FaEE38OXhV9K%~^}cX_2!b+cPExJ6^aAwx1%vua|)_ncd8S` z!`f+HtC>{9bUD^++HQk+$n-aFu3)Z7L>W+VWTbFxlM5yidY2h+g@Tx{rB(^g8eNs9 zFy9m55v++vY-?oJV)INwl2+px9o7sbKK6YfIj6$*gi!-vGnKdVLKAKiS`R(#am7uA z-toD%P}GIG*PBBHZ38npF7Ejd|G(OtkyeMaLsEQ}%Zm)7QG_)JNXWnGx7c&($s|M$ z!q(B+mD}v*mJIMVQ#nCaeGO_6t|qY)lEtWDCoxUi!l&ofWDF|gdimq)r4hNbI8&Qm zOHo=-uG3+Ur0jKgetvj+1Owr@X)cxK20yH^S7tH4H=;pOYO-uVC9&A=sb3fSaB$8! zTOSQ8D1cV^Jw}+`K9r9~#hkAEA|7sAC}tu#Ga2&uoxbT{wc1NYy{bw9Uqqc{z1FkK zjMA&m^8HGqHkZPa#$=`k?eTP0rg^V5D^EpcBSeXfXVq>#4p-#)vDTYYTrkVq=SQWX z5wxBe+{LEamdAT9>pVP;OuDOBTG>tN{XwyS{7lyQ*fGYqF2-V~7k=4fG8yf*`Dbgo z`&5MydKuLx!&N$m9In1jw`hN=%Sj)7Db@Fb=q2w;m_)HcJyoTX_ZM9_AI0+hE%PxG zu=8qTJ9+bq75DfB10|>D^5pZo4=3;jKEC+~6nfY$4${nyrHI`bUv>Knis(_TaPtiu z@6Esd{q??DyuZDFsj|#zyg>cznkvO|qx*1s54U5!3&+gmWStVjJIQIeCL-m?X+3=V z_K157j}7dBi;&er3`-+{*(t$X>J5N7KNQ*{y5uJ;ERRSo>0TAAivZe5 zvL`9>I||3vbD^PR(Q^jFUMu#$Q<=7Yut~4CtqJfR3>eXxnL%Q8N;oN5+_F{rtWNIP9Zif>eTT5cnSF)wTEB zn~CM6JzIhd&MTT^FeQ1I`N3R&R}$tYwQ?a6j+&Ytnt>iFCtqJV9Q4P!IB3Vn(mr!y?cvY814P^2*jM|8vKQiU*e zcZZ_3)uvsA?T9I8u*_r7-StY9@ivwj*DCcfE@XmJTxTce_CVnL(}!bQBrFMTgWOVaT=+u6Ef9xb(A(ZQlbu5gGR!kM= ztx{=3X-01He7Xrc{RyEtV7HCNFBS~AQ-!)yOMC# zDhSQ$4HS>5y$p{@3wzx*U$rc2DTA4mM3SA>C_Gm5Bw)!_U&}r}lxwDkCmxKrj+~>x z?ho5d2DP2(^CS`VNrO@=>vMYum~OXa1%U51a_z+rT#*w=X3ES-k-^tm2J-AQ2`b%( zp%ix|mW?J*sO~_^LTlU8K1}0wY*rh@bp3L5${cV{_F=iT;r5+KrIbQtG~ZI|vf|y0 zdH)oW@%^&f=*$~0Jd+(ElYD!HyoYE;>>6=)_q41wzzis3d@{o>w5~XQnrtkL&7xL> z%C$WG^{0=1zOkB|wv#Ev8JC`6IAY*atv=oS`R8pBYb};i45cLCRz@ky$;Xc$gnIno z&ENm>->h`se*X0C(}C?8657!*IhR=GA^rEuVmkBnkKg`{8THGTKmO1E{h$B+7o(5g zf4_MYC}KRSSY?GPmv&*73b;f#E`yA-(+@xW<^N+>{L7K$^P69hs{iG0{0hpDGnSSK zG)V01s}<(*X0!tQ++ugT{j4|KXCgwE+^$oLVY1dg3F`i(8!Z_;X5xc-2e|%xW!#sumBmUu)Ho!mr&YuGS zfarw`wB8ymab@S&9^j~5=ff_S-R`g)AAWlO;q%ey@e#v{Yd~i-YFOhL30bZ%Fdu#X zcw}+F{tG}~MnsfKK~Td*=LKjR&K zc%8dF3w1yLBt-P&{o*G6FX8D zd_rHYxYXUQAbk}oF+A+J!kEf085H9oGZaRJy-~eFlplBWEr7s`&u%Ai$mm8mDO zk5G?gvfu=J%+e)S5?SEJQ$h`Dp6MGr|7L%04?5(#tk z6O1{jDx_RG3{O%AD4H-bZg};6DeQN^QeoJPPEaJ8?J`-kM-x1@^$EJXE+%U>^njR{ zM*)2(VRD(n{U*;52Z}H&5=|eBuxQRgsqu2OSQn(Zve`aG!PkJvV#!$tH!qCd?B8cx z&d47ZT_$GL&Y)62zliXz*562BZ;X@!LIH%cXAQWMfCrS&e&>Z7wh^EZFeW6`vpJg# zjZ7rASKF{W7BU|l{f7#Lqd(1Y?Ugc()Xq;Tr{Os zU1TWHB(>JSV2AMyw~EuB-fR+fkJFjlF3|KaD(Y%%^!E!gOGy;eXQcw@!t&D-?$Fh= zC#HM5NKEUO%Y#*maiIdoW;Y(~g4WX$TV|#1Ly;{~uXQRCLqMLrM)H{D4qEH3D^hJOU~zZ1>nMlG|O_VNKNG zwO9AYACKbCtm@=|^}@Hg|MunguTP`6J2-gw`sd@^{^^r*3bOC9p`@=b68Z#!;MV!^ z-EnLL3@c|nxk$|@RrIKri`?PQphyQ9t~3fy#pWgvOb?LvD<+5BoRRg-Si3Lz{P{uY zxoY^&kF41yHkZ~+=aLEQ!+NcsIX^hQ&T(O(l30xUqb1@=b+g)La)tt;Z8^b;Pn_$D zeg|@EhdTrl2%X_Hr)VqVy7n0i8YDI=o-Cbql@f}@>wd^(s-@Wag>pk6Log_?f=>k0 zX17#vSV-!S=`1T8+*+7kS&GeM;1&Ub{s?j_(&s0li5+s``Xa_mIyR;@#GuKI3B?&f zplUV{jKG-@rn)YESzL4zHI>}Z&ScQuZP04h>m3j=QX-b?Gh7KrLK%HR!BOrk_nEYg z1i7=!c)es#&yi@%%zP@3C`R6KSC2rO*~^{AB;_|&1iyCWOqkduP{?x*P*7kBI2+>kz(CO(u+l61P7b{3rxr)||`l=hQ{pf0Org|1&fsA1QR+QiiCWwe5do-&)a#kLv;HK)wg9Kdvbh$|V? z8geG0(_`Y#jRjIV>_7CVG=x|&k?)PVCUMU5Iu-aTtJeEO<`BxZFhcY^%s1!I9`^HQ z9T+dBEGD_Jqz;Ni+6os4@D_gCs9jr$Su-g<#9B;X(kUQ{o7J8sLE8n7JrOvD6&vEs zs92vS?T%1x*&nWybR@rIA%UQn#dJgl?#H3nX0y7&sW3#+Gm;IF*s`wS;gvKJMP_;$ zRuYKeY#hYclA5{)d>U)dgq!7ZjR7>H^l`9q17pREA8pW?;vCFzHIn}f49dV7IAzL- zC!UH5anxo<*bumcHS@{kd~I$zYjl!Cq)w6gP=%}*#dcWlr4wltU>6StbO5^*HF=w+ zB$di(2>Lax4-P-UuWpWn!y}#N&5{YQRLyLTPalf{FCzGes5J03{Hse!SE8j$&=JUu z4-=)dL9d;3U%OJji3ku&FBrqUUg)8uVbqU*t92h$~@5rTM+*YTrSug+Z-NX z_ydP||5t#=^53Wy3NqVm>7&Y){oF9DncyxZ{$*M^3J=f0Yep0KnRiE8@9ZY15 z#Q-dJEE^OX52?R80pd(fAP~*IFq3)W}<+m~+-Oz6r_-@o0Lx(j)Vl$F*0!btkA zF`yzFICw`?>4!Ie|L_0)>rd~|G@X4Ge4+Czmh4_2oe7eXk(rayFzrCsKu%D6f@KWe z_(`<#Y_M^$^}siix&1^46@!UBOE@a&Z$ApeM?wRl6~7lxYxLg2+dNvmT1U6U01zqf zB8p1H=MvoVLBzN4f8V}4K07{m^N+v%m97c^GngCxb9U_~W-rS-L7Ud)s)VK^L;^qV zIo`sb%K-p@Brrsx?GdY7WVkeJG#IoDG1Fp=oo@Z*5j*RsIJ;gML_cTi=`>J1&!(%Vs7s z%+cLGd@VkGzo|UbAMVOGqr2*2I~%fZS+%DY!+&u0_UPc^@YA97=-~Pyxzvg%0>4%N z`2JMB8@#}-zHM|LNBwH~w*2j}3TZVKIEz>r%YF)<9s=yK1q zMD|LKsX14Q_4#neXo%C`(7Uu0LEE-Cysy>OI3r9KnqYByp$VH%Svc%(Ox z2TxV7zQD)J9WI0>CK&F&(AXxaF3=8LhjKlKVU*`t98M*q3>iQtS9W(4yvVdZBXJ&P z5*oM3*3=bk+8u~MCuFvWJ)R%vmB)m~&NsS-QD(h@hLR0=E?oreksE5gw%S7UPm@`% zMiWO@+Z(PLh}OV{EEcW0h(|+p++t|n?T%3kCm~;8v%#Y?Um&#R4SC#`uB&UO9Y&!& zyjMHW4^@zBQHG7WOi{+@u1ZSsJ#XdVMexYzXyH2ydJCl7@^mrHuZ@V)dUbhzaeeN% zxU%{^L^5UhUDFM2y1g-DW>x%!!mv3R?%aZP;HkRIHvpk79h;cVu^zqhfy}2 zig{h3P>6wrz)-qFX`C92K{9cZ=ll$77dVw+hpjT#Kga2{e=neSp=pH+g5zbT;k}E} zvj^O6yZz$&#KHr@nb@ma{KVSITyuPAU093jQ`khj0IDG|dqqW2!<{{zG{ka&FfSZ* z3)oosq{nsTpbh~b?+(P7bPIb)E)}KsLz-cIHG~T$;=V zW@zwY0k_xVAnenP0@~@qrY})3pcPBUGtBlhw0Xk~nJftSDT$g5kt&M76bW0SLCi6- zE`}WF`&i0k4O)yy%TvEm7^(d1icPA8{uDIQ-PMK zLZ*rc-xHGd9S^mLHypsJ>a{ybq4mQUMU85jl%BcW27BKUN&=z^0?^1wL!c()w7edY z!8Vbbq>W8a5xggH;{;;;SGgIJN8E;P&RDg=TqEXqY3gRf;7>x za2LR?DwIj0RY6cXClm%pCR0bAWSMXTX(VBj@nk#{AtW-NhgP#%?Sgn&B!VqIHaEHr&`QL(Al_pMeh?Y*Zdl_&<%9E_71?L1%Hl{A9vzZw zJ6&<0t6~Nx?kepzeq9u?%%-q<JFobdg>mKYJ3?L(V-!6l@ zUZ11QX-U}us=5xAlF__a8wnpHkvAl;#o{q?QJIa#qkL_gn29u(3K|yD4`p-)faBnH z@&X(izIEP~crgl)p#UqBGKYCB4~#1#UW+1x9WL8%K+|lhD1RXLiUdZWzT|m!;pq|K zCvE|#<~scW;gXyZ-7z6M;6^YSklaibDIX>W0WcBg-BC*=Guaf9HKc*JBnBy%Akoor;*p98 z4|UKLS8%m1grUI5UNei?H>2edY}C9YVmI+Za-5PeVrL?hQTZIT6SqMG$DH0g5ay`K z#HSIr0$xLivf+{f65^Re7QvbhmH2EDPemwZlnahI7G2Md4K1&ZzJ$9nao^A)1?F2E z77{=ROyUgU{fT48SAoS@t$z*t}`Hheh2WhF>C$9qFP9Ejp22JEG6@wDSU#ZRt~*ULc{hnoKY zzQuaf?r;jpJZX5EK=~EyM}RX>?9-gru{cI4Zbh6x`>co%<%`=A4aXe-Yyh`15CH^P zV_+gA59SR>Zt8Z-(m)e;BH5FV!)JlYOA0X8F0Yy9iNbFH%*IfSBg7?3wDPFO>BQQK zGn)Gd2OT0W2!4@b%*V=R7`yFEcx+^Ka_NdZQ;sx}8f|9Eof?g(Q< z`p%_>Yn(J{Ah(<)(6BiaLdmq}MYvaUz&ZTc9M?V>jkq-t7-8fU@x>s?ct@~%L~i<+ zg%Phz1~`)$asUC)0lHsavqXrIOR&%qJrmUuOSBiRP<3x(iR943x1YDr$>HJMq!Nq}Rb zir~xVa?(jj<+l^2jqKsI9bsJo>vH#+In4*;Ji>HNDI<+lf{6=HO@e@BH z&iVBt@a65ri6qWy-W(?YU!b|&u)4=EOi1-qyb6)m#7gm|+C&Ag;~*If$S>Z6jd(la zaN|kjTmnSE58rw$quE}M>qaKz87rl59?!H`bLv9NH`Qhw1gDTVZmvELJu z3o@d3{t$;LOah{Q5f!$`v*pRy73)aG*5dBNoriK(q`X8KN%OR)jzQcX@-dG*JhG5< zb@cAd8?uDYtrr~kV^XbHfUOYoc`pPzDiDe>nU7G7#iGb#KtXSjf9S(0%sa+P=&>lG z8#t*c?c2Qu4zC|SAjIPN5W&CrUjF=c`{T#M4-5``QTShYdN=7Uq33Yd~%ZY85BDFeIN9#OBUS{EV zlDO;f*aW-V?SptK6j;9KDLgOi#qTQc%2@|eTo*7?%j3pyKxs@sAe{ZpiYq02<#VS+ zhA-i9sYI0S9A_6glc$+AovOwc)V z{erk`;q)~V8I_?=Z@DLhFX0CdBt~2W8U?(rh~IYUL}^N!x5)=B7pYB~ma9RLim95L z{1|R5d=J_&5rfe~-OYTt+>?^y(%si@w~fsRb^zHSxZmjPIF+f)$9?dL1beaPR-Imx zIm_cq9sZD(^!cdN{d6HjgakrCU%+!6=fa2J6ghl*cpV<|>Pz$u81^8qQV_ubfv4Jm znMmzTS%UO=;t9*W=bO9x@)SJMb|WO*<3VQyzHB-@+g}xa+fET*sT8i)X;dav0aJ+HU?CmmNp2gv1s+k^XXvm zs&A4hwf4X*1m$S8HCe(+(MDv-iTsl}xk@{IN0{P5lgMDWPAScDshv;mLQX_KLC6jn zgk(-{Dhn=$>^brHpYMHkUg1$>ZVM!^u+a7J#=#E-Aj(c-u5USCO69f)m(*l%Uwp|e zsydWbJhP{RwaLhaVo^$Lrf?XjyA0Jz2=(8c`#o0At zmBc#f48~%C(58)mt2zg!p=?uG^lh6pddz;KP@Bnb<;lg%IyupPktQ$k&iGWaF*?F7(+-i+WRV zX7*xv0_))RJLgba41&uq;(=5m@4U}+{i!E&S+Pojyi0lCj*PRV*||i&dxmcvGCAdaFJb zp0S-(QJ3mltOlIfnIw98@tctos9LwuLIasdanCmK*k)a<*29F`M}vN^KkTt5cs{Ek zdrIpT>gg+oE6VJPkMmHS8+$=`#`b}Qg&^=ox!Pas4Fb{b9w!onwNA59DA9I-h2C=E zs`(hh>R`}ob%&j2pO5SzW3u#oKJ~`P-5G)yUZvS<0~nSl@Ca!Ip0ZvT9_PIB`0e}S z6lpw)?T6>*Qm?--6tp6J8WWrglRnbL#X2VSN(jBHro&^7xofaSCkE)+>CUaNvU*~P zy{ZD=3ffPvHf>JMnf>GAo4B-yoge3$y;Rs~0b8nfuSWlxV5!p7$ zS`IB1>5(mB8y@sT+*fk6=4^#5nw^@pA zWw>56XNd??%~7Y(SF-r;4%zmRcSSBv4PNTw9 zmiRUn#3>*V>lqGU6P8MUmBT z4djJ+@Y8`K(<>F4Ad@$GBEYj;SG9a3%Xla2x!}{oOWvpRiSzSdZb}7nb5k7X5$jc! z)HRZ)Q43Oz8XM9>$-pU8iVdA}==uIT9>Ci|d&#o!+_i>afYXJQS5`v71+30)jrvbM zo+8{&rx6NYAAf%P=Gf|r5ycghhAYqEI~z6z=zwhTm9T$_(E;Tj#oRM4vLfEiM~b-z z>{l~19O$d%W|0$ju%<#`qE~5Yk&p#`oIOY-BzV4`sp3xIH^f*NyFzB<%9F;8OkKW~ zlFmz4Y~5nx`+`KZHkdUZzkRzcalvz2*@*q(!%MZnTwuGKG)VFwLao}`GE{P96?6*; zw8Cd78s8osItUM*a-rBx&TO9Cm}@%|vV+n+bR<^n50xeJfpI>yXg`0Yy!win9>LIn zSTy>5=oxWqs$Tek4)N~k;i<{9%2)!gq>)#m7e^mHTb#B4Eo3?rv>lw2o>Oa*IR&ce zn&4GybVbbENEu_u&aRMqKu=)w*H=a@{(HH{wtTY5T^s~AqtfHOkXrZh>76?3^`~2& z>h9wMi_MowI$e=4On`v($em10xQ!NTiyR6)W`q*W+#1m%MM4d92wwdH3rgr`mGV85 z-$JQ9HNqPWM+Aui;PG2sUAX5qVo9q3rzy5ldU@$xmLAp7) za$;%AV><``F)tVHz7W3hJKr`gQqp-|$WCcXr|;i?I<`2xmoRDGzWoS|*cRMPMoS}n zdFgP)!3ogsaK9WXqxu6U$0JalmzzJ4unU2r5K*%6c|j)M5vEWYYfyB%9Rw-~K;kYF zy?XPP{~|v36bnPbw$P+W!`Adb zcw&F~>F1v@FTa2P=I6iu%$+qQknW;#Ai5X-2Mobd^qG zbkBr{6~U-55r6vd`H(mF`Ix2ihc|COk*Ld`;v>dXZLv@W$1>SGLx5Z!r#7rC&gl+A zP^Or$9Twm$>5q`pHrdjWA_W47u1BalI_&~)ik3`7xAtWimt*6Y%MQdQWwXD#+FsX6+Wq8tI7v2Q-ycik@6GK? zt*YYGN96UTQj}i?%yR8H1>W0OcK49e%!^-(-6yif>J?7AA{n>2tGp4^E1(KJKFgD)n&G9@LD9?8(=)?xL8pCXFyw%ctAt$3^ly<-d%3jt-os zcBKC!O1GOH!icBu-Zx&nCFNJRp56#8osr>c#-~YV%^86jOduz(3 z$sP_^Tmk!u|LTM20nZ(=i^VRst}lwi2|0hMxIYd8WS)xSsUK6UwrZ1cJQ>L3YajxQ zXtq`@eCMqFotE>S#LDN6I^41fHG}zxE#V7>G;nY6&xgmK&(Zu`JNWipN1@DSSW{+d z1w7_cg%x45)EE_7sF394s5vM##}IV4gIS#D`JR@JWS69SRR^WT%#1lxQNv7GkF2LC zyJLIFOa-nkFU}l3XCUavY)Q&P=*f43fEatk6U{F@9QRj2_gcv$i9bD$V8sTEC>d@} zoBiVQ)RhRCF`JvSY{6}PMJFE!Bw+?+udg%nW>J8fht%+zfKN4dk~*yytGxWf!}C*_ z`)Z{O4sfA$$5J*B2}I(#^fs7uAH6;N>=JW()0>ROeG!CLV>Zq?9oo>K-kbNADtUo) zIw!tmd*tcvz!Mtyt)x{4d@9KuC*IL_A!cf0Qav6(@b5wrqk%87y6)HOFEE3Q zoJzGk#t`E;v$*06ZIf}E1&0YLjLAA9IbAt*)nTEjF}9?iBk(7lUL&P>t_0m68&87T7-xZk(GCKd2JnfCDVqs!t z%wAD=V#-x=Qm2gqy-jYv4Mi zE;?A-HYvD^qd{Y!`%>FU8ScbGsg577gIT3o=cXIn0^074$JFVnflXO+o!LDSjr(lt zhv<9hCUaq^82i9QS~4b62C!gUbwmQaY-TepBUvKHm(D82RU~EeJz_%pOY`cQ zlSroKCIStAk>(BO7j=ecjfs-*P%~uLJa1S9jrRGKIRU1Ej~$ZsBxTv})Y{YieW9tv zg|z@A`+AL}B8c+Gr_JOc1ux?s72Z;8T_IPjIL&%p!ElT|gB|l|wf1ER5oNenVLLDx zFOltSnv}nV?pm@tUDpyeQ3lYmnz&-g3?q^wuvYb)=h&9m(mCDSREB0a6b`SKJP6sN z&Qfl)vy3TtEVh=W<~Z|7D?waouTyqRA?X$QdtJ7wnd>Y33}d{m1G@9Q|Ja&R5fa`$ zc4m^}!s^>&z-Zyc>8!9q~uXID{1 zQt0gJ0QzbRzywdzRQ`_8WX8IY>o=5pFoJ?EbNj3)2txvOUI z_Jy-kObH{;WuOcJ2{VTYqt-NKOVYj#=iR1;BIvJTUwxC!DDL z7Hu6OpMCg}(b#yvEUP-4hd&*8k-g(YDRedOu{CC@{h1>6t~mL8X=TDjy$Y$@utLP|4I7qN*>q4cH*A9o z#g=(??9NULPY>T7`+1i$m{HlRu+c{b&5Dc+*R0+psI#FY&(7T@LfYHs{@!)%Oe_Z& zySa=c3FVFE@v$Pn%l%T*F3#MkVFCSUS&6!@+&OjF8Y|hPvRp0j+B-=gUJ8{)*>c4ogE%>&R=llj z6VB@x*Zg1;M>v5bU;z=*f{wn*biElk^Z0WukU5Xjw8NWSj{s8wx!bc*VTHE!UPW`D zLh9Ao)s;Uq;emVKHsVfKTpf1?P_K|lA{pG}(}b9D_js-}lNNt`#}oecrN2pq5rt#8 z1EnaSj^o{Q8@4)`w>F03?YSk89TcAL?kdYvAhsIT%ELJZGFohE1eGruX*A7LH-2sl zNc^{A+aT=PliaOyZp;58=}mSNNz-j@oxN*UWoBjc;o%*PgVXmy2qA=!7%*VKh#?oi zZTx3fla-MX;St_Deczj5LI{~mCL|j$umK~6b^%-l|6_S_52|)mRHiq^XW#p-wVq|M zXEna18J3D{T3dpQuPt4+>k7`?YJ1Kfxb&xwyD~0>BlPJk{Y=YUvZ%JOLOv_G+)t;e>C*iKs<%pus5Y8eyBV7Ay0QK0_M+#~1|1BlWwz_B>d zJ+X8Gs<4QuLr*2V!30CQhww63gor-`m(X_d#-7_KE)Psffoh}faLETC9LeR0FbA*A zWSl>>-|}|}2Ed6*r8U|_%glST5cs*F-pPd?VD zjDszmnPX!IjDe)7?zgR0eZQ2SzufZG*HCIWWL z=~*Owb&<#wj>U?Kb5Kr30H&9jys+3`Vf3{*h{YAl8Ip1Pcn+W699RV1^T5C)4IekmGM?M-KPVtFJ%t1I(iq+_JrFcf;C2q!wZ&8=!SV)^Fgnevbxn_%!E ze1-h?9Mf&Sks4wdJn?iu76-rtA6w!An$yu#ru8x$ai9g{;V_NhV98wj6K7Z1jIz+= zUCd=ayKobVC%ta9GhCzKS)hLe!@-CbDBA~jVK-)D(pL`!it}J%uXZJUx>8_i%iP8= z#&?J0hxq8zRLeT!f&WLO74-+37^o(2ma47l_upATJZ)0e(~GMu&%%$IRQB2|=T})} z#Jh0718rsxz<2^;!uj;vDf#o-Ox&d$pWgnteE9jNpNP)>-5*A3YOtI=u-prYlXQ!5;Lci5p>Ts68OB zG_nV=clVVjF>wcz=RPD5k1)-aYc%2a!gii|uDh3E!dY3gez5O(A>ri+A3(+z;%?I| zZ|(q3*kkZ-KAvB`{pr^;YdCgo{q*YZZ{DALZcPtAZ&y>sX6-UdS0*oCfB(;Kzu!E!WeFl5nmIkzEm~d1<_!%O z*Me@)a>$b+C<0eLO;Olu($6&IQtxJ>+Ag74no{$J({qRK;@x{d2PU5>5&{L{4zs4F zw-nFFZhy>XKqG_c=LS75rRDY$`uDd7hDvs;eP&gPE*gW$RGjq96WTn&YK@WDe>OKl ztQ~7@;s)G#N#fTyzhNg1QCsQFrC=fDhYXs`9R>8bVk+$S*e@>ab`O_)T$Kbo?4Cps z&Ty1t)*H-#6z>7n%>=24VGRVpd`E3<5iiM+4DWC*X+}91&K%8>@2*5uW+GS77qb~8 zktqy7_Hex((mZxP^U>^&SWcoi6PKAuB6d2|<_Uj$FyvSRVOWyvmE_d5$9`SdO10<4 zSV@JV!4MdId8LE*#ZOnkZU>`}{|Qk;8o*~`T3vxR5pJ$%u*xM$mH8qm;eZOmC$zBJ z$CA5LT2TaaozV;{$o_z%eAXA?r*_DF%$9&zx;@4gO5-*hY>n1%4DBW94rkG|sBFmR zlO9(fk}fkF@z1BLnSTUb_u%PzBMM;4JHRAxUjFoc07$1t7|ZQyn>x(loN`BHBQV8j zL+omAGEV1|XHO|4C>8`dv+H#VXav>Rj0r>V2SM&rrf@J*uf+nj)F79^Mi*09FCF#( z*yR*R`9k#C;c$EGsFxIU$H8>by^cRjmDbDYNZc>jf)1OEaJUg5=q~00fESu@nRt*x zX|3c|$-KX)sQvDANnP3_WmY5N*CfPgS!i_dHsOv@cX@>~dy>C~5hEE%Qim(Tn7Nes zl5-|n)TUrlYoZ7P8$LC4x>JuyfHp>en3{R4L@N;9a-sK9)q;~V= zraCVe?QblBC*@*lM%nxg3C(q-%&qC+sWn#%xr#dCXDl4Sr)7Jf>q=L!*F#5g+j%EP zmObj`rSJ&~{82SlT}nhfj$nS>?^kH&yG$}bOPR>Et6NiZ~yx33*wi!Xng(r$G7J`KFI<3V9qmob9o5ZN%W6}_^yEj-8@DewqQ{e z76$y$OBkutc%QPFMw@}?Ecn6FyDFrdQy61TEP*0oXV7+jVUN=sKpRexn}slFHs?uy z`T!*A=B7^BgYe8Y{2NRq`kC4_Hkxq5H)8vd(!v*Yx1QC$bHFysDP!J5c4<)SOQ;yu z+k79fS#8b`J+k48cOOr@gDPf_td&)2dcT|*0qfbxxjS7hXG3mRI1)@UT=&bN{Bh3a z@JGGKzY|~Bd%uV(IeXY#H(zVR;fk`Q=ZD%d880#ua-diBbhb1n@YGmLHW<#y#;#5D9_fhZDL6(mR`1wb_&F*jo>Blls_KS-cH=c*bZY7-A zimVkt1VLyKSV;mkHtp1pfHN4h)|}ldt46M ze17*7X);Va)lH+#cchTd-|o9QR)NPq9|Cf{Q+6jb&F|*J1uMvg8cgT+9o`y)P09f% zj2xHu0PL)oc2uR6)ac&E4O((T{h@M{rVtQNH2*(s5DL!+XO~r&IPr%@1 zLzyx{H^2L?te~mYD7|bn#-Kad2+_eTBA(J6HP*Q^ErG<`!k|jKgGGJX=#C~zHi}V; zy&_h1_{$7RX=flDQ$c&S#7fG=^tEo1sMF&ygOXngK4rSbFuBb2pf{Y@w9y-eYB6lF z6sRH_&3d5yaI5Zt?m!!mr`_f>=}jeeENAYX+M8lN0DAx7i6%u2yJwLUFiT5(`YReA z-N{69Sg$=iG=#Fx?kY>&T64@$mCBl=(&b3Tz$i95vr6_*-1Jar2#n|bzKjeHaXyDo9~jx!O zflqBA7b&2kM>Us})tsTI z<%q}WNvc~4%*$J8NK4^hLVs2&%>es|elacQ;61mWaCP9WT5kfMELlzyB4QZn#Nr`K zs-CvJ?mSP=Ss=4li~t0-L@Dof#<&82G6k8kjOWQ_G;nnhU-#I(i7i(E_^R8@yf)Fs zq}2N;x|oaxD`3L%fLv*_tI;%fb?z-_SQuB@q6seisOYp#8~E*@n4EmNj$<|2#jY%u zF2Aolgo#LCTslTdn>OX5ca#7~hn%eCl*Y^5ZSC$ymE}E$5TgbgSAur9>rsb!mzllZ zX@Bn85lS5vG>#~Tt$>MF&iLK7>)f^JTMLFQ9>Z_Hwp>`wUcY07CaVSG7>pIN3QqWX zmj`xFdU?Y=<>iTSvBPYEt?-H1tBW*BKAqq@~ z`(!!ec6%Y>g5`Vn{_OPitG6Z~CxFGm2Ccf`d&LL#4Dtmm;O$HiT+!Taq2+`TZg816eb>YcPv)GS_h0cA-PX|bo*(K1 zqJrGgher6)8afJ{&Okh7cX2CSm1>VEe`^TJR+ug(<4pQ!EC$oLn7i^PA^g63_4>`b zH^06*;cfECWFfzP^Y$W~%LmWiUFPR6rV|kb7})H8{s{!=x6hwx(*2#V?*IPlvl&+X z{P~X`7#6>MySt;lc%))RC*tY7eESAp!OxSJ*>^;(-+%v#vdew{%jf?PjjWoiXb$hMH+RowVKQ@V zXTYzvK3HmHVo!+-EhE{0g~~VkHPo#ue5CK*LRvm~|K`=JH}Cl6@}Hc4`bgc&udk5o zPVH{Oci}YM7o<+<_JbfcT1f_e82qbcPb`K z*A-nJPb@%ZeBfZ5HWynsce%=Dj&sos@P~4jXvkybo3^=tj9-{NH#T_cF6-slCyV{c zNqNLuX1wbhss<3=OPe=d#IRl@=(Ojy*c}qzz->Lpra=A|0DwtCXLSS_#Y_aiCS8u3 zZ2754n8Lbm)v0f&b;e90h|T8o(d_rzb(&tdoY1R_|F*%?IVTU)C6J;Q@eQuvEtGMq za?58{j-fwa5KiA8Se%%1nadZ6C4vq@cqNi9S(0Xn6gIdrcF0s2MuMCKqUnoPxGwh9 z(XkR0_o;G14u|*W1>1h!FEyu)$@f05pX$x%YYlPn?weTw`0^RCymsG8Zwi*VY+Xc7 z0&b46?7A_XF1}B2uu(N%T5ks1R4IS$^LBZac8AAp-hFcB4O>U~NX1pK@33?WHTB!w z@$2Y*c2^s{$bALxhw5hBPc(dx#XpM^R z313-l1y`f$Q$9$ogD2@v&&@cGDG!lk?zlsJ$4qz=Z&Q%O9rp`iCK#B_zgnXOG{};g~2K(<_x;X z&2}#>RZKz93T5_SUlRLVP8p2reYC+rgK+rssBzo4F+H4%VdLTDvH2j(l~5^)Z__v= zOY!6`Q`o78(SWVQ%WaJ@E{_Z2sIeqdd{+b+c9~5D zV86;rX_+RV8jR^VmkxMkRV*$`W$M(~*f#Fr^6XY4iY$QR2t`z=^&FFS6W3eOA5W#z zIx06SdDT=H=-ceQu=i_DmWLb_Csnpnro((bXs#x#;>Cfg^(V)C2CJmOY>g>+vZJh? zef?OXoj0zPt)xdu2cw%xJMXzK7?pH^;?3PI<^{o5tFbZ0D6gx#^mffK&%zBrhR?fQ zP}c(ey5PC6I56KW4OZRRVv+I$MGzGb)>FFCj8yiR1-H|9ZVvTOo&`BYRx<2T`dd?_ z^j>31!5Y%)$)Q|cCyGlNOT%=TfhPI?Ax=?a~ z^l?Cd%e1>uL%(Xk)7g_kLW(tVc55J5-iWkxsxUvw>uGlieuK{ETxB~q1CID*7-F@( z_m!eM0xr7N z!ksFlIfFZoprracEnCTRJK)`|m5-V^=x-17Wr5DGHs$E$r3*L}i6gSj1c@+$9+&e4 z9j_`y&M9w&)1k%TyF4VKTLR&Y+Q3-Ov9yvjB*rmWOi9w{NsBFBT6I|*9imqH;?{MX zj$J|13qiuhTxQm*Eo^;BEc(LR@`6oweUW7*N$=%xQ_xkthzz_W*P?*3@mDwmGWIY( zZ355@AwhT~tj?M*w6U%B>?kN&tm4O;b*G*2ChFVkD@YRcmYi^T^Aa=3%Tsd*c?F0` zf3{L_8W2L=>DlB;6c{Hu%L5@rUBvf@&u(Fq3RwS$#xwR9hN|r2XAWKM^F-8IMiLrU zc|EMP);Jl+Se6W0H_K(nRcq}KjO1htQ*3wVX*$=6Jw8@g4YnaaZH^P1@(R%(eZQ-u ziv)WlvEQ1NeGc$Rl|Nm>OR8%?Co!k)CUb2qQwdo~$_pGrh&`(m1(h1!R?{QES6i-V z^x=#|Gfj4k^S-5St=Dfh#5A1-=_N_=rhvdzDN=_jQtu^7V-`>1x>VYzLXRMU5x8>u z3P7(}G8~yDCSjW>}f8s&a^ zJPyfTN{d4Qo2)OTsoh4SH&tR+t{|M3Ms=3Mvd4j^9o7?wuheT(sFR55OVNz$4z!Rp zu}HdCbwn5Yfws>bsCnQWj5wdAg*lin4L=ojvnIyO!*QXl z0WK*eWwnR&utM?$RRuYQ#LIYAv|38r0T-s;z6^SSm!w8RPHvAjt8Iu&RW5IrbW-4U+X>>a+!tgufz@&L+?|aKZzx?@W7Y4P1Rg_K>|&cGaQlU_ zHb%lB5%x>u71ohicYk39D@O#WfEv zElhL-z?Kd~ImH=+Mkz-K;N6T@i!$N4;u+wFLoOX|K)VejBj^J}bbC*Fha`M@*EYjO zC}t*BlZ`|6SPC8p<|zB{rL#cUVRx=)12)@rWH%+p+Gc5~OJE!LsZqC%`*}` zY(*Cbx&kw@3{(q?k5b9y%ug#_3Ul(9GhtOusZ-qXHOx61O%PZtvn?2OrgZ2+$V2y8 zD8N6IZO~WPt^rl7Xh*VJz2Grea6>`Ng;0@bi#)wd#S-OwF73L&Q7~g|-WRsnJm7RZ z2sF5?D_|;F(^47*M~gh>w%|vSVF>Su${wIWvX7SW(w%N|`?bE4Re}*ms)5I?wz%VB zb4$ezyKvB;N3lj-0~=^FxK2eT&`f0iP5LOr{iw+lB2dZ(K#h$BP^iwBXOB$O;;?Vg zdp@4cY5d9s_KTTmgl2af4#g2-hb=7uJ*8AcYIY|}p8P0aTYsMBR1()|Nn| zER2x-^K0%I29@$OYbXosOS41ZC~a%sA6Seu7m1`O&3SAa2riV5lH?r?$y6`9jQnd} zsAJwj4YJuhs_a}qfgz1>49#aCAjrs%SK4Y;zIJ2|1R45s{cwyr!N-&JH1UJ*jCXO>G62?ry` z{oCy48Oz!laQ&9ik9TpKGnTS!yc9ji(USq-L~S+16#yiGey#aT)dY^uBL&M4UgMcR zIRZTPpe{1BXV2-FB{E+&yMlSo(KkPVBTD)dZk;%Q)=cm3ek;%Tv9C0Ql+B8x!+hgm zmO2uWD!@m8C6U8o5cY@YPve-XWI$T;H11*c(Mm>w#zenYpjVqgW6pqLp|UZ9-DWNu z?O_Zmf-ind1t;Dhm=#2i`QFXA>Ii=WJPMNIgsuM!CHG8d!jy2kC<-&+5CEXfk~W&w z_~nyEtL!&0aP}myS<9has2Xn{Q$jmdxIlyQ*vb<4dpbM#mdTEDYAFPAv3m2n=W;@v zOw~(S@E>$Q;||&CB*?d#nKK8Ai#KP>iAR~e3N4EHpQaBozC?ZrYLgN_AoOq&ZuVQa z6ikC$zNh?xFep)0AGc;^yd0b*PiCj~1LavK zUhB-w$+anb^gmrX-0{*@WF{B-M7U_U_?^fr$|UuC!}&()E%boN1T$6Fi<4je^7G&R z=WoBfe*3}VbNFpUNH2Xw%u`R#_u!NP$$$Ri-~UEcHZ!cB|NReQy3mGy`|aPq{pa`3 zU+-VoAenGA5|?piQYRFxk0%$_(>K4+&ijA<`>(7w-v9Dfpw7R(etSldEK|EHXaZph z2X28_UQo`T9!%x*;r`jI>10X9Dh1CB`zxZRFvn1QnGBJ6zuY{+T6%hVcp!^}XN?O* zuV?PFj@fvEcnlfDL=0Pu};xnudtdgtbm<3PV;vZXaU+klItnGH(M6}v4Q^GGOGt4Tro_0c545LydnD+oa zE18{!X$OQZS3K$qN4#vWqS-vZsv_}!14XoKLR7hyn25;|Mr2_8cpxc}=9;G z1~Sf@kS%#!4Hjje)tk!Za>-x>s7c)CrB-phKhkyynmXZg`U~A=TOa|GDHV&kG!Uk# zOmeNX+w3%zR~mzDIdR~WYOz``@EMo3DvwQbLWQ@C21CHQ4Z?dQmt+EpFv?-+3M*in zy+(ulo~h3Yi#cp#{7Z7KxSn-}S~eKW9xCu}7c_?N3{Xk9JVcqP<f+j>Gndz;?Wj+hDqk{kUVGYrpo}Wc>mh$!DMdq&rUN|? zDCuJ?&5#L{N;bvuHCK;-1pUXYOmc_g!=M|~N0kTHVNMqM+6wZFnMxE82(3CDas zJF~5EmIXU7|f@wNO6Pu}HRr#YU!Ustf1F?6XofM{0>QehGbqNBf1{7*&5f3L*Bb zaXi;mC2;ofQbQ8_HZ1!s4!!Yo`}MJZ3`Y;9^7uH3o}Y)O@Iaq7zKb)5F~0kH*DF{* zoF*4{zkM5q-@Ljk@FNkj9;?lr-SZMwvp#ov)qB3FZ+3+gH}n_CF~gOSj^;F8w&R1} z;m_<@F|7{}deX@vBc_tEygx623fHbby!jN;TF*Ryg0{k*|8o1-(2_^Far5=ImyBl( z^G#^vx#1)98`~bQK0wKv;ZU9}W#}#orHkX`d6AE2*Mqwo3PTC?DP{x6V4(0|d zy;X_kRTBX!>AM{C(6zMBc+OaVJCc<`$QJYk^Tl|mP*(eLChQ9xrqiWHt{|_AyoV7& zlzk*PA!J)Ugp-BwOJ`Yj**WRhCTROzDj9M(i@c;Hr!%8GeY@vo&;OL1-z)KiNEJzLy+T#Uj;|HX&*7PrU2;EI6agWVVPMWT^h#I_a3T_fao zW(HlU691EEWsnh&_bZqRDRcH)M!}S_{AtnD2NpSLU}c`stlaL`SiRSV!l?CxIU4TC za3xOLPj~knN_#7nCH{S^DMXChz3Bqgu)p6@{Ql#??~Wt zrYI|`mvb~zL6&7zwE@W5pHjM&iRUWHLM`DE%x-CA>Mig*Gb40ns2K#p2w#4G=qTHn zGN*m~fhaD>SW%n|CZqP`Sdf>aXE4RWR&C9QWAb4<@;6}d1R|lN!+w0}k$@;mcVyZMQr9;R+^^j4udz9D2fZzKOw6 zsNH}2R-5c{rJ_8BMx#h3%wMQFVxg(>aQs(vVFW&brN?SlJnCGyO4)n`H2+i!U!0}u7&f}p83AnK4T7yl(wEe! zoAxV7D@>ZxT}p2}-`x#Mp+Gc7IuL@c4BG!vqZzOszwzY4+ z{r-5^Qu!lR@DNR>TLNuVU28g*cwA2X(x;Q`{qO(&qq-@?BQbYuyO`0zCre5`U)jQE z(6)`IPR5p7*NGMIkN`EJ#d@JKYztx~WJ^=i%+;)tvc3A?*B@^lhB-ip;2CthS)PQ1 zseXt5wL+$udV*_fQfYj* z+X)?VoU3_~@}sHX0*%Bg5+8jK`gMvHAu+4qMf=)Sh$nLP&W5uj1Scq>XhhsUB&jm9_ z?(fS?k_tjoCY~QX&TL+(v5Qu>t0SZ_6{6R$w@x35?j7^OjQ8MN%Vgr|ZIO(N1|SF? zu*#)~7xYX!uz>td`Dd#y0_Q6+dT=$7d0p?3%(4}Fk>@SByr9Bh!qmQ!R@4zy%B;+$ z*b|`nOq;|i3}dlPR_OSnA_U3=Xlyps8D*vI))=6`!zM$Ch_|fg{i%Gc!pOGT!EQRFm(`M$?1;iiane{E}1swn!!7ygd0p$U*6t zF;K*}ySs0{fBF6Y{^Otj_zW!PkAM8%|NZ~|_cv4KVj<<)+N#A^;mEUt-hKm2&CjSktYfm^J@^)M6z zZT>$*hl*fU+wA1xg(lC(BKes22w|| zKqCpmvLpiK0)d7(2#DoMC+IgM_k{v3tUY4INmw9r8h^9Rb?z4wzaLD)Ysu#g&8| zq?N;0_CQ)032S&vMf4UnTbv;*f%7>xRF3i8)1WTU5TRZ)V@? zQgxD{0{W%(<;VQ{ely-t*G<=Bt=26p)$Uf0Xr6NL%67TQi=*o7`%UX5|IF_9D`uhk zBrO|>%VuhyX^vuw{ruBaz+uhvb36~9**h}|o*PeEQ?9iKWO>wTr_|mV;q$|MG|YXg z_V#$UW3Hh6-16r9{rRsaNy`pVYxvTucbi}SbMy51<>vW8rZns3w)0r;KTeO{pu1ot z9B2=CKEytxwZjal1|;}PvwHjR$IIy>gayGa2GsAE~pqGJzwx#I)xo> z3)AvA#(o4=oJbTEf8}Ue+7y-YzNg1euI)Bo*l}jJeRy;J;X@*>>*GajQxw!s86j&9+9v2-x|+Dy}VCehgjwsxzSLnTm?NI&n^)zMndlE zOFu8yG4;$vsk;~nBm7jHO$!dnt<=(B6&wpeo68cmCgUOJna!07We$hYr2qK+>19CH zuG`v7*2N;81{b(l7E1f%G0!#DtlCi|b(GgsY~f$b4>LTjYV#iGaEo_PqbmY>plpKV zd5iF*s7l+ik%(Re?1>#)H2i#A<&d2O9ZPbfKS)zzIBQ8$ZM4{yqm^(XoJ)iQv0$OB_25$ODJOc}NAAA4At z1qIfMw!kJA(-?dYet$HOHhLt(D%m|-?)i?IymW-0ou4KsM~d!;xGmwh^!V}ztrD|D zqcY5-{ZEl;|QzEn&fR?SvZ&O*%GbAHyb;S4m;bL)Mg`HEyUD@x5CTV)hWvpj7k}{R8p1HPoBAL~uRN*NK z;$hQr!Ss9xNuV``E<{lU@Qy`U>okZBJTi_k0d38BE8$D_{KuT*!F#H8A^a&=Idm% zGMPZX?l*et#TEs1G+dS4kxT)76qt@3dV|$+YD3S+rMy93D0hrO#))R#pDw&%eZ+va zLU86bxbF8Fykr@-#3fLP7Ad;tzD&SQRsiAf@qtY@8*$ld&c+)i065be(WNZStIpJR zj!Xf8%4CLYLBG`2sigPH^ucq>CxbRxi`aQ_X=p-ne_LgCm$jP1RF*ov)jm zdAoiG5}in7;_8xoOemXlTLEFbrE2}$Vz;|}S063$qChvq+DKkoFD(AjfgOynI_y_u zCtsQkDrz6-d8WL9m>E(Ifqx7XW(Ilz3#@&2fBRs%+&eq7=B{T})5PfPc>Uh$iKfDM zsO?r8hSq#;1w*#tBs$BznRZdQy52B|;0IV`Fw(YD1ZRNnC`3kznmv5JOUjXwK@Wj* zz=F@sIR*=HAW(>ch8jFOb>z3RB~gO}R=enK4HFF?NERc(9&S)Ji+rC56qU{s><4hs z)Zow)@%@nx5he0c_X+zX>pm@a6_fk8$L}8+qjfStoU+;5X0l9$612%?WjyhK>Z^63$S>p@tIZ#eFQW}oIF9IvKvuQ@unC!R zLQ;8BHYVc-f?AWT^WyynYcgL^X343WN_94)y;voSZQd`sk*x=|w~a}TH` zBAjAhztB56-e;uRcS=dxOD63jec1X|nb*M~lwH|H=YhwpfAn5nrQ}u%A^_;qWHeb$ zL1h~PO32wfyAkAwwp0vTFS1-ACVR-;v1qzXU{E2N+!eESk1=}s{@m|t-t$k+(zrcG zzAW!5*&?@jfj(&t(S#@8hAmU;QKe!DVUT}DY1CDXUv|bagpa@M1o`+XMyb;~uCg-@)+EpIY!AMI+qx5PnuMMrltPC~F>@EtE=^6shDrqrk>qqzEsEyYb4GUUb+}(#5%^ zB^DhMerUBRL=*e*-4`674>jU39kT_cB`@h9kI|IKeI(*{TcJYvc3iwQ|LHs2vzL)% z<(SSU6NSopZf4)HT=q4oP5u^-Y-_M#<{l7q3!-4I3`7auRLW5^1o9#<|wrz4|=HPqBP(DqPasXSEo6HK^2 zIMu1PYmb)%y=9^$#8cCWF!p7fn9j>fcg$dMoDTXt1ZJ()P!Wj^5oL<5ZQ|U);BZI4 zBYnr0++)ZA%Z}6c;r@}I%8>d)$X97z1YUgbIG#NY`?VWo3lNq+l#E7#9$*)lV!3!w zcV@rcBfej@(C8NoL40^#?tvCjL4i@|5kITA7iPnH6XXG!e>9ScS!~x9cOvKucwHdJ zf?@a7)!9dQYT{&x#Rc}(q}^Rh{m!GwF|6VoH{JJ*mPFK;7E)-dQ;5Cu?tBlPT?I5u z-G;V{?obhBLV{ z$C%58mEAl6K3(1wf|piT+yI0^3;fBMJrwi1FD%~l@tBE$!pLv-_YB^2p?)s5EHs4Ix{7yZIbkuy} ziFLBK30_(4QKI+&yoek$>fP~pKJVdF`0*l&Ev(~=(yj4KoYfxdW}E^p*^FIs#boCj zTKeLgZb7Y*iUv?ZE$(nAL@Xj=?Bo^pEnUN+(d}=IMV}%sc!(yh+C&UIP|swx4v?f4 z7d%0uK`~s+A7(Te=6u&S%XPpLhzGAMS8hy^R8!JYldfzkvHT8WZME9Lbct0OI@mol zFc6PFzJCAu{Yfk&N}9nc{G~ppGyLN0!kI3zgn|TlP}hT=L}4MQbO8`vGI>A}*}LBU z^7q##c3y6ti&wwC|Kv>5QV1EERFKDA8Izg)Oto37U4wM{$G`sh+gBpt$e3nm_y?+L zYxGD;0jKFe$tI}80k>UFUUO%(Uh^BI(8_Op_tSs>&o8Gw>Mrb9)?a_Pa3_mJ9K9~S z7dA{#(&zo=ST^rzy9YJ#B%!K2X{0R z$!e3&aJJ4a{$+#Vw!HjlXW`QZ+k%zhImH@&A};{1^OK2xdIq ze*2Ex3*D!NRUJhaX&o80*=cqlo-d_UIhHQ%S;XgQl!2?v!Osfe^!?j+0HJA*I(h&0 zCg_i-_x{R+^vLNgguqr?h2<1rCh}8BGl{&r@@jG2>JW2oKU0YOZ}LOcpTR_BiAxs zCcnp#I%@0%0Zx{3WKvDh89(tcTabeyUWhq49u0Bsj+H1RK)atk8f9 zE*n_3fwv(yYK25FRwSr6o)`(w`I*IAAX2;D{#41iJ^3w{yNO&$G2fCnE~VnB!-k}|lFLAHqC{w2 z%q5RF66=VYNfJQ%?p%Q9SEpmGo?d zhU!utaKmyiYK^p1%$Pp2IOs010^#5?n?;7*L9f;YnNd``bXxCx&REejKuk6KWd(l1 z^0+b3!xtxxqF8@v_qgs~*b@+YUWAYiO{YgL7|MzMsZPyTw!D3|l24CAIm~pVWv#H>)>a!AT=zF6NDU6r=_{hZT`0 z`?;T^k1^hV0)hTKDtMr=icoVSb{kk>tDRx{vOFtDI)s|4;}Tn5JOoq z40?^OW`f3Ai+w&4@LnZRNho{@#6dNN!ftz%;ty?A3PnSOG0je0BW^#ngo?@-X+zTY zbXjx}1E(7Sid~ae$_*j{UNJ?Lc<_OFu!J^U{1RL8+2m!GF6K+a#*AUj_UX+fis~*y z`kWYZHWiAMa+!1in<#<)R%^5B1Cmdtakr1!G$(P=HG8}aULNb6>eN_uUcP<>O-83o zw6L1aC0wRD-bmVdmxTS3o6!<~O?JahhuUMysUsXORC2Lo)^v|14)h;OGz=%=>IzEt zT-(G0yzFKi?CX5;*x_c@ovjQ_T3|D$m| z0_v7vB;04GUaoztW3v46IXy^2rDHiRtH*GDCys~gKYB_oT?Fz%ufT}-e7{N1txY|d zkq9QH^;<5P7)A3L$T%Dw6ii@n!?{?@#lwb%qUngOT5LSf#|C(p*xU|Ffi5>AylAa^z}R5__s7tN0D_oqqq>5rS|jvgoUp3o^d zQI3`HH4tQ2|3~^y@`=lk+Wmg>+#T<7nMi=&$$r)s#%m@b&SH`%t;x>z&b58{<97@o z+kDhZ=QKBvwJIN3L$H+)foM+;c8eiBfBR0yfKf{O{5e$<`)pfTOa#MaWg|^iIos=Z z!Rg(XZ_i^aqBcCx7!vV|?n|bf25njx3??~ud|v(b<;UH_U{g${ix3>(_EDYzD8sDp zYqq3}?X6|Zn&h#$$6Ce=W*B1x^O8fhluhlt8Vp@V% zFxy^Q%R|=f@P>0G-a$dz+52DLxQvxl^g^s>6eL$3Pw(bqHF{-pgmQb_{u4OS zZ-Q8Q8v&6Dwog;dx-Oj&?mE|C1MC;)m&6|fq~sFWm?MjAc77}~K|9Xbjpj9Bx$KV> z_F4Vd~WZ@LbE>c2w(x3>XNg3aKPdyziQkXtdR~KjJc-D@3 zA(YQk5ogRNy@|oAJmv@#3|-~2GF6WZFxc4%LU33%`5f~-5I-0)EtR#kDs>wJGb2Bq zA~My6nUw*U(pyaQo%R3Rq zRT)3uK7+fiwnV6+Edo$_Z@k^}Nt+iCx*YLB+!KvN^WHO$31+Z`3rg0;PuZ2-jH(E_ z)!Gj;lza2XKmPI0-|x7{GT?pYF#)9o^p8$E)^%(p2=#0|c2;4lv@>?~0pyJ>j>r42 z|NWQ0{qoN4^*T>U?}8R~oO>`fl|mtE_i`nzi?5vl9H{j3)9p71QdmT5eR%+v^|m1p zOyYfX^M!@oP$ZH3r)%>b+^`A#o7V5X`~i_sq-f2IN%U5Q!j7)T3T=oerw)hh>4HDzuXA)%M$S2zsv|KRCU!no%>Mi%egLXA)5FBR zUs!5={ntPK{Ra!%A74!}5?p3bJFIW`6w+qQ7x;kF|M3SGf!Y`nsUi#q^Q8*dJ8E_y zIs|SP(0R##16)dC&Ia=&z4sU{AzH1=w)|x68VhG>`(a} zfnPyCLlHJ>?Qkt|XKb~{i*2s3LqVL$&%rQF^H!m(R!gw}JY!&2DyEHJb2UXvQ+tX-+1_iPh@) zqBng-19e8WAH(iXUQ57&^XYDJ(`d|I`i<}3 z8g~!Ra1f|7t|N`0z<`Jumse0bBkoTpuU`H1?ksAHX58G>i+O)Z7xh8BvGS$k(e@aQ z!D!SZ6az#0PG}36!p83*QobrnLf`BFH7(u$`u3&QnCFU-_;M>&bbCBzw>YfnVv<5x z@9D?aZ{EA?dTy7yB067bH=e%SK7J?Crw%5=`{vUNosILA+IXsd|Iw_?qyqbnRcldK zB`vy&Qaef9a5yaF_Wp~Mv6>A*b-->pvqao{z5XNs8@nS!K#}(+8AXwfYs?+DH~m>( zsr2U$v}L}G*P^0feD2S*qSbGEf9a3!vP#J)xEzsCexmTz?}W5B2%IaW!CG}CQgNs| z;I&>l9Rhlp0?+s4rB5PnpiMX%o=jP?-V?}2ys%~3qW2s=o z&nm+ah$$_aEnAb(L7l1+ECE2m^9hfw5Bw(Wp*&NUTP1`##9zqCXc$T`PNb< zm3O<-iJUKW<+}EI(#3_K9TMa@fTmk4*}_JkN16{LJrf+MCa0HfTvn!!fPZHQ&a{ef z9zg!2Wik^X`~p?QF#U@9e7VG!5c6I8t{oS?I9JJ_-R1NIGpqT~3>odw%OwuiM}Tx( zcG-M9nW_gn@viTxKUj)B*25BVLO5N%HYt^)1a=k*h^uBd5? zEt;S-0^hh<*`W+qLaR4r!`B-cbo)_7hi^nCl-wkugBY)oRIZeg5WP&KS2+?cWOa$s zBB|)gCXbliwN%AqyzeWiBi}A6LTj=&(v=-8iz_8NANQ#+zh^p}aamXJ0?thFY^q?2 z28TlrDECeTor6&+hwNccX*&2oT^H5kcBOG6uP8mPPX`$fltg`No7N}zXWL?Bx@ZZ4 zFd4HOtt@+k#j)JsDIhwSt57F+9E&_diZI>K!NptJ>u~OMhJyWi*pn!W19v;X+&<6m zRXUYaxwL9cdNYZ-9iTh)T6;pfPR>Xt42^tD*KJi8EAlQQvW}gwiW#&CmX!^8Fu}Q>^b!csJN;#B zvn}sQ_$V;4E9LERB^MKioNjCwD{{%a{`?(e7BIO=u~gbJFk(VPi6$bs8gwTcW4b=T zsK%km79x`(E6?zu(C)2Nl78Q1TqZJ@2oV;P2blRs6AbNT%%K!n$)ldqZIJg+#$9-r zh!x7P%F0;TQonjQC^&(7z4miw0+z3w-sO*5P=~>SLXcW2XA7xVoPz1i@d&qw6zQ5-`%24cr`n~+qku?3!W^Y1 zAIpINXCV_Cp%*)1 z@@;#-WVV?6X*?maK2Xa(XOiLmZa*`S?nM*~erHcW+ zpP7=Un;2V=up2YrdDB}Mpr$pK**RX(pa%6PbIw~&ieb4$SsE1ENQJ7lDebwknoSr; zXsyw9IN0PVpyEX9A$%vj5pCJ6^)SYwct(ObrVemh%8KyF0XO`F(=Z=)6<3Tjr~i%}>R z0yG4YH+-EsB*Auz2KaO&FDW~g*6_L_37ziHDUL&77xrdx{tG*b|B`Y1AApe??N(b( zxG5FtVp$)r_Q@+xh7dL@VG($5Ud23*Uv7GcS;HU_1y$n%9d>Pnc6HciXVRE&VN^Z8 zG~sx+MMD|)UTUk^Dvw^MASK>b+tkt<={T2wO2Y3V8TRIl)0fRT?J>W{dh+qioyd~S zUv?H{D!$nfIYZ>UbMaY|ftH&9zT@hHiO*!xHRS?=0yp=tHl$)8qKzpGVp9v>3Sl2V z?ZFSf$?v?x5O2LW{cu7|&1!YV6VX`E8%*zvJXYv5Hj_yDNDi99K7exwRg9nr7nm1K zvnYw=`@5Gm9&h~A+M4zT#Dgxihcm98^F!M2ji)kHmw1@JPR}fE2tQt@%VW9Xo;R7Z zdK7ZDf_a0KV@LxW|q;gP_EzeE(D`i2QVJA#tU0Kp9r}wPS4LVIYXHA_|SOeT`Fs^jFXRt zg5RGk2vki%83wf3V%kEZV%zsr?e__m08g54lc8iqsDV|HC8TU~7infZB1u?`PSQ7- zfCD1rhmW7)AU=5pLb2?TxGT;nG;9McYy;nXpv-&lmvNQBuc~p9R-q3*^2s0(i_~z` znmk>NJ^+B-p2G|yIN4R>xTX7#Zfb9|$bNKBr<){~V*W@;=M~%q!B+dvC(77t%YXgXUw?UhV!2{hLeY)g5#0@84&PO0hh_DKimdR(S7*w&n8>SoKCNp?c~aqL=OX^+ zKM}+p8K1BC>dk*Vs7W%&5GCa@=&_*B=ef3lV5UIo1jO`D|MRz>vF#)4zWV#$sr99s z?G44c@3H*4T%N1*OQ3?l<~k^$6mIZ;{Dl>ShnR|-XF~fl3$swcEYa=rR>QRqYWf+f zH6JO~ci%DCn~*f}#LU2~Xb2tC0StktJDIm>+oR|zl?r*Bc1%KSeysTBU;W9Ud-eJq z2?u^MHp|(^w}AN0EQFYY9=FqWj`fumeFH^RB*Vu!#Nvck{x8;@Tl;t&_gH9 zsn)??p()a&MLwUNEA-Ju6CO0qf1Ew6DewN|NdvZfeB>cv2@6^U(DB5)BSEPmrA9MN zzL*YP0|@7@t5iOlpkBtx;T25bN~C-y#0#LP%YcseG}f+XVC%bsg-no(n@m|(w?;7) z@nM^VAH$#bL)C!lYyw2gp6#tF5`#c`@6trf0f8sr&o8yf`Vf#JKV>syPkU>h1U@aJ zB{nAV#wgGY7Y>Be)XtYPAUOlxK&p(tN!(QOX_B0LekqK{Nk*MP%Y1&=A>lA0Geg*5 zTh7MA@f5K#-doo}7ZoK5B$7-#eG z45!0%sq$wuoE@X3#w-V^hZyxvM^0hSw96%;iA)J6qPjxX05`HBuSQ}A#xsXwpDs#a zHk~3`p(bfd+KYslpj7e&3P0A0Q7Rey#t6JE6{C2lhz69Y6DUB2&R!DVg~nRX31k;SX_1 z7!Q#^<}+mPxgax=P}tC(t(H6D;oMR+<~Q10DW*Q`Xj(2Zp=Y!49W(Q2wJ#R-Yar6} z&0|yN$D=|)ZPnTI@G6t}ZvbLT{G-e)mul_>`M5ypVmr6`^6ZU9gp=& zP(f6Xjvn(%n-5I=peMlG8V%tTGWAaNvY`{z<`)Hjs(d`=5{d0*xxic%4#2R87xd)< zYUUBJs!VWixuNfy-Mzp<+sr1(i@{`O(pAS4#Qgv5-MwxjHxLK#2MU4!se&s4T!cOf6rx-lVEfDzamru{z zgOp*?p4ek)gx&JGhReB=PlbSbBBY6EJ>JoR=Hn1cRmW+h?m`iN1tz` ztnHk}vy|tlH!G2}={(GBq8ui-$K}%W$rt%U>2Uri}w z(%5uzsBd2mTa!8ai!IISy=q$jE_38|*x%jxXo;hxMNuy|9~_(NMa7M`7ZN2{4sypy z9SF5pNLDFhiRE3=|ICEr&z*V9y$WALCFC(Fxx1Oj_Po89`c8=4ZOu>jhr|78Y0so2 zdgsHy36GtHg*^UvcXOP}CGqsf<3c{YJ#G1(e(aqsE7uj5-Q@UGxp5a9(!-~-yN;)v z^JR#zWMXeVK3_-&BWsa7Q6`!}a$&C}+ zS0vi|$SAML-kMt(=4C0_EF7bPLci>{^3^;&&MZ0Et@gH3(MBip%EbB;%i*a&eiI2v zPJ+|V!I(J$On}aNwx7fxyWl$obBtRKL0nuz$ z+-<$1e6X>V5V(=uV8W2#>8*|=Q;1U3U^}J3gphsuz+>Nh%UZx6N?4=|g-1)<3jJOmy zMbWD$N5*4F(ioJSl?zOAn6(~e2w2-8p@hV#2npd=ooGlX$pn?mrw-{0VS3YyFtfCP zX~U!(S%#GSPcMi%TK$Bvfiy%8H7E}}+`d-lImKeKriYkj&$OjE9rUTtUTka#{%}#l ztNu_x?sk|##+=|Frw=Qi6S)|RB{I@VuPZvzM6}x)!@Y3W?d8AOCbn=pB0ic=z(`st z9I=2^=dhSmGxDxyt1D+JPF6_xQ)rc16&TBH%#`d|2=A&dPUJ5bJ zagZ;GCP>@TgfotcPXWkt4_l0U#Vs&pop_C)35lj;MI4-hG~=i-Nuh*6n539loRaBe zDOzc5r)3v0QW9s5WXMvpvduDv97D6y#Xx zuDzRPg|l(_7&qsC(y!2zc=JhGtn$Rij3scxCbN9< zHG|!WD$97!+M6Dn>ToZ9X2qbxfPGFE0% z!B5g^qR8G1Bk_#x$RQ)iOigUdF*;`SD#9qYO;ixjVu+C0Mq(vr054^L^jvHH0wRkg zV~aVU5kTTjak>!z^xX+6HuY1qp`+4#QL7O{TxQ;xN_a`$#WetXKw_Y}sZ~ZqLX;6N z!3z5`i%xVdcSr=`4dw%S9IKC03PS8k55qHeHZ0^}#|pj<69!`T!cfLqW~|{@ydSOsYyvKM#lOUvBiZ7PgTY_rHW}=2>A}xzx1?fwSfS_y4$P~mVm9Z z35HZ;64GUd!Nv!b5KJ)}+F`3C#X>UI)R0;J46vRLoKGupQ4MBc(H*G^l;ixa2B^j zTNg3rpG>6F!FXeVMbPOS6AE&*=0*{A!hH!k<`VqUVkBSQ+~7){h{RgbZipoaU^O?1 zXSs^hQ6@=ZX;%)i2eBQ!J&?);Jy-sm5!{TU9t2dudWuoQF`ZUm-5{g;h-Z zr_~e98y~ITCR4KEj?IE|^GYm8Zc-GG^kTfJwnMdQU>E&@%H@Sbl@<_ew7me=TDT}C zbJH4orPS!dYs4=IReyaGLKh%Jif(wxZ{+1G@P-k=j%<=hl_sE^k$8mU64n_P{Aa`g&P4PRH_ zxseRG9H`^3FzPzpYUD%bt^D0hiZ5iYU@q`sIq)O#cc^Zzi!V1peP7d{uF9`28~Fy` ziZ96H-34I8c`I$5s{1rBR=oT3_oZp<4ea{*t@OWKS?%&~KkH8Z0qCmY3gW6%(!;mA luP$>t62AN`=vG#huK-xQT)$RaU9{S(f^V1KB=EnMz+d1??Ir*K diff --git a/xemacs-packages/gnus/etc/sounds/catmeow.wav b/xemacs-packages/gnus/etc/sounds/catmeow.wav deleted file mode 100644 index 17a7619cb4b7559b7a4fa05d670f276a2c9e8e58..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 41468 zcmaI9*LED)wx+lHPM3NFJ&H8C&vs>4v~VQ6_a>3vd+#%Wg!hghK!UbdtlFog*1aA^ z51{X#ksw(|XLM8%nTUwxrgv-M(LetB*Z=qMFMsLzKc4;DD5 zV*mcjU;dZBjE}fR{vX~+rxNjaJef>HBjIo?na<@4`D{87358?nT&Yqnmx}ppCY{aZ z^0{m#n=h8iC2nyqlgZ|?yc&zdlDT4~Rw?B($w)MjE!CT?W}{Xv7V`NL_lvn~zFcp$ zxLGX~a`aRz6?5riBAF@H>WzA}m`x>9nNnl3v$@%B)vM*AbCt^VW_zREYSLS!n9tF$ zNc$|K)fHD=0DPd@>q|#52Wey;dz` zQ;9?(lP^{q&QwdqLb0TE9CMe!N5toR5al8 z1!EbSmGh}sC>RXI({$d&0@DL>>2$6DYKqx(G9HU1lIb+fJnL?MG!2Au$&k;z9*Aq` zLOKx*gCE{VCgQ0aw@Nvt7V!In;YcJL@OnJ{P%M$4qewiF&SVl{@7n6BH=3)qTD3wd z8j2*;I359bi6j`$B;(O&EFO=9nOr!QNTuRIkIUtaWGnS%t(fLPER`36<1waQu9OS8 zBtylM=}ao(XS}c;=b5tC8%pL&nq@K`PXLQbF%u7mQ^iKR-7ID8WxdCsSxXP2g1=vDBurg zE3J)I-PTE?uzzh~W_o@-lFsE)VbAj7(t0Res+O~{fZMg^2}Xb{Yd1Vs3mNzdpwW?c zZE11U7ft5?M996uckl&jB0--o5Q(QiTQHo=*BbQ_jl!BRYq1 z3T4LfyIt#EAe@K*({Q>}spJzOA3cR4v1rJ(ER-15yY6!P z!tq2j=yUsGkPFafg#l4U#P41O0RCtSU_=A%wN;ltn#mRN={R%^hO>G%5Cw#gH<(VQ zkRkCnq(`UFeLj~KO$r6TI2#N3{h@d!2Lpw|sZzaBD`XJ>qF+c!1nUVzlfp_W#&nF7 z;k^Vii6t_y1w0tfmMSI4N>@zq2s40|kj!MWsfcfFdDRnv;)>~L5c-a%(voA0nlBoT zL2v+m3WxmbT26#!>8RhewB!n=OXWf`$kYRoREC=#cQBFTo~St-4uQ0w0J5~|VK4~Z zwFDkmMy(k4tu3wjqI4DUdHk__y-_tu1K^|4NYJ~sytL+zq>xjwpl6i{X3F(iJ{k0S ze1?%oFc{0#+imVep<6*99`d?YUEXLa3jp{IZ)GZtMkyHy_yA%morI12$@1p*W;IRw z2yo*?&ng6=Rj1-1&-&V$H=1PynJ9BdvL_Nu#^XWJm9f-k@xaIZoo zX-2AKB7QGo!MgQ%V7=DnrY4Aj0I{hE6h)&{E}vDe#>Uk;f-N46!1F>zzzZyz?PeJW z(kKg$GHDkqNe|gX(7n9uj^=BvMky8Yc>z!^p8@RtXujHPl+w{qNHff&!s0_$kWMp# z`qEk;Rc_RaNkon(hy+iEJ*&&!c%gx?iib4oL@F8et&6{;jg{0MQ> z2P|RYFcI;uFR!?ewYgNtwYabvNL5=K^=#DV_9Eo~J~N7>OATacF_Qo`i2W2jiuyp4 zd(9O{mg=oWIVY4PGdWgi;4IhbXrWvN#V9ld{XS+HMFJ-g-ab$cb(X}8sOfw@ZSaOY z5Vl!KHeIQBge3t7QFjR$j9f&2WMe@uilQJ*oJBnI1R)=Tdt(w#A(J&RQBgPu2}oC? zmrymZYbuSx%jE9WGY>Lq29pK-UXM2z&sFNJdO3&WPG*=^EEI~S3KjG)mzE<<685`M zRbgZ_SdJtz1wdh|Z%ce|Nt z1$}@5P3E*f2rd}UI^fS2WCb8lLafRaN<;g+8A3NR*HVU6!RDQvtrnm|_yUv&ietr# zp3kA0flme=L`p&#V!J3JIg-HW!i2)Wildz&2Q+pJ-H$~9#YpHP@eyY0!L)=y2_BX_ z&(TdVg6?g#n{~7CL`NxZvM@w*MoOB6<9MSUWP+5f%X5A5GF> zE}eiT%yL9&Cru6%9Ag%W1QD)<*(G19wz*l)qSt~+=se+FS#rnAo4dQ4b*6(2T0#FM z12WDKM=acjoJ2U}Gx!v!bxdqJ$7p2!3ZJp_wxxd8{gkHjgDA1)wp+Hk5Ao64^rJ30MMiSgrHL zGGe=2Dx@Rpi_{D8YLN%LPrT@kk6Qg zGcy>%$d+m~taL1F5RZ(N6)#Xq)|sUp_bg1$xgtf(RrH)cfbs)nUbjEaEqomS0Mh_| zS%IFlHBUgoitZQ=Qp23{$yh~Zh9lUowTh%7o&>NLnP4*;x3M~$0l{%@cG;g|Rz(!2 zG`LtDah1s7Nj2d#BT{@1Y--n(D@)YsWhJtNh-Ih)n*nLdsz5Lb(w+zj1UP?W>c-=rpQ*n zZbH@?8fwR{6N%vPRneW;=vmA{_wouBd9~fH7m~C|WQ%|(90(F3(QQtp%|dKyXNEH=U0A*H_(DA-%CJyOX8XFwAA}CD z)Z@^0AsJYipIh=LOSNh~j)#TCA?4@?6=0`=6)QGGZbC@74cJ2w987#AnTBzu9rUcN z2Q&4p?af*#53>Lnv_>oh`T5KnK-yz6l&fG`YlTIn_wf9&X6t21^-QIO5i5&DHZ0T` z_O325P*#?!4Dx{N?Ra1vb1Bo@IXu{ImceqqRKsAF2k8lcDara^G>unWLZ?G9IaFd1 zBNsJaX~?}yBycD;wtzolAVrJ$gnxN%ZZ%rm*xB7E;rsfbCd@W1DO>C8?Cf;f4Pp@` zAc3YwfP`fDBN_o7;R)2Nv_n=lI133U@mIJB#E|pE5THGv*M-dXuT-dWBpE8riz+7C9728`|ora9b7;%VV#=ok-Ei1&=-j1E9fcz+Ik>e z7vX6nNR(G$Od=pSkbqb58pTZV$&l9@!27EjgCM^U{9QRwL?)uOQ9d}OnPhN%aemPg zD?q|IY!{{s;S;TZ#E=r3o6QR51U#F~r6Ybh{N|%0!7=cnXcC-C95b`j&ELVZlK_;) z$KpWWnYhHf_O9W<`{KyW66PT~0a+_oTXY2jqJ?bvvH|5g^p0F`20SKHKd;`>vD1^ubU{f3?h810Juo@yc z@&HkWxJ*=pcmM+4TSwmu207Xdqyk0*JQ#hK+L%%rhQCZ=* zz7{Va&f3}C+iBzIXJ9E@nSk5v@%aM*UjPw?VSpt7lAt%jjuvZ8xB-MQe-Si*7~96}SqCZpDE0u306~yY1kytk3(SQ|6Xat}DT;)pYL`e@(I~s5 zYh}aQ9lML`$N##g|G$6SRj!!bUSfAxR2cQhlsw+eR=bkH3sc}q8ew_OgHyR~!~);q z4nZu~VEApUM8b1x3*%Z6w+Jm+AlL12ue)4CTL?wsTBqUwE1`&`)J7Rqh*u-DV^uUN zgaR?~gD7sd8@UJX)mgkEFa?EuQR1cM=Jrm9a0FH{%n59mtv477`f!$I+-$Te7@je7 zBx7M_#k1As*7nY39qWvEJ))R6ifqRa-kQr7%^?|Txr7!HPhm4CSf0ah-`YgwBok@e z{|W&SSY+MJ1z=FHg!~brq#e{ird+u$Ho+N9C9|>)(~6BiDl&Hb38atK7FJ}JShpDy zMOt*A(LC;-#*i0}VdU`;!}UfK#*!<|WZ-U_6~T$t*7o*BHHRybEmdm;bOI)&$E!ht zm`V!W$;oG0W_iajYBskz8z^a{cn*7*=)uzRn%je|z9vD5NkJGJJDMONa)6*uq1Ntn z+QgNl0x<;Q2>zv2m#%ex9FP+oQ3N##ZAm^8foR})bclDS(s?9rDTSV0U5BmwMia7U z3rfn@cDR zCGwC7=_gsgV%%CO9YOUNc-^=FV6}mbEYC+RFxxR^n;V^tCTsxp=7}z0bbt_137!Pe zUMwe|8%B|0z$rw)u;jQDMwFVZRFNkhL_DOp?iRT>TeVy~1S?s17z_%!tfM8b%G}q2 z;-4$4u5~bijV$e(15|J=K_1Bffe*HoX9ILG#Ava;vZN-mG_co52%&6H^rQqlqIM)! z2l0+MYQQaJ2@NmNVh!dcf^JR*lZqzrLy=?3!c-u(mV6R~lDzDYdwF4TnYA+po*`y3 zJczDK09!BwIvg1XNkdjuqmnK<0KJHSc_u8jK;#@TZ~npV{%!|BYVK+s)0NP()-8ic z_+y0-sY2PvZ0<1xnvEE@$+)HrQv??4M)yRsa1>CCVn|`Z#55~73dyjuvjGn#M2YpH zXm?RfWKT*x7Ns@~xU$%!Qc<|uX1gach@WCYEtUZ(Vkv+RVDQ6f62)al3dt`cIn^PIfrE@!kJXM;Bqz17yyhZNqLd&} z1?)PhFtn5mNx?&8q6j5vM>0n-<%^cMFd)>zk|0q+2?VY5`fTyKn??Ay6*( z!T2Id`k1X=+t}GZ*y|wO;}XIf)pS5IjwS^B4TTDqO5?~P6o26QOO}w5i>Hc&?Mn$( zKEDX4F!}M15!A|tTcVR7cK~6bU_qye--=!%Oqj=AT$mTE*0ASG#DlSaP1h=6=?$gJ z?X5j5xdwD4Lf&lVBg9YV77&YwjWU`OOBT6AxCY=Nyo(J);vSM3*{&g46#>I-X>&4{9tZ=etv;8B#8x7DMU=3M3Y@0E{(L3 zL`1R@^i}>U>RlvRg1jQm2ooxxD>0290n@@|#)I2i?P@-ifL@w->zDv!M_IOF+g0Tw zq*!F+c(Lyh(>rLWPP2^LP^#ku)X`BG$m<@W&qS24mJ}*e+(MxhAXVMi-P_yQP%IMd zfk9WxkRe)FK-&VU98owW6Ohh?2tX`(Q!KLWo$U_tAR-cLwaZE0^8D-^;)f|9RS9n> z{E#oot6#+9Dz#y9X~8(91C~0Axff<;<`$RG(4i#pZ$-kx%7n$d%kw0f3XQG(y}eEY zy@jRI*l3j!p2gXj`Nb8KIvl9XYYf{Ulg}}$<>mEIw%*x4I@oCz5`-i3Sig;2h`92? z@+#7uOby`}Xj)+^1(jUHMbp*I{iCD(P7R(#%##PKbO{m3i}rN%FOf}z(SY=2pcFy=6Gl!GN~(`Xs*6eW{Kq)p^nEdPF{E7nPTU$^HQJ;uJR;`>4u1t@Oj!n*pO_ZWhj#{Ze za>~oZHT@}?$V`^ojCerQru|Ek!^7h<5E%B1NiAg$NhvEeyyA@&Fqx#Gv6~@!GI*tg zcX4`rd~%j1R4vGgRnS=}=ztrGB9MZm)enKq(GBnO4U5Fl7DQP1M^v?vVRlL_6#dm8}Js1mASQiwy8 z6I1i6pe3Gzm-aUB=s+RpCo}7d5{^6A-`@lIs>?Fp3VNBFo|;`+^9GUB8*phgBkMYZ z7izK?#y^B$WOB($t2Y~k7`YFcxV)sds>Eiu8o~>9HaRbHe_57)dLo#Kj~Rtn0Orl? z^vv9fES38vFqrCP6m^b+N=ZsQWCg=9Rt(DHqoWhE%fv;9q-+x8z)ErZf)raUEUbkH zYQrw7uE6d_yq1dT!1BbfI=mn3cS%|o1$A*T+ z=GJ57&e7SCCWdVs%TVG(1UFgQ*h3qW6QJ$^%f7XRat$%c;Khxe=@AI+6aB*Y*Xr~&-P+amv$-+^4<^ff0Xdl~?>I%du7H~Zqm>+)j=<&d` zC(}MS*>9#j^V74gP>T38;U6CwjC{!!5JuxDz~63H66-UAJx}|_mSWZ2lauXIcx7&u zGM9XT@;lW#H8d~eaoVDg1ee;y@XEyVp5DP(UvBI4;$$=9Wm-NQ9GQBE{ZbnU?{(_3 zCS~_^HmfP`+;D%-i%D0yeRy%YmG^5}5ehpf4kD_K-G*H zW*PmCfVGT*7Eyz`LC#B#X2b9QyInG38SgtAxBQos@sal#DMz( z(D13Y^ic<1A}sTe4wXics^9wyExx11?DHFmV>0pNCApAfEH`t zX&}{TkDc3;9Wp-jVtCeOhAe8EL2=Q%W;_R-n#M%K3oNLxUWK<|*?cozp%$qvEFEU_{Y zg$TPWeAWNtQQwrmxP1&KM%LzM7uKy}KrueluEJ?D88EI$%TvY|T$vnr^0;^0mDxNz z*=r;`q~OR3#8f>=tPg7lH`@~D>AB# zk6e4RkVFBOTU#Acfa|j(&tHr$N2&)Gmq+ak(P0!ARvx~yA~vng4%CPkiV+dT`LE~I zqQB?)6jJE$M@RwdyjUbf=K#KT>LeAU7#pH*l{b%s)%%VYgLy(3GJ%I@j;L4$zu$|`m{ z0}wZ$j-}SX55p!PtBK*MIAGW{Gcq_dwVJ5yo}L}FviRh-4&2ldu6MnrX)!OV3-LKr z;~Mv^OplLEuSLt-M<)mELX?~yb%_jt^=mB{q)qhE+!QjDxhMwl$jJ0+q}16zMp7!V z2Y3lz5jnw@sgNo}ttsNH_!#lCzzSCPi;0zJW#{;4t4v@D*UKAFjL-7e6xlErl~<6N zBl?n$dFDn3`Ua=nsXFY|&ZDRCBUQqn=M~B$0hbk;$e+it&L@15zAwgCqvg)Q;dV7i zQf|$o77A!m2|$H7wJZc5h`Km&*Pv@=bZB^LHH5Ty$?(9y=zOrad3d~APb(#W#g1i5jX_o06;v`*L^x<~0Ut2^i_lI$cw?LwRm;+>}{X%e=;^UwHB-I zUtFDTl@m&*sXl}jM2NOF+az&F_9+a`o(zoO@Y=M-aA(@bm&k@ZMxdKANw{2=)n=Q_ zeFIP-SS>ivEGOJ3>E0JJzT77Ay;BGifL;}JHAbV^1R*MRf^uo0*nK9jfHLeITa7jL zPfvGiNkFwouneaQIY8%SDt%N;MFdXPe!UP~n|j{!YyhRxIX*wy$P*RAcZN!k%u4Q- zsXwX^V5ek_`a%;WizB^HdPd>dz4NoZTEeqDPe_B9uF}r7sfDryK$<0Yk7SYGKRevp zgCxm!(CHh5T8QVY5(AMmW71S1QuspFp6s{k3&V@#R$?@rxP;ukn>}02&4pLSwE=OPzXU0cj z49dY&=0UApsZ90J($whCsdE3!U2 z+-J6B8)E_wVO8GmB9lrM6q;mGa;8;W$nF#VPa!`CLHK;IKo~^&2}gE%b^*TvBW8nj zlW`zDO_-y=`>On;#c+TB$h<#??Y@V5L_}tKW`QySs&W;O7fcy~b!%^us?65sMh5zZ z<^o0N_GGJsxj(}g=<^KDGWIb7ors@m+1T&IZl!#}yD&1)`(oB#*gk)GvDZlXmI(7M z$?wJ3MX+qv1R?}VwJI^!sH6i+<1Yq=X8pyTvsbUqwu;g9MIx%KJYCt`J2^SpCd9#P zw85&ZD!*z@R$uSH#CmGufn zzc>=G=BB2m=ZQTlOhV03Rh74@&{5?cn#1g|C;g1k+!r0Dd@HjGUo8`=0*G zO^fP+sS8(#$34r+2S%5|<=xYZQ{)I0{e-V5|HqTsJ38E<=%Pr83Z*Y;g3FZDMph9E zJ#b*Yb9!}g*j9{ehOpWyRYSXHR~JX*VYJ&VN)bOHfSrv}WO?}6gJ1flyrsRX+w0?I z+P5@=Gd{BtNH_P-ug>Sl)m6=GAd4?VTSV85*5l z_QR8B7pJ=f5D0TB*{oCp{;YR;;Nefd^v?#$``52;)M9aRbaZ@fEu7ytJij>JQLI&k z+4%NY{X5NEU~%}_<0k{O*t>jld$z^WVdC-Gl~As|hd;Kzp`sfzWb62DyBo#Gs_e?% ziS^9p+0E@G&MKOkpvs~*QQg8_Ik2z}(?Tt)0%WV2T%Q_v`18Yoxk%&q)!UonCT`ET z`Mbef>)`C-WS6Dm6saDqhC#l|(x>|#{No=_#@F+E*Kgij?G!OIpZ5=p%z0Avz4MFH zy>^KbENyKd1%mS4D25h?9{&ArKlUxe+UK`#Z;zYF_31&3?8((wW&7mn>I8qqLKcMh z8{3CRd(G7P#Iqm&_CwEXuzq~|_Krb9BIg$q%fbBS@zwRkQAe&VgQ&&v+3|KcvN-hk zhkrgCTFq>|{P5}ZX*=ba85xi}mTn$i-CUpUwQyT0aEXcmj!*VmSe23L}smv2A3Ior&7=SQ9ojLc9# zw|D;X`ut$S2|&VS?R`wPjht_G;Ng!y^-c#Whd1xuUGG;R=%E)wghoKg)vIn3AK|2Q zmB8!iZX@NM?EU%2hc6bR&C}a=Z?ELCO=AX5F46=7zGCr3E6udXK1@?fxW;>b{^6JB zi;>33>-Tq;+l3IqwYP6%&X;K&U*AGK7!uTTuLLrUeF$N@9Gn~Y>92o%Ftn2HTz&Zb z_M(&Z5K(wGFt!pY@0{PfxjyZbWZA6{_90esam-q$dVl)+Kc7zcN=L6he!4wwBwUl? z%^B?MqnB^)UY&Fb5hZB+>H5Lt_0@4JxieoMhdvjEaEDocyhp?J= zU%vnK!>gla%BR47sJM0Z>gMX85}CJoy;#od-hTeqr|aELhe06~b2bHH)6UyZru zCa0GJh0e+K&BbmhIMe&XfBWl$!PV^U>tBEWc(tALObtAF^lW%3Ts^pc|MBi(t3W1V zYStAk?VMk~!s7}|KmEsl{p;g#Px0{X3r#xdwXvRG9>Sif_Sw5%e|>Y>N_mJA!#K^u z>({qun;F;0FaP#m|Ne9)+&q8(`)_xr&G^zt&%;N36NuQex1R;UwULSGTWD zTgg>;>)(FtpNqE6-~aac_OKFJ9_@Yncwow%-Z*~)k?vQbgcir=ys5^)<*Up6dTeFn z;XnTNQ~yG|eg6K}Pd5kE@Zw0%qsRTz-puC3+m9b^4r+1t+{DD(dWvw#?JNBG)saVk z|Lc!^^U>DDhu^=vJ!>UaMtdIo(lfr6-ns&WcdW%dJ34|9+B|-B_xgM@v#usTKVM30 zTz&lG%UhNK~DTKw3^x=%+_7 z=EC*kw_pDFcnw!Cjtyd7Ww$Qw-n|0(D}xXI_V-64uH4@1-+ur6`mhq3MVSBGHxsNJ z2)EaJG#TyhA74w>k8kd7PTOhM=pz9c0e1E2k1y}eTJfc!M?d`V81EWh_@d<}Rwo8} zpU(tJ`>*caTx{js6Hou~Z~u5Y6{?-wefi@91hYQ=_@96Kc|cMS7{0&UOs`M$KN~Qu z^X3lm6PWJ#@ozt(RI0~sfBWO()mCPG{OJ#Whp*#8?(ZKif$Bv6)4oY}e*5a~?aQ5l zf2Q}xzx~q$(%t7TA1=4D?(t_o{QbeeLb!4A_BTf9WZhH!&w5AKvs;(1-(DY7L-Wrc z{PV}Blm62F>(74}yG-}~_>TwuAou+JAOHIFYOeroTcD+L@#Y;g7n>jW`JX@b&V;MS zcfWpNEqU)$--Dl?3@GI5W7C8#g>MQDSd_Q z%eNojzob{}_h*B17&YhDS4XY1d$Rx0FFj*x@y5~ho7b1fJ(~Rd3zVGiT;9Edk1OE? zqMie@{yc%Hi^FDeZM^4~pP!AbCL2eu&@8*<;OxLJh}$V|Zi`XgUBT-M!!%JJCzt1Y zjihU$?~!;g**dwtyFK3m>ixg`{OI{?ptyJa?$g`L-C}T#I1@5TMv5Xj%VT}S2Ig@B z&TnsD9<@@4+lLQ(#_8kq&8LrVPTR?~$$=hOLX87C>KWhs2r6-6EmqwVICiv@rw^YF z%?C<**YAIQcePXS&A#aA!xF0OoG5l3T*ew6m{lvh1*Y`KfXe$ zEn}Aq&w7#=)jJ#Igl}nzJjODrX6FR&uaS1oymgLHG4sgF!9kY-lQBcl!KY~{uRu5S^D-6%#~aM}=EH~A zunw8zS@L25wj?`8D^McH<|XP~C^;mrN>RoX+y0_h5HDZfULS3keXu|#jdDY3vB?Gp z$X99`4_hJFD$LG3svlO^_SHGMdiC;bn_LnAl?NTdVrRoB6}c3OQ+TcoPlRNAtMg2n zt>U%qlb1I)xKmleOB6}5$)9p6#-QR{`Ay<0RRS*L2-cS=WLTqM8!PYT=H*elpdBD9 z_^KL%Xs7;sC*xT}Sd!D%;00+4dR~!BEdCpPM%^sL2IWChdgfI7)&N68y6j z?KjvuW>%MnY_1@iNntsKqQrS^>$+k(7Rn%w1*t6&jG!#Oym|8S_Vue1dBh4xDHdn- z@f2DrLPJ!JhrYq0rLn?2SDtK;f-4o^-M z40TNpkuF^D=QhJuI*kQKnUg^X1NLF|+C4k37`WsRjE*jVtUo0o@(V}$z5 z6eKXM@GJ$(tVOkv3fFO%3*`u-lk?pQr2p8zvLpR*%SHj^}g(sX`6i%jz#6*d}% z8bFw1Zk2kd&gl)z|Lfi5z7z%QPZOjlF+`-KRX=Vb)ggM?~a%^O5deIvzZ=K$L{QTReyGugf{^gnR zVQL$u=2j6dC90U5;t#eQ0A_VZa4MK-9=v@2`OD{b*QnyKYYxftVt5?Bf$wWA%7s+P zp{h}UGc`6c$}n+4jxfNNU*EnwXpxMY(=fvm^XxNIHgjkHP=!1c@nXkJQ;#z?vr5g~ z*6GdrUq63*eZEV?Zh3laaNs#rS4$Lut7dhddLasxISpfZW^9=9iW%)-?VP-N`{Bde zS0~VbcVXg1-?L|ZFUDq9sT8aeNIKfzX|wm(w+b~sfBs@*YJsyqHjl3F-oL+ldEBYQ zN#PAVeem!}{|Hl1F~{NY3Bf*UZx{x_)c<@$q*kU4eA%97HeqsBk-i*M9r;-Aj@Nih4eK{OHL5RUuRi?Hr$9T$~|d-Vu7EkcdX-XD6z-5E+o}>g~t$^pNYjdjI>s|Le>9tG!xELD`27 z9`+0hZWJdSU%Y(z^5U2kDW*Tv-_tWNHt$VT&;x(`kN^AMKfgIer7uqmJbV1Ke+2v_ zimlz#mp5;2U!Cu7mf4X!MLq-1gr$~uF5i9mzy8Pn`Q_ckP8l3!BSFp6l)x53coKYsuG_G*v1ilvExr;i>zW!^k$?Ooj7y?yiYc&m~Mtm2*Y z_Vy1?Ey(~pz4-{&!Ku5@0?F1#KRgtnu6fekPoDGuaZj8zz4`P77QZ5|=U*J_{pE)r9-{l!CWeM-!h{ovE2WO@gN z#uwa?eCxpE!-rSL9g;J1!#$54JbLz=FuLjk;fYhUxWu>9KfztN7o-de?jb1z!t$6>Us3b zLmt6XnJU5Yo4YsHXL}Uxd6y;zd!Ih-p|H#y6WoztpWh)~t0}+n$HT`xFD5uJrHGGm z_wL=BD;{M4{K&wwr_TmPXIDcwJZG;zAjscd5DbrD6!kxO`0yzl#}pfTXE#Jla8;=5 z@ggV$L`jzjA>^yOPrv>43HdKCaEg^Zc-T9Lv5ELSyu5u2H!AXNENm+i6pI^2uL$&D z1s!2IkcjIMJNCogpn2!?`t{p4NEqtMy~~q>JxE{}(vSQK^T2eP7_`AA7CoF9aL62g{e;ayv*0St3}@r;5Y=55w{PFy-5Alc zH0bvkOQTu7d2ne|_4@Ka?&|z#-;+lVpFW>}K+pwv#&=9|ufY;ZxLK6wZo!<{h3-udmjkDp{c)^lMJ zl6_B~AbV$#%C&7Xcs{*Vvm~|h=sNVt5HeO({-ki;zrBGbRR=QGN0&XoQUQc!Jve){I z-n}~0GkKT&eHb5eYt+a?Lx`ojSLYh|^Z1u8oae~>DD^5`j2X2IriDhK@H5WfMNY7EvH7{-62I1Weq_U_Hi z1$!wdYMCE_zL3(Rm?6}&9}; zx-_fz9T+&@2h8ZQ!GZo4>JPoWe|hs(TJA)(dDO$a=mn|B5(Gc7jvM^sw>N0BY?!z^ zuHER2w$e1U<~!**QIH>X-%nj0U9J#W=p2K#w-9BgiV&ZsB2sp=pZffr`^O4ZohG)?i?v!4Fp zNsbqR4v=<8R`Q1ld`6;En7^EGNFeR#;_CX6%>s>LDkw7-gAsRzjT*SOhZmQZXVkG# zv4Ab902TMChCevJdPO*B4**6ybT`5zrtrcOY=GH4Iz2sR*G-N+z4KG-(wL!GF-z(D z8B+TC{0I>eb}!A0kK$;d@7bWoM$#ReJW66X%|r)9PAP1+=S>j#nVFuRCn#n<7+#xB8PE}6 zY_HdDV{N%nEUMMnJHiOw>uAp$W$P}YL+oPEsYB$-IqQU-bQJUJQv8Yl78Q$>f8e6w z3bk|q3P&&Cv$M;e%^U10=D0;p*3qVFZJ5ykYn0Wo?}7AtmgB+bRL3Z>%ZGHiw!5-< z#V(E-;tWPVXBiMCr{!TAQMG?0{9(LQ?ypW1uvcHecGIt;7o1 zzz0KdHU<@v?24h0KZz(x<+*(TZJ?k1vtu)CfL=C~~ z1Pt~-DR4wUE6OPaRQalvvlW6k7Z28n+o{w~=RZ)=X(zQ9_!S6J?3c4si0eQhw8HJy z;dve=Zz$#bLKr~1nK)7d>gU8|mP(w~4y4fODnu))6g;VN0P$CcWgL>|Tr^^Hx{kV4?TwB>Q%jYoQI1UbrK2#9&OfpG5uM8d zS23o}jn&B_f{D(8*48_n6$gVVprZ4b+4jd4Se+QnObJi1K47CLHC2;#{xJuDh)EUd zqQaD;p{PjH@hrlpg7HEra29DQh{S#Z9l0#lR>T^?rE|vE@XjPT9aBebX>yDNEJf&$ z5$8#9+y^-ah{U4rIvPQRhz@0`X45E3ZPZE-MOLXo)kq6$Bb-ET1j@h~gtbEv96NFq z({wJR2pC|QYDTs~W9dvi%Oxn>Ey99lv@buV;HlQb1RWv<5AY7+giVAxJ6O`PTL@3Y zMB<TunoKEv_Kuw1dnot3DV9H2o%X}o6wT@ z(Y9SUjlIRNnG#B=1t5c z_H+OR<^_9`q!_iiivufkAg2;aItInj15yL3H`IW#T!aXYPJvi9jij|%ugKvuGOt!w z2!X3CSya!N4b;9;b;YcF_zh2zw}28nP*$Y^2VSN4{|^ zBps67Y7kGwU^_ly7rD?UxNwRzVR{5CB&KsSYRFUeQR^H`lLNp->)SgxIy&YoH8!lX zy_#mE6G6L6(o&k3igvP}Vj>xIY^Ls3&9VXJ=;(kQRtheYXrkG|0!I#r9~ctKuTim zvb&d4gjSaq=TvH`93;CGAPx2p>-Z}jrp05W*Vw8G(;l6iow3V!v!>I2AkI0J*;4$g zX7HIdz&Q2`5`;X(3WtTV19qQC>*eM7iFUej+=vDvfImZduJ%MwvQ3sm#~UE7+-u7i z+?<2W-u;d<97cLWC(|qt!eNuneE$OmEgXnd3wxVGBPYn zb7Tu9#~<&x5_ln&sZMbu6IRswYVtS z7>=o-({7~{9McV*hXs$lsvTx~$7g5frzc>&&dFh%N}yviILn0Ma83l)g+szYVY0%o z0T3L>sZwKWmsI5G$uSNLY^0;nS%DHszL4^-I@t~bUk0YmEp_|?Q7mlaa67xGsjehd zFIFH0CBH}sWnCy|aV!gz+F$r)t)F8e06ok*vP!wH-Z!9gOl)2Ux*5$#9UDXADF z(!n}t6&df?eVC?L5L9O@i}6gOh{)IsCEHIbN$E`4IAUd;#>CEv?Hzeq(kX0n$Dl>r zie)kLb-cDbEHoM4X{<{sR60eLpC!0p6p3R;Y%)Km=E1x(`DGNV>z{s7Q4ZB^V8r2S zA?S46sC22>m}YZ=F?5n0`U+@upsrft6H+G*9kE|SKAN@x+9J>c=A@~aS9wZkN7$f( zoB3kOSaE}Pk|44;A_=OO&}3A>4y`G(h-|Q_2pt|sD;ZoO3K@=@8!|aL18-rt{Ss6G-8GpwAsZr%pmK4sC+SYlam-nu{!f)Ij{xC zsqOtm<0u`|E%c{@88BHCLf!&79) zh>Ru@psGX$9IDz5$JPP`P;5M-HS8Dpy_{~KQ*F!!m$@WA58r`yxNEq}s&rQ~Q#aZs zs8*clA}NXA#nOZe{e=nh>Um9OowgT2u!4*Z+OT%ewhsMZed00!(i#GBy$HT^hPlC$ z;S7P828un%LD7+~m=y4)sEmIaP@35)RIpj$W5?l984X8);zp^RcFbTKsG(s1z(RE< zj%1JM_;4X!3uJE?&W29#f?fz**r8Cu0QEnjZ5r|kLfK;p2RSw}laNu4{)W&XZc}qI z?esq9HE>zj0`AZ;jotG%jeFr=d?FIf9l28MMl(M}9)+#URJ`mfmWV)g_9(!F`k%9q z%qyZDWJ+RN=i&o0$p|LtuoV+$g$mKwo(M58=cJUFsWqde4)}xjX|(4z!7>ioWs5VRV$Udr~^M0U9h8CWJ_tEq47P~C!`=V8oGeM zVq4nFz7tYJZ3a_8lS{!RLL1-6P?Neyc z9~01sz(y062sSLXB-lhaGOLiKGSC1mB+6_RMj?6ubU3w2f?FQHaHHTFu|9SMbYN#+B zE|ZO>rbeo$HoS#umGVf+?>HMpAqbHwksCz66aaFZJ$O3HnP7uM=+bOBLxK)Fpd6Cp zWHE(mI6cU~DHQ9z$T{M+GF~(we(##jE|plu?6czs8Bwtjx#zMT0jo8XydroeV+q`2 zT(96)n3SYaN}JPc=a@x(WHKo1BSTPxCy!np2Ncc$kn(`!kVsPLPwAjfvEekFP=>5D z@W53-M+ajI^WffEie~hS`Gz{S*pMhzM#$wckhwskL=OJ4MJybJYMzDhiH;Lg@KeE4 zhb{RX6PZ=&(ymIyEQ}XTe<0srNCJX57}Ul&l!_wYlCv+;VLKayt`o|oiTGc^JDt{p zAxlGiYbj&9FgX~wO9BneR>5mU8B9VF7?&vEL{))@7=Yl4Lblz7nzb0jp;jao8$0!f z6&#hwu&|gIQ!SB)1QgT~cO9&#C3H?d+RDprXH+Lmp#qtsW)}ftg4GzgSmHKaS=GP@ zX@GRMbJ}UEQ@eCVm5~o%F*=uhEP*9c9P2?;NAC(MDMF7+z>ta>*!DCy1p0wF;1T}m zf$A^_+a8bj!0Oa-o*04pJ2Hv}Dt^V8 zLP%O{atAt+1Ns9vj%1cshkGXO((z1MB;t-yWtExQlK+j!(mbV`2^H7@+m`sCUbu}G zA&9Fq1=Ow-hM3A!2M1L5iL#1$_A8SphSU!#u``P zk!dKi1#7@mtl)|Rq|1gv=}9$PPy_0L$RwCeJ4>d^hK1PS68k$D`ZFrhzK(8YP!TS! zIDgONE7e()m@#dKt^IL6K<)^27=)Dywz3LQ?OLWb)r!m!h_Zo9e@e1frA(ka5i*mN z7BQi20WDeA68=!SLN^FtsYP)P$NuZE1BpBY3CN@&=MJC;=o#vilyVx1q@}y$bLWZs>ZNb}g7DGz&f@^+XLq zrY=yu}3rk2G4GHOwEMmYA(?@nGA_zKw1Fy&;voRgP&U5zc#Etno0?L5!2d&IJk%K7Hn8!->XonwezNUVlK~ z=nqL9V@c^rhsa?e4r&xN8k+RS*Pva!PQU>^!akyF880YQlpYyx2_KP_SXMbF01nuc zDHL4+Ik=C7D2T*bB%Br1GegHL0E^}-J1KQTQpGm_*L#R=}h01ZS6&V;(tH*!)Z){8BLUIji;h)vP{PJ+xw z`@-Li6*jmCP=1BDz0SU091=47x1YLLsn?AV|@Qc)}Jf3<-P&B+bhi!s*cZ zwKmR(^lNjp(SW4^6w`ew_~N{rRS zqAbQ{$1UL~YH=3OZsaW`txKyHs_qLGK$(Lu>q@;?PtMEE`z+VSz8_yG;WD5yZGm2} zbMEq{$oAXy?K>2&5SL)xy@X|91(@0b;We$z>B_;Jezoq^tzPU7qfZ)X*8J<@)PCW+ zF1=^+%U;u~x~Z=3yHpRlpj5qW^VT!Qapu_l1v^Ts6=n^^OkVG(iPqs@&iRCHb@8q~ z?CmaMMYHz1IA1L7yk}3bInM+S&D>V4S?F>Wz`X4j;NZvrR?HIv zl0NO5cpF2;L9@Z#fS{M)2nh?GNpc&sY^4Tf?uo_>-o{qOOY_ zDfP-AMgd(^+EbIe-KndO?i)6s=IktrK8z~FV)tY5!~i1zSl?Z8>cYr?We~B6i}jqf z>$yP6b>BZv?04~tQIF84k@Zi&x2KwneYpp@p@lnNo7rQrnZ7vh@~n$OXP!10dv5G0 zIu!DaFl_oK@UU?!G1OG7MK2 zR~piJW;egBT%FpAoUwUo6S9W%e?KFAs<%I1>dT=-J+r4@=cJLpe_tpR4*91Kd%cSZ z;mUa9&%Ns@kHm0#%>Qc2JwEjNp9w+ls)0J^o5PK|>D;yV?WWTow{0TUx$bu_ntq+d zcT~qyr)y{CLWhv>?Om-_H}Ao0kH6u_o*4q{hrnhK>w>G>wEJ-{g!P90Hw38xy?2|b zo!!tw-4+_0Ip{X6bk8mg=)7yMSuf5lyKOkKHZ~#aq&uvM9|s!N0WW-8Q5Q;v$L}D< z*L$$(t|5yb-Oqb07^?0G!f<8acfKLAb?F!3$l4g1zP)HK*bnDjy{e}+5nGWn4W}2$ zd}k{5Toe4(0S%qI22d@r3t0o60pH*+xH(W(*ShY3su%B(V9?c@-+=G1ok3iU?9u&W zA*$Pxdh1FC=T;X9y3Y;W6Y%X9^`gg`gLBJXaXQoN_$K5!6T5F?@2VT86+bm|ElTsX z?)1!Vc30#)u(9>XnmTLkzSW(F4ezwMZ?B$dU~{_fz!pFgO+c3edLh|v*-ajG=K|)1 z_OEzVgYW+FRSiU3d^o@8cl~ca?3q2%o$hP;=DhDb(ZF`81C6cQ-#+!odBxVF-vldr zO<)rkgbbUrO-KE7d+CnQed^r&I_lTg?2gvzEY`l+3~lAkO89F3+bhmPHM4Jytm|@s zUe{gB5y4HZjM$xCohN$50P;;vs(}L*b)bIL)VS1fe7Y+#5Pcn4U%G3(|0WP{SuX

bhqd{7yZiM1quVdPe*4z#UvuK-_y73C(82>fu}+*;)vu}6q-?Go|NJL}Wp!TUL+)txBRi`2Mji;RH-cSD9 zXBPtZaJol`eL4&J(~7hP>r&%&;n4lkMX7G8q4TL(@ryHWr=i2fdcZez=D_Tp=m{V> zt(_j6Hr9*NuhX5HsbA+`cOv$o;cfQcJ?hdTckJo6-tJrc&py>gm$mBtaQfEp26Sg0 z-BG!x6T@vVE!=_FpI*_M4qA*(w3u&=)zmJFZr%UFr-LK?{EoSd_Z(t3UeMDnH}aa< zCc1zBTDPUxhr4?044_x+vM)AtvqkGuHw=G#bBM$qJ1fzWxOhugzK4PV zql@$IQ~jn_^tS!b=XVWsvpcAD=Zwrt_k-zEmu~4l{jg8xj!jp$^u+!-51mH;zn^-= zuCKjVZ_eF&cyxg!uy)_=Hu^Kf?r(krM)mE?R(idy;-TU9ZG8H{_ZhV`UW~(W) zLVf<}(qi@0p=uUxVo1M#rImY%_zwi(P=u(>+N$&Jx9`B`096mZd;KeaeQ<*|`l;Vd{21Epjs)tTu5WYcPRoFx@Al8YW&PWI?i!Zw zq1%NoV02*VpyfNjc5fS;9r92IT|zMo=neawFMQqu+W`5ex!i-6Po{={WJ_@(kj|29 zh4-tor&_pC|5pwGA`SxyM(~j0Fk%p~lU>GF&MSO%xJ6%dOK<(B*H=&B&rj8@wXrds ze8+ch*r;EB*Nd8gW~eVL#D1|aU6dNOY-L*J*DubR{{vBS^B&M${2099iF?Kn_U_rP=j&po3C?mD0L_?{b`yWq)QbMOQ< zc+;Xq_c-U%PzgGPEQcES*(Hg4s#BXT72H2DvT=S9aXSC>zVo%a4tjM6!sgt)$%oyv zUyV_mI|7s7B)AwzwCoAqodo{-nFi~KWs<_V_c2T z1cej(#iscuKcGw2-xgu7@B=vLtHGHcUEm8n;%UK9-}Py~*;fZ%U!UHCzT1oSsrT-` zXbc;~#&Le!|IRbL)}29jmfer9@9^|~{#u|dLZ98WI*aBVzDU+}v0@l7H`L(YsYF$}3)`2q%YiM7)k3|J` zv-{*8{r35%x$76LwEItB(8~Es%iWa=Ub?Bz?&ZMJVD|m(?;krjGFegCQhP3Mk*?|T@2|J?z)u))BB!AQSqZTe~7yFVO|+w8t;_-%N5 z?f!`~m}X#?ct~HqeTuzw!`RFrY$MLEU%!3POZN<7g#L}r?craju+z3d{7P z7%B0e^4w}R=yw>{ldN=ayJh7)UpGID!RKL4AF8F$$nsJSmzSm_{)EgBloQyFS)3qm zPI$UsAy|Mx=9>0le1F_vTNqO(siOcC6$Qu3Lk$!ID^J1Irs^olK#mbK?amV5zhR?r z-uaPfU2qM|{J4=l8IsC>L3ja|pE2Z7u&ImPzXih~dLEUnzp~0K7MWek08i>b51=%F z-?nI^#mO%+#_5UyOm%)2r4^exoKiG;-3)H*s;u7~Hoz&JU5}VO#qp2AF+lSSQmIrRjrAt4Aj<@+=Xx8!KiC-TT;z zIhGm317!@xIc-iqXpy>2v_eM%^>A61=4n%N%i6o|9e(7-^fty?AfI)#xYCP8DTo^& zjr3s%MML&+6}%=o=(F%uWjQ9h+&z1}=I?@DY%@XPxQ|@QdW^MTGy4n^U`!PjVWzW~ z#@Kg9(cCHrLF^i0{C_P+#~J=hHa+tzWARvT)T|6 mofyAlfcaloNak3-l?FY=Y*#o3K$=-4+3cbG{!^nYNW~vz3b^tB diff --git a/xemacs-packages/gnus/etc/sounds/cry.wav b/xemacs-packages/gnus/etc/sounds/cry.wav deleted file mode 100644 index 66d9268aaec750fa0329809ae6032cf7b281ea1a..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 96194 zcmb5XS#u;wa_8B6+sFL~`wjMC4_T2FKFkP*9CAp`Y|k{WuI`e`%E|*r1QCeS!^0hZ zpW%+U4_pEyG82_`Nmnt@}!`Y#<$iD3d+TY&-KxXv}A2zBI2)L`OnW?F%>1FEQ z|NY8>wACtum0rUJUeXvPygfhzW2S~;=ix|=zHehZ+-87_}QTX%9^H3Iw;vld58t=^a35f<=)rsR509IHnZ|WjsQG7_V8AKkGKd}l3<`dj zK7@>00OqcS`GCS;3Dn0V&9XFoPqql$dX}-jN0Q}&poeh`9nB4ZcKro>hbGMu?wH05 zjBgNWOuop>)Qrzze|26M5phe7pcuq50~1k%*LMSwzpdEcoaFRZ7#Y>o{%@1C&9i z5R%cqj1Kw^ZJ1sq0YL7^1(h1f5{*csDDqfO0|j}&>hOmj355S?P*98`i+CI;5ivXg z2(Snm=o15_!KzyixEP^&WjkIB5%QwUA-l%G*DQ4G5!e`f5&|@`oggjBqAW}301ZXB zg3be_aiy{EI<`G>!?Y}`sw#F30#oLZYjel(7;)@5BOdVMd<;+t9n_$(CcZNq^1Khf z_}&O8FU-buU5`!QnFCr+1IHd(wj*{3yb)bjdy~n8_FyZ3)W6Uf4*J892fH$x0*cbH zfN~xRql^yjfCj^n3->WT+o8F#tfIG zQ;aKm=h;@TKZFPY45NXD$@p|Wot8{h6bh(fW`_N~=~GCTAcq^I)nqZ9(Gfq2Gm(sb zTm5d&9%=Qt1}My{>0&l3l6#=Kf&znnr#rN1Eui1l$cc(-zL?L)N$4Rs%1S_^ey`KD zY+!t6G_;0pP}H;Kd{Jd!O7p5Zt+T-HciR9lT+N+jyCFbeI?W@Pg?>-!B6J4bPJ1x) zSTQ5pvIdTqRkQhgKBK=uQdCt5K+_ z^=}9zzz1BMR^!texcTgKJkC$YWx-%zz}~Reg)MAm)PiFpXil^9`C>J%D|ogj*jD_J z-M0qqZr2(O2L1lXMnu4Qz^xW*0LR(5ECCFC+v@h)?M~OG;T{8WeM9@{Vzt_=7XUKg zJW3+SaojyVI_?auUZ+F*ZjeEj>3p@_Y|j_dGM@k#hw;ej9Cez_qhmOw-7#IvC#SRd z^6c#5@?tT`^Jz6s5$D5R^YHkvanS1byT|PT>oOVxwmQ4KzPh@Y19)1MvFACR*8XAR z`OAa0-9K)%MZ;>bS#2&~y}7<#&nJwkmWb*#Uw-=h#lcalKj^fYZFsz%pI=__x!$bm zYBre_zTG=&?(H@9!P7nNw0b>1trzRd^XrSN&9utv>9hzT#BsCPIBp$x`>gkY8|3A5 zwY@lBO^bvjEr8SX8s+_UhI3 z<)$7Zwh(776gfIPJZ!c*v}ij~#)>_^y1qPH&rY==BKYlLr`>EckK4V$0Je@1A@l7y z)5Usyc0qGz7wh?~$mnvf-E1|QjRv^d1Iv~8 zuBPkl+4(uMb$PLx&&qM=IQ?Uoqjhj}(CBvhblvyT6j8I@UR*;*dbgNs<#_ng6K6oIc^E;ifk`PC()SRz#7(V%M&+Ks&zdwWfmMca~4@xx-WTGR5y`F6cs zpD*A{q-fVVZXF&RG+W&+!)2ZOA@YB=Wa+H7+wFS2+^%b=k_1-osBJY54i5U=mZY#{ zhf!6YF6Qg?W^+almWY?Kik-gY+J`Uq+jg^k*zN)EX-xf|JmmBvXKq^!*np7LXFR>tli^olY;a!0GN+Y9ob7r=AFbV(~H7Yvq- zWsw$>%yFVs?KF>^#oz^PwO<}Z$+-U_pUzx2T+Ud1%lRaoFK2mJMrC0X150AJ5qaGK zFzzsF__H*tMozU#2hpnZi}QJnPB=TOe7_odN!IfQgT3O^dD#lsnfk4Ep1UQajjJSK zF6YbBG_EG|D$Bwuwu8(|n=iF{y=b_Vf6#W${eC0Jx8*RK&O>`TN4bar?+@!!*UxJD zb`+h~gX5lG&XZ>?gh@ZmJA-aGD_i^C`3%Nli>#CR1?uPNc4-g8iwplRkJ*|1zSDQ@ zr=Mhrb9_+N?0i-|9#@MxTvl08Z$oE&QwD=*5f5MV7j@@lbG&e^=dCI|vg=LN3!H48 zxWi()+?0K*MzGhV8zgn%^+)j}@~u%BBG5{|-R_o?$mu|if#3GyVHvYDhH+e`MV*FK zH1<(gtBD`mWtt6pgRpKNdez)H7&tWp3TJ7QxtW88Qp}dVSJWk_#;C5*I3M+$ICea1 zXz{Dpjr}nS@Hm5g>p430yevGs2Ddetr0fb=6(ZZxwC|(0_JhE!PoBBU#qbmR?Ug%h zmN$WQT)tk$zEjn{)hpNaNirR`pET=5b^J8GT6gyjoMfC^EOtNgvsioUS>E!IelZ$U ziHaGaZTTp;T`QbLEho#F$b9Yg{ABK(ppI3ApH~^OVLVNT{&)k=N9Bp_#i+1J=AgY) zZZPUi#xt+!R@<=Wu9l%?&GMw1EY^8%;N;^B)hu!CqRs~GFpW#kj#vP08TGMa(jsx) zah>|UKTs)pWvsn1@B* z$=$G5KzhH(3*Sw~Md_yKNzpJ$PlJAv6dfCNsprRWaWwFe*q&R&Zsej>Sa!Y62FKMJ zw#w^K;4GGzGfcC2JQ!wm?V>c5j59Bg2PKl;&XU@WMll+99*oLK8I6({BOnja#W6>- zz!@Q|dW{})&}*l~+;Ny~G&@YA)XNL$r};FEr8UK_H%jNJZ?mu27)){MCoGduiH+f; zJ_@sg2@$Gj+y_#Xk6VZLC0q<$RPev0r2y%FZ{(2tqTkbzlIS)wao zYT0gDRag~FMi`V6)a0u4PX_35WBTt6+{j1JVg-ABhi#t~8|G=5bNN^<2bpE@r%wJM#!xwMMgF)%XCy`Qv|S!;a6dbqj9By;!Dmo!$V2rZ;G#L0VEK zgYvYj#`F1dGrf=zvRWtMD4hgW>t(myXgx=J>kLO|{G$ldFRpJk=v-(@^YhKsX@XpI zy8C-i+Ji>xX`|B|91XjcTUPANf0wd%V}QhV8u)0tMJ|KkBrs?y%RBSv23=T;IHT`{wh@v%1Kg0bN90>D$N6y#sW`juTC% z+wIL8bl;n+i&Zg>W48;DET=ncA2%AEo*QN;={FcIn5=omA{(V6%kFztchKs0JFZvE z(VgGioNfKm?}kIH5Fh^ohRtzT3S3mI*4x|d^}4DMaaQ8Ri37ms7_Dv4b)E5Yak<=X zr&WM1jv!AR#)%o8i z8+|{Deaju%!&aw*+85Mlp;zlU3)3y^zCT>1mfK}z4!Z-pAEv9D^NY987;*zREH`0?iT=WnjowKE)zi(c!HZKnD1C`sLRdoZxQ$?I?KuC`OWAIUa39(2pH z^`ha-^Wjm;>e$ip-5t+nt`*g_eQb}$*2|_{PrY8(9y;;t-B)k7V-)CQGWHwCR_Hu? z)@I4~F(%LkUVZ!evht%aTc4)rd5*vTSwEbogX3mz=-20WciXw^gu$vphG3)}KkLNf zYS;mHSYN&Q;%bsv7*~_j>LZGq&zgQwjN0wK<=30nU*4|S*<-9Nf8gT@c+v7>*6(qv zJ1RFo*FJ387{o3n^Dtjs-n^ZU{T_UrIyRoO)?v#*Kzpo4cf7p3x!IQN zw}=WC=hL8ha5O^Z`gXU^mVAD7dse%{5H$!VnLEHdU>9aL>2{o)yEogZZ>4y7T!-D@ zpmD^~jw5SuY?q76i_5bru#zczf`h(%@Um^gBr&pLRIcHU%_MZ9Q?!3Ka5{VYEgOX$ zA=S0=yA?tX`#-}R+^*+=i`kzewB7c>%NB+bzL{Znn9erm zm*;atNnPhbkooO{&ssRPa24S)3Kpxg>(wfCn4>a^%6PEU2F z(Os0M{ipjj`T{#qzw3-Qo6GHHDs^@ov$;5jPoH&tyb(b->{!Wid3klV2_0l#?k9EL ze*WaZb#UH}oner8 z{Z_}t&&R60Jaq@b7(d5!c^dSN4w{{w6Nh%I(RR>5m)Cb^sORx~xn9o}WAGj{+h`xG z!RNonX{@@vJdQ@?yHad9%*^;pF=2W>t=3yN`9; z?Aor?c={9>z&^KqeRsi)>gp|!T3(I)L%BG5hfh8^baCd)*$l4F#z{K6dv{eK2JP;_ zK3iT+9m&Nw&MeSKpG-|$h#$M2F9qc`C*isA^m$&De_4U* zzpEfbxqbEe=IYJe=Xb01tVXd;*yo%3FJ3GWvbAEAgd3*cja$6yjiX6XCf6zMI zlUD@C=%7D9*GkKJxmj<{fZc4WI0*3BI5;>5_+vWVZhz#BhW(M;)^UZ~5q}n5k!gv` zdW=Eujz;|>HHsva%h|zA9K&U^)kY2(8O2!YDAiErsBv`MmFEl5$-=~&JDE?>g03z> zn1>z;Wr!c%?%^ovvW4RG?Di2$emur|Iz^hEZCBVrc-K)gkxA`F19xKA8sZP`j{r=^ zcsJ%7#LRj&P9kC_CYWI1#bQs!A#3&UocpLBV?44;c^>5y!1r3B*E^$L3+E2{O~20` zZDaXG2+4Z7y1cqMUrn+Y-7&+WaqM>E;Hcfxr`sKj(5mq*O{en>`~CUq6lF9m;}eH{ zpT(@PbnzN%(}x>Q@!U?=SJzi(^C`N2SVZ{e-BAaRr(DeT5dSeToe($WqORF~F1P5b za`s@{*dG4OLwrhdUkvenp>riT_W(SdxBP5sB)2c}8 z?b&vgvlaMG0#~`QZ{wb`JP)#Z-Uy#hq)-CueS&@rq=G{P0s}AghpmH-El7fT4jdFl zWnC9>Hpf9&%j@QQiNdA$w~lDsmrkLOoEHQM?&37b7U$ayv4Swd9Y#kZcKk-8$ILTu zv{S`>@aGZ|%H_`^ToC&wK5&FSM?Fy!=L7LRqMP`yvU+-&C&l7yv%(Lr0BelDD2nWE z^JoB*&`pmh5z|plPRH2q^X+>(9Q*V>!;^{OIY7I0U@AJpuoTbD#|2Vr zx?Zmcz0eX23uGe5frEubOc|o$B_JNA)`4826fy1SX#5?!{U%yBT!h&S*MSpi1yf) zalKiuC*yGxIBpW*(7_{j1m(>{0;$$lw{MQ6yHZc;z)%{mrIs#t+*;yRl!E};A?ip{(uUg1O{sjNuMujQgbVxM6Au(b2Y=?bTRqOc@9 zMNlyW?!tlJH6~Nm#Z%8%01r znE)bykUq$#>m>o60*MeXNw^Hyg4zTrPM{=lLo=PkZ<)@D!OzE4aN7Htob}P_4v`)_M@NZGiuB^;v6`>OVn$XH5q2M2m~DW4 zfSE@?a8VIF;yE-AonlM}raDPz9;+4y5XclehxTxjnokLeEI}$6C_3dVB_dcO<{b&3 zeU{}`(mcl44rzpFqj~lTpD`&|%WkgFx0)}A&S6%ZF7dbHM#f-{g9HaLNHz5=;fNIi zp~7^`S`yNQ<{mdAV?rGz)P@<043$3({ep=lq^sCqK3RaYDj+Ey+c?2qBl-w^L?~Z- zUJ&d!FCiweV6$UNklqlw@Q26kp{yK&n?{n-Fg+!9PT+Vssk0Glg4lRcCa3{@mYXMc z9!mtI8KG7bBb+A+&oU-2If0#XR;Zdc@p>gT_&#A*1*(Zy&gb#b=liqs8JG1L@-iH`KpJN_=1OAZ7@pSbp_lHYZ5RvL_&e(>G^ZVod%C z!)Nj(^N_ej5`@Kcflg56a>}3(;HDh)kIk6GQ4k91=an|iv|7v;GXfkSW%83e_pP?! zJvd6v5;-35%R>1Pp%Co`DZ(41r%<2m-eW7!Dk+Gcw;&XW z4vIlTTXuDv=TN^C(rTit6t+bqVK_1jO>mUiFwI9fy9^H~I9^S1cuxyI#vJb-X+1%G z1eA!6$%)wUk_v~=bbNZh->_r&gdi;@UxY$?L8L(_g2-Vpn*mwJC+^5366H8CwMy7L z*+nEHkb0~Vm~}Fr%|P$^LoHHd*$K@fcaUYUK3pK`kC}X=$$W8I61^C)EhC{)51-Ef z-!3@eQbKI#*lc%xMAV27d9CeIkQwO@$7~KtG?F0Kx+XlLMXKd2p^G3#n!x&@tL2P0 z7rD$na6cp<39KM=aY_dW@+e8l2oGqV)C?F&A_`eXxLV>logzx%5)4)51)Q-*_-ROB zQII%{CAG>rPoVu0t$;NEB${aq;^1A;vh7ChQI?8(rXOm;8;mAl48BBCh$*-Y$Nl62;>*OLOJ zZkhqX8G=;yiV^l~V5_;h>7AfyAQ=!$$31*wAjKw-nnS=84KJ=35Y{z(%<7Dcw80y} zWCN*eKF=e?smjQB&?*|&G)^~3*kguJoGby-Is;-Zfux&?5G+a>M+IQTu_vjUwo)6> znF4eIa%b@8!JLZw!<+&6gLIS46W2MWFppyJv529O^r|2Q<%$3wGZe7kQth2+SOz6C z1f-vg&7_y|-4H$DqDIcT8{h<>b94q(?j9wYbuw9^FB3^&!7780uv-VU2{A8?b%(N? zR2W9(Vzrq=BDFSx1tex$U8uk`m_bQ+Wrw3e8RuRh)_m&W99bgY&5WP$mr=v~Y<#L! zFgI_5NS}w$?lW~Mvj+> z(28QhBTYEDC`d}FQ?!kKiaQ`-N#Jf{cBE!ttx1t?_fTd8so@wwlp`N^vVd`W@GluZ zKFr4KNc^F8VI4@kl<0UQH*GOVg9uV$6r&+@+0mFqcB7cKM~F*O{NiLxUKJE#MTwLV z6c~~rrx*z{z?KH-5p6m0p5?gKa>Hps+i4jPBxRG7K#fdRESrxub9CtC7QapaDdAW& z3D!=#hxW)WZfNewg2>2+WOfj3urJ;eAI`wFqP^T$PP9$tn;A~bw!7L)h**&dJt85P z%@l#vM|XvVAdqZqdZ`p6oQ;byTMyD<$UZ2wl*~obOQw zzT(>mOAQB`gGELs+4e{S#By4nO={)2OBCc|!k$`=(uiU?uW%%g5|$?!o7r|ft~}-z zQ4r$8wBd{)on)_0b|@?OH_Z^~=QDXuQK4YADj{?L|H2r!E~IRE==e3xacr@(O+}PL zQCoCL5-(VeWaF`kk*UBFXyc$v@J=c(E+Y^JC!%<3g|~Y$E%0&RH6nkTJkXqMg6aH> zBuWO(E`h?2XcKFg)d)&aDyy)5(_}ndo-a?~wi6~Th^vfH_p#!gq!7sYY35OlXEc5` zBiJHZYDFa;Gu|^65Rq`rct&&lQQhBw>@5+OBWvJ%fp;gXNaWV;f%J8BUdmC{8X`)EW~2PwCBs%iq* zvx&qnQX?Fr8Q{n#m68QQ4i~O&?T=%QUF4*sZsz0)G1d{Dpge*(hz!tpu3ScE6q8U+ zzCt=aU0y87V?nJ@#F* z23axvSv4oxQJ=7I=}|z>?G}zFY;_Xq895@GRZ);9k=ILn%()woW5~XT);YjckGT|( zDUG>Ah6T*7MB{R@xm-@sFh@vr5_mL0#`l8p0B73d$C1)NN(?cD^Yg`o=prEkHfy+p z#+8qabAyrF%ICq;8sUj2D6^ElwFH8{BB>YF?3nS^76x49P zONavN8)nzx02a`g^yP%rySO-C*4ns`j_5?}XU(HFBiCUC+}B3U0uWyk$raNKxyP;$ zq->GhW}}4^Ha-~68?bHS=4Cwf?Ba4+Bin3Gk892k8$!vM5MxmyF(G@57QP_{l}h4| z$R>wG-3Cr`n4Fb{Pg=|TlwCK@CTpDLCE}U<3v3Ns8ApfcS=!A~8iK&%nxr*t+m0XD21a3>%eo%1V>xd~>x~VEoWFD9LZ{o8cf~L?O6{iPScQ>2-O& zsL?JM5E4^FZya^V8^`wrue15&6}v90Vs>`5o+gk7Vv6W4o_$st&H+gnu^SY^?#o2V zd4bem^`RQ)!GMScJAlku{D&itgaPH?CA599tXR5CID)WbQIPTi+tV-n9Xx?7l1Fm9 zJcpDd%@M*GnS>`C`^StM3h8i%b_&iGz?So~tIeEw5Epn^nTzHa+_H&j8(#`bm(@qi zj!rI1tsdHr(XcJjZHP9@SscJ@qJy2n0`xKt<3$I>fELTVtX* zQ9G-Ch~bwvISQRdtwdHfgxMInwF zTlr*@83YdV#rgGiL2{o>rnqtwLLwA}CIXFB7NXOHGM1cL>NaZg!s3C*Xx&V@YWlQHi%V(L)KzFi4KxuzyeSQe%xHGKfPG`(qmA-x5lR49<;tHh!ZLPa=tn%+AdQ zluQmPMp~Bv6w-=dljSPO{|IQZQ*ml7FE3ZD2putTu&t62@kL1jTtxV*(MZPx?ucln zlkMf%3Lnjgv=k>hEdzp}^5rueba67haN|xf>q)^NM2zci$N?Rpq?ZT#Efg3IDWSxH zlHBDfBa7d|K^>L^6FJJ`V#F-S`({{|+tri>Weo<}Gf|1yByfVDhM{BA3^o}|805(Q?YZ1o zqqgG~lTs6TNVXJu6b>F+D6!U4T&|1r^W`*QIPY`f6ya69|vCS z3`y6X5HCyE7N$((rVj0%1xov*NyNMsx`&6(U@ zjGJvFKpjJ4g@#k?VL0RJW{F=E=eFfI>?ZaR(>RiCj#e$(u$++!K(_PZ?B-@O@vMHw z8ET6Ot%DZ_UG@mh7zU)>c~EA_o*0bRm$!&E*Cvy~L5Adh`{j#9A4O0{C%GmbT5vih zUrJC{EM|BE-G_`*jfNczeMtHpa&dy{TU2XKxlD9|lYPfQizl9ZK-vp>soYKkW%G)h zo;W_;T;5zPOGswR=|FO_GK@%5OG2Z$V5Ac4ACnO=J9~9|zVt?%xWhe?;|U>ui1%YQFQtF4&fnZ_C$`-| zwIn4h4ebL`V#vNt$dlEk!U+nTO)+uO>o=F{)at^qat@^4@rzIQ2QFGC(i_Q-NSJdB zDK1ynpWkc~@;K2#*^Pp*|MJtPZI9EeN(IATLGWv{AX9yD_4eJ>bad1l63Q6*dFt%_ z_~S$J=t)^d9no>#$@%#-^v0K8{^V{EqISAU0Z9wL^}`=L>Eb0fYNc%a+4apPcH;Hj zH{aeYSOxudUo~g|NYN@vu*tNFJ5}B=Rf%2!O(sBhyUB} zw5oMV+Fd+ZP0Hz;zyI~$-d-%<{_O95`lkKKkA6I8e)8}CXfLh~e&>Jrx7K>@^(_vW zOsnbg-7kOrk9Uju;`5*0t^@zY%fI-+kN)_hPtc$Agw)j4?b^!cZM^5k%s!+gk>Vt#Xb_xkqpFMsmYm*0N*F8j;x|G}U9 z`KJe+d^t}VA3u3%k;=H;Oz_n?1DBkVyz}hk(TG^yn1fnDm|cGLPyglbe$sjNgQr8c z`|&5wTkRkHhd+K6ZI@BM?N(Q>zy7PA|Lrfn*~aaIzV8oOd&pb+p#N-Ov&^dM=Jsr> z0Dtawn#Zl9J@h^=jY{ODKc8@PZ&b{-Mc|9e5{L5S%Vit%EqjNQ%c9K11T~_?t)a{1bIX^x|H@F^SHA zk&7)ziZbRZ(pk=0%uPj2h~i^&qhNyx3r+x-3Q3d#!?PtDd!}Pgv<#49)bbv)vyoSo z#nXt~<)=at5xWSAF~tJdM3hy62?BV8cZf!C zRI;Te3dUj$;ZxFtlcN)OLm+Xk<1%80P=<@jEMT0<7f6(py8)gS1>Q0c;9n=Yq%f>9 zKorRVjs_K!zp6ESO(LC_Dr)R@%Ses3}H@6xuK6-(>;~aAW)0l zhszTe3*$o>)+o78CIw{A@V3(xtTSk!KOh%IFVEsq#$qh+G|@K4weYahBSxfWm}=;! zc&3IXM=;n;k1?W>A`__~9{s^6S1PF)43kNU1$qFaGR04@l=0znmJGgtI!r%$NU)e2Y`uUDhA(N7EFz-A}Pz~l|O0mS5ck=ZWbAkO}2bhKNGXrXK zH`)ZQVP=^FI#1k!#1VSSK_SAOrcVqISTzcL$d-xltcq8F;~B9zQv(@<(99;FVpedf zOB$ypg9I}bU4R7`gcg>%2dG>S(3M3`bGY2u6uAd#J`7U#;VasPAoMU3N_tLP+^3HW zox4JdS|!H^x8?ta7KWdhc=92bbh<1zoarvr)e1%is-~VGYH15=4c!0a>`HrVl%1kVV> zS{kH;2DugLF!IvOo!UVvYhvjy@>IYqI6yS7bW&p$nQ4nZ0byVWBNSlffbTpG_tGO+ zhiPPikXfu*95XZzH?R6k;Dg^6(H>#X?9PTBQ1TyZ)mg?zn zHp#MNy=7H4+2Scc+1bqIR2gxDLF=<0e)Ob4EEN-WXtxLQVPe>CukOBn^Xh6#YISY+}&MFP82#U!cnKoA%)fu3#{8XJhY0uYm zn(b_U_4f9XljB{tUY(VkGZ>sxA$Q03#EO2Lb zb@T3aR#<(ke^Mu%7794$oRX9S70ph(eD&t_4IQ)aGZ9I%4_`bdOOimMgIl7TZeQQt zT}=|s4$sdxk#8S7|CFo+7QNlt-)kr9S2u63rtxrK{616v=-E?-#iAb_zj%J=;}<4# zKegL2X9%~Ga=8Eevksm|chr0N{P}Qt#;Ks2%I>w6w>LM_D*ns8&kl(gL`>_`r!QjM ztLLw8i|)R4es_C5oh9ARKHjrpoO0ITk3V`Es9?sMuW!Rf!+rJbyQ@hm>*7V(^?QlqK7_DwDuRj0lfB4B6 z0fgzLgMeDx*0!QWq^6*_M30Aug@VViO( zRL?k)zj?a7I6J?2`{mu;?e;WJak#J!2Ce5$pFZ7h^x7>PT^s`p2wt9_ajx#0uixHY z%-MU$RKS96A3XWw$+M<8HN#N@4hE0w&Bc0qdH2n`x0fqYI?+Wi(qYf1Pd_~*j@a)j zvmhXkiOBMFaryQg$6{7FIqmo&P;PsT7f+ubaLA7{u(-UDRmEhpp02L%zI=0gy~Mj1 z=YZK(^TlVMe5P{{{UH))M7^=`Y`b2Zy}rAmWyga z2yI$%%IFPsNAON*+oWj=M-(na&VIDJ&BG1{t%(*=E9vabmtVfVx+H;AM}ToWQ6=WH zXL~vpdQ4fAfm`MvT+QcK@4o%&)%B`4;Vd@Z4QJSCeD?JDA?_k7>5%TuL3-4A@<%tX zzxt9RnVhxusZ)hAIc)BI`m8~Dr9r2?*XX(^PSu>m{_X2;zy12%IY-?ous|koFlape z=;IeH4zjeGFApg_lVrpcR@3u$KmYm9zCJGoR4K>^E_n9g$A9)`&loPHQeI+Pacq74 z=5|r8zX0%?o4jWQlXN(+Q?K#yfB4hqZA40)`-i{%+rR#+&7jpRDg=BOcRu~S-}$q> zc+~4O_C7uE2qMkj{rsjZ&;I6@zxu~te$L4dYv%dge$hYp!~gXUKXHO%&QrbE8xnn9 z-u>d;yk7tESO5IaKmR7~9`8>nh|)|t&;Ia#{{0_zy`~OAz38OnZ2kIY-=5FUe*WuU z|I;tNS=vXRk?=G+>K}gk{r~fKf6yTKb9lJ_ycx{4tIKy^-(6gN`=9@x|NQqqxygFZ zj!2(`CQp9&umANQf80_9orBNzhxNtz`SllHeg5{Fzx(xn{kva&eib$Lk7B>S_v26g z;`{&h5B}pPjiYvF|K*F;czd;3z54Q-uipL5um0<=e)09srsL)l!Wzdv{P?4%Kl+2; z|AQYNw0o^RjPQ~i)a~1EfBMsJfA))C{qi5adV7(RGr|#xkAL{&$&Y{V`~UtgK4TUS znihGRRlU9W>f4|ECFK-ZIWv{_5_vA+(|HY?&{)3PHZ13d}CtnE^QsC&~ z^6fXj_}RDLeEqYpzxn+3%~|a4H4a~V_VGtQ`qNMT(B4Lc>RVm68&FkB@pTB!^O&OglvOSA@ z*gg2{#r}^!{oyAs4>}{zyINDCqj)Y)PIS5j)H8bUGXovviV8q*+j*ZMh+(hw5qt+OEyP##Uqh`6tNF<2LbK zDl*LGbxDv^2id5LL>aJ>dNfY2-8kwFNYSNk7yfwSO)B4{3SXSPA_z;qASo>>$iif-k)m!s zdWy3Q_=qq9On0%GNoSxJ{6KZa5-}P+(AXM=0OCs_MhmCAGBfBnL@`vL8JQhiK!FFs zDEqR;jrN_H`W2WLnNmAs*a3hVO#+$@YCvT=f$>Og42uMFn`|2Tf|X4w4$cgQN-C(y zNj2jVZK0|Tn&t%H)dlsFtq`9L{bjHksD8@}pn1#rPZU7q*XTqFGA$KDz*(S4#G|iK z5rZ{@08}KxzJWlR0KSN}8a4(9h~&QzkeZkML4K!9S6M*(HvcPWADH{;kbN&|>yjGb z0mdFF+=7*5Oh@ySp&8VmE#_G!o;bxA&B85{QcvTHphl*d2GJeL!w_@^qtlRGKV)A~ z#*rTK5iijPhAwlC=`{QRV&aA2eG2 z8CqcNF`;IHH89cKu$>?@B?5wr#NB2V=n@10P=+%j5FH^IE+>BOngLX}4b|wAzCt*d zP&LSy4yj6js8J?cyv}@zJH@D!?UDONO*1)y)i`uXNYyu}MpK#;(5Ml5!GKLG8ZJQm z30}>kCPSSu_{<92^+m{eLaYnpYIaPY#EC+Hd{8?w|Cv{@gdwrkJ|G4N1ai9wT!IH^ zfS{k&hQTEspqB=Q7R<I&oJHc!jt zARmtUpohR?xVqdm540U0+2HbwZ3Q zsDxdE^)HU#KWK?K5&sy@+I7=RfM}q{cC)H(a)p0jHC-28_03RRn0H+i10q7Ws^KDF zOba3a)L;^sI)Tz6A1z3ALKA`vB{NV%VBl4&~VDhGqaSJeb9 zus^R~-=2|mk`~Hd$F|^bI>d80`%V;WwY|LFu1MtZi5K^e9d>r~sxY-jDtAM2)b06P z?g$JR>Tfy$bx=8IK;);>_v`KL-Q_AGw*j$8LC^uUV%>r?1*_BU`sLN#=U17F!-R8Z zBqa9iZjY0)m1iG!-DE|t<_Xba(qVAJI67-iA~Xecy1i&}{q}mT3Nt~7=H&P)zT+1J zlu-Dca((+|JtMc)<473Wi%ae(rfW`|nn!1sZ!ain#<>qt^YXy!HR!Rz1NN|MS7&c; zW*O-h?2{*H>I_@Q)R;mE^m_e%yt;f%!2xo1<&Gk47YmKhD7h?Fw==4?uP&EVg=B8v zj?C${2?oX_z6R8D49Qd4C_syRP*~n-x7(;bJnQwTTtceginzSC88*(uqSPk7HnKOJ z-oVWl+s%rME&OFva>*moQQNG2PWMwVh|mpne3Z?>BGZYL0Yx~$gJX>tuS3S*dctuv ztw7GmkZr(#SfMZ@sg=p;db1>_TQYV`D2C~84cLrfLR2xVI;zF(l83ihRn{j4+ zUD|F*dUH9eGw6XpdT62M7GqK*I3w2~yN-G>)=|qz$K~ny<<#qkq)Mh! zDiKli5{@Sieb_ysE(yW|97duD~9TK zNE4s}4P`JA&vFaAEURrc>f-`Y6*ah_+30%dgc_r#q+d~nmAbIhKI~G5OUc&c=Mb=<%~0y35A z<>Xs6nJhN5Q}h`ffhNDzrYJ6jo;Vaj0uGVKiEJvWQ@{qQk5n>) zq~pXtV?R4ZYLSEVZ{)?9zwN4QvL=V5~Fmc$xld`I-LP_em3Eh?kV+B`sBq^Hx%-! z@HH7PxTHx-T-2l!uQ{GRLzaZ&oP1fbtcT4bJaH77))`rREmQ-fpb%9|sDw)CNx~z< zPKkI^U*d>7G2qChB(h1kQW?GUY{QvGWo_XQLPlW>^>jcQ8IHoN96eBww@=dQjM^Hk z9YT^E@*_2kEPF6Ye;`>~UzBmGssIyCGLwvj3Pmi1jg%C)Zin%L9zeK@_+e2~wT~0B ziv`ty2+ugD|`FH$Wy9nN;mR02v85_=HaB|9-onlwWAB??b; zk{VlZceIWZLYz{ieVRliVJmhiccLtEsgEYJ77palH`{k!QrCoZc)|jbZm=UMW@Ir^ zW!>aMv%E~Xd#oGKtNOUkf-8Rz)5c>kTnDSNifK$&ku``^l|aUg$oVV8EA}GieSwv_ zz-l40Q^nd*PS~L7Lv>0yV4KouWT-qlD^kia_AskQ$^`SOt2zj+GqpsTfi((?5!sT|m}%@E(q?vMBU7ah z;QAp=5vqep>WVBjj9a{oG6rQ=8QCsCKHz1TMoB^y6O>S^5ga}Q&> z%EPl?nQw`O8b`R)refX)b_y5#}c^XLb`yONmCn$sZp;`WZ_}n*X{uJ8X7yZ2d z>*1REvAe6Lg`dyv!u_xJe*pP#Z3ib%{bw$NM)!rp{4G#}N>_Ak_pH7?^jhBq_4va) zaesC9lx_(^kh}l&$8O-}Z+`6Vm@oQ6w?Fu?8{fkq%}oJ3^g^%?pGP2FFm2Ko)7%4u z`F)T7u|d8F>OH8M+%>CPx?}KtfW%xeeR+S;pn3eUyROD}sD<8OGdE0oyCw~UE~=5= zxTGuQbB~AH4_6Gl{@Nkcx5wd|%WC2g_=9ies{#FQ;2*&sz8Ki|&+huT8^{jiJqkg6 z2zifU*J0iGjV2#qA5iQr2!8kfJ%al`ch`3$+zssEyWsATnH##k`|lBh`LcWJ9(D(5 z$Z4M4A$aJ@4xhR9e#zV;xkvghjpnhv!-_m|%H?mcRC@8SAAq`~@~ZofxiE(5=V zc@O!3V)xj;bp1WjovhX0kFfs|iuVtF2mGZ8AR|M;oD^<#H=cVqYW?&l8HJoCZj_s{JfzDJ?vf1|MnEC#>+cxX-E z)c$<~kH~kI%yk27`go7k{JL+z{1TDwKM#luR<1qJ&fwRByU$M0-v9Cb@(1vb_k?1% z-x*wB*x}sC>-+D5Heb#5y!-KZX(!f&UOjA4fd&<8Af*5LWzg1(w(-y?YJ;`>X2`k;3YH~s~JJWQLOGN13lf9KK;;C+)1 zpua)-$IH9xkMJ7MZ=f(2%*FRm4^8d}xO+f9MUEX|AJE)i)je9LCs*!3u%53ld8?0)LH9yS#yAd z{C*tB4&tH7dl1tBbVh ztgiAg;O_w+n%rH#fBrYo?4Er5`Oph<;RBW4JoX;Nd(`U8dz|-p9xmy|Bj|1<|1GSV ze2?P2EZPn5yC{U;!0XG0sMU){)bE=V_y@SnQ@UnAAK@P^e{lT~#SZcj^zpjE`rm0% zkUJ*+F6e)+7i#wr^J6E>wfC4GuYYjKpnk;v9>sSrnXY`d0pYk`Vvl&$i4Sn=&&P)h zyn%c~ZT@->|K02FLGQ1>M|D44kMJM%`e9Ep*B);?f~q^atLD<<^<6J?=QplD_VGKQ zjPjv757%{xkKi9J8EV{LGk8qv2261Ld%P)!k9ioQ#9TB`_>^|f30f^0zYt$`ofItp z%c-Pi8M;wa%%eLe)9!-NX!NZ7Z~{~u8604__g#Te7jeLt_6(#6Y05pOi>9wM^bo2v zS9h%&FOeFOYs|o^m&U7Oy7P!Z{Q|w|rSabI)%0H@=W)5XKw$2hF=$9!&^7Z>$kbpk zkQ#zMhBO-0J>>2xs0~F0vFm}kFBH2Ny)N^td1yyibwYod%ew(G4hVLSg3ju;h-Sve zAMyyQX)|u)-xG2XLL?J9J_?)OcU#fp`^&Ux{D1(ceWOb++e zQ+(PCz;Fl`#16Ei5p$nz35n=MPc;}_qh+0|0!Hpx4GTKSQMhv!(=c&vGkJPINdS6C zln~{3gg^BSaEPr+lyY%1a6q{(&$7YFUBZ>SMnyBBG!9)o12$EdQ)ZFU5EzM&DYJ-C z;?t$)a=V(Lh!i5IX_~K~#19WKAQe9dp5T4gi&~Y3BaQ;E4nWW%t;$i)7bcTD9@85r zsILN5w1ltp&YVjUI-(354}<=Ygg^)b%?b)%s>50lVld;?C;f`Pm`RjF+$158kAvgg zbc+-WTH`}8Dix&^0tO5u!Ru!GKhpDx}~# z94=b0NQvXY+#)!+4)C}V2$)5!W*tqU$Kd1CBatck>Jzhqf(#mZsV9`3fwMwhR-nZL zangifA+)2)Dj9ep54ZJ?bZi<*crltsAd$gp>5;}mr&TP3DW=$;j^R@x0>X0VgwQ1O zs0>0vR&WOsDGCv^;z%dVWKgiqDCJGs3I#P(vWL=4nkLF6x+5Zc;z%m6n*RtQQ}UPd zP8{Kf2GEEXP8m^0wOwAv#OZ(DI725w(l98A%cCmo$3XyIi$wu+O4C6OiuKZa78JFD z3MvBfYAd}ejKbiIo7V$zx{^Zo@D@3!B*-R23wdYKIO6~jl;cUrKvi>xA__zw9Xdb; zDWuN%PZXiVts2!b&{;P~h=hVpFb!vo+{{4c!*bPiUhoEm{29M zk~5nubi)Ott&#=pdGQH(o|If7s7NWVniDeiw?O%`5F2_W;LRe)FMdH0yo-R zc$XY`ZzPH^B=A#%lj&zZDceCGO{|%zrbXD+rz{3@rK;U9G)MarhO4v29?U|F8LlERgSD;~%rOq?|BDk~f8>)A5*V`HGS1`lEaeRk zBT~kZo)pU`$C^9zlnD%Y=ceids0xY>BhsiM{4lFz6!XKfW%hLTSefS%nh4iOmFB6_ z$=l~LQ>|UEU*|egbHH-X=^%F%E{qup<1BQqknTk-ei8C&{9BYp^KPYo$tnkUT8d)`Fu0n|iOL zuEJ});+%O%$cJa@NRlR{Lm%J~{4fU0owMO1BG}Dg}6GpG= zqZSeKMSd0%Mk^BWPhtdngESbvAs*NrVGCrb5Tz8V)@A~m!R=b!90fqyt1v2gX?jIB z$FPxnlyK(UqiP>3b%qIKNSu-MwFDfJ=~X$Jf`Am-Bt0IMgj>lCQ$_`)lT0cBQ_rL! zEZEtpXBfg4yk{GRU^d9zxqeFbO*m!19zGf}Sg@s@5;Az_BJa4M z#~EbwiQu(htnYJZTebdE}==oP6V;DMh

z7%rR-1Ly=iYNzToDwl_?m!w2ek(G-g-V;}o=gC8~&5InNhD*&H<_!5}4aK5Vy&S`| z(!NL)BA1l%0F*PM$eM>pkd7}^N^65I>I4PfR4+aZ^=2VNGE_p(P{J80r!W&`**R?i z`|}=2bQ9hmJEXEZy+iO)q#Z&aU*G{YQJ8`^XP_raJCMQ^=**cU6%0siFdfYo^HEU` zdB9ew$w9E&)DvdKGEh2#=%-j7D*>fZRUy%Eq+M7J;|FOz>6wDc-m6Csw7M%P?6fo~p>!wz$ z?{TzF#RLu0OA(fCEPByJR=Tzk3J3FQ42$GDschPqdDqZj6c=a|CND?q%Zh>B(G@v= zNA45v$Cq!L1}G^imcIS_wxlk&n>Pl{Q3;I2IPn!G@u2oNCeXQy~8w zO5bU5K`hmE(4i#=Vv@EI_sRigN*s%>vOE$_)u2^MA3@NjnhCH;v!*-^%Z3VWyscj5 z4Pu*L>Kz^D2Fsk9zm(PD708yk740~Dlc(M|Xo zJrnJPMJXb%RKUlM1s@@oknz;PW;v*MiY()lEHFBUut*UENO2g7?FudBUaJjSU=c;e3cEN zX(*)mlcOkifHu9I4MpY}`ybi-a0~-wV@yy-mHB$1?hOpB@4LLBL)_MNe%bs3nLI zy2Ptwi~vFWfL!lJK~y5$nQ;~;n+Bv|;$$wsuO}+~hc?Jdpjk}H;ACFJ2OI+@AvB;#&`>3lcP40J(Fxh?SU#l6G8!q-<^|F+ zdoa*+{*LSDepE_S@*^V~BQIHM41@*Dn3+bs!UWo|jTt2ktqY5U)xhq~#w0y#&yArjjT^~1y6 zL1;J%LdfJs<(I64=f$G1F{FmV;6*{_AsiYK&-4rO=)PV~qIrR(;8+^O%76ff4TPZP zigS{Qx7F_X=V!a9;cYy}VocIQpo z%sF}h2UejX8rs^U43#6&2nItZ8K-Vg(TgN+}#^eLQRtB42ra< z*dIzMoCEPI_mW&>-Mfg~Au*~sn=VZiQ8+xO2{IX4Ff>F0$BO+X$|9_oP4SXq5i%mM zQD~SHdFKVHhPkUO`wO^QViA%ePFFDDYLu;*BI2l>=Pl5PXmuhx#XjP`a;4cBq#{^} zEEDKo&wqyo@u6@?t}#pi4lNy^N+1`u0B02-Pq7NHI@o3DOOGT+SD*tV+XpGpi3-}{ zIUyMFHwY6GmlY;FYA#k4j22A}BJ@@XNSMeYT&Un(aH8mHcvIy%Nk2ONhv>)RL~Rs* zHjJ3Ju}5DxZWswmfXP5~+%5W~;Szvx;je`~a1)>*>5?grvKY85-}U60ED=`jF*Qk% zCgE5l2Fd}a&DTWy!RMGg92%A&)*g37ZmWnA1hsq&BQ6S%F7KC(mHsRgVWAI*3=q;p zxKSJHv30aLR5RuZ)0b_L13~YFG^==iA!KwL)IaD)r0s{c%b~YLp8@9_urTPFg$c>= zKJ0(F0%#?2^&vBXv4%aOlzBc9nJ|*TbGnNF?_r~@E)16NPn0R4mGY+6CWL_mb{;Ph95+zUR=58+Q?pBgc>bVKqY3A zSRHaeGS@vpz%9kZ;JqiA zvQRmD=BZM`HJ}V+uUteVE7~wx4IG4x;Si+q<_oqcgpI>N5a&4nVeUu@$cqEuoB>9n zR0J-^Vua6&H7Cj|@=r`;mgW`P3wuEK=A@Y&G6@A(ww7WhS&nR{Fnkt7tq)tk0U!im zpP~lA+fWvS>xt$G^*5=>;;^A}z7DTrpGp|C+!Xv-+;jLguNOj*{)h-oVS6Z8a4}wk z=!X6T?OXH&ZZVS;B9f>88z>g3_`-2O^LCUg7$5(K5+GpYCQ6#{0MtQBNkre5u#Tuj zY>nIvx{T-<#DIb~psb?Md7em2Qd+Wc)-XO;4c7`r zj!XdS5c=(6jdMMjvpCu~J(v~?#IeeDa?Xq+%Bma|92pHxB){}a;0oedp!p&UO|CEB z>B>IwI6PcjCsJ`LKzC4~Fk@&Hj*8>}z+Fg2v=a781O#uB(-BJyEdUx|od_Gw zU373}%ih31IZPCHf=OOQAi9U_9#*7inWEQ;j>Q1%iU^S+XT)H9&Tfd7B9{pT8vUP( zL6nZK^BT?rHYPj}z6JOghY5#ggN2QX14i}?1bFfP2&r*Zg=l#LhbiZe4~f&4Eo2Sl zFRWekWV9Q49dH8JIPwdzKd}Pk(j!yQ#i+@}w1@Bz3dnO9CNG6bMTv#Kv1}nG(ZZQ0 z`^pVNA(XEOukl>E>?_8e&<|(kF#;%3cm!0!JrwmHW1D@GpphIR{xCE_e#gDy(ortT zucWI3TDja{yjC91p+^r2i$_FaOTnD%F9n=u2w{9pf+;EY5mJ>>WAUpKO=F_s9~A8c zl0vy>5gdf@4C*gowm1&J)aQhe3~a4bHcE3A#19*S5yl!hXR&FmlDHu-w0Qw^FI8v& z?1SnI5lIL}i~&v*=E-zLYY;6R8bjj2_VJqo73;=mCC!Iy*>;5da*fe0s+ zTP?B7Ju^pi5cUmz&dO0{AQDkb*l6SjZd}em*aAF6>XdL&%6Um=Sm7I7lrKg64m38z zUV)8Pzkr6!Rgp_UJs+$Dodvi%Xp);P$|kZ&#GsT_VhEw8!2eAk`C&MSDkdcsAFNn> zEkxLGtYE1?kWe2wp<@v=5ofXx1V_wXizdND;kytqLIdqh_%YXlyAG@5K?D*0E)iS! zkzh%(aL^%%{WXc_K@KcLY%@`nal|tof7T%`ZZS**8sP%)BKR5BE$o5Ag|yj15mImy zP7J(2hDUtUfdB@Jo`wR&St4=drm-Z!Yw@I%RLP+o2`x%b2r&&17XZ+UJP{GiE@AVS zgqBdTpc?KIijEK&Mj8?T#>@}qD?AqYFZ!kYmI7m06BiRR4823_Y~&9CD&cn^@ndMw z2a$=$zKNhmzml*BK2sc$kgO20oB`*@?!%D9bjP_2qv1lqLm+XsPdtFE4Wg7?g8aDX zEEj`Pd^Z%5i{OMg66WA~K;~?ba3aVSUpe%R7ftMC_#IM^yNR|yH8ie8%u}vC0tpc( zXHl_vmMbB~D_p&e(T6O>Y0NMd^o)B}tP<{tFhkfWdjvaVW-ub@gdrLugnKfF zOST6hMsUgnl@?w63Z^5*pLg|XPKKcg3+8CVf|iZq)Oif)CmI+k0g@0|1?xmEqV!(*Lxn2IEhI~UCQx+9WbP=h0vjRLDe4&X!Wxii zEC5wmv`9P&o)Clp5K^89WNzGZm>x!`bZQc6|4>noG`2Jl@r(-*;-XVDXuZcNLPH`H zB&Own-yqHaB!Earyfxl+uzlM8U+&0@k0GVYc9ck;oa`Tw-j{tTY*7>M#b_-xrq8o0%5j7*7+Y zZd()xtUY#GTIF%b*ox>@2v=bua97L-$eRVglW=L^_(6W*z~sCUQXCS|Pifa6pbcy- z1~VrKm*C3N>p}W5V**HG1%e;d7Q}J`vXH9;6>}%4Gp1EKdVz3wHi%8c48yMhgJZFx zny`tmBk`Uff`z9M_Ykd?S#h*X9Ga1qbl5b6&_v5aGBanO*_rPb3-QQP7&frKArRG2 znN&5SMWpVw*abt8De|ATT(4lyFJ;n+rC^izpgX_%pVLRYNkY05d)OeHFGUgj^RNT`A>@&k4lhpvL7^<>fw@u zO<;f_N62&V3jaMrjcq|fvSaX8?h41rOcD4n8|a#wBwd|YFJEQHI8sbi(VZY_?iy+a zF$H!I=QcB7zj=Y+?+TEDFe%Ok{fY&lCyKI)pGr6cJ49fc9%-^zRt^K^d+Zn|EB}eJ zLo8Ym|I8Ya@WoE2n<5FlBnjaPOJ!| z1A+}Alf6QqaOucW6NL?S$qbPB%&67lj{o*Xyj)y`nuBTv0s+63kPcLgkYqeAA*c)T zB|c)WNZX-T0AOxjXhIwd=vzWtf(XKy!_wf`vJTiI(vO|xOOjS3);ufuLJADW4yzF7 zgyfU)U`M7~v5H(hekINYFU*2~qR}HJF-is}4IQu}Mf?Y#TF~H%$P`?R6Klx^7JJnah9Uv^fQ6K*<0oGmbha1H^~V|UP%pb6&2fe4!ynaQMKG@gC}3lTPo z5`#Oc&E7yg>UTv1p270oij!t{Pzv&R4)LXkeKE2e>Nz&8pI+ zicW9?cia;+A5V>wyq6-cwp&-jzAzJ69UzRfLj%PE%TRwslD&P#4YXEVw|7fx(hfO+I9pPKLx4n|c%4}R_=dKVAcd6Ve0Z}{hGdH6_6RH^a6Ji<0|PXqy%^9tw3F`)r{lH| z8?4;h-?E`*)nawvPKI^Cj=?l!08gOwlK-L8IL|_AfC-_V zNbkKW@g)wq-ldtCBXBhsrihXz_p+dol+d4y(Qw4=D{p1nz&Foo54lQV>!p@8MLCoPgE-`z$q7AO( zl#6`Mror0eau>?n9-0Lj#S$Jwc3b`qz8Iv&@LoqVxU_fRj4qx0P!kXoq)Q0B%N9!$ zE#VzpQ$c|d?Fi0^2}t2tEkDvEE{E6{lVuEGFJeiMZJ?Ko5FGzV zOAN&I6vofC@LlhD6gzpZ1V%*xg6$)vP%rqL@kO^23y{|_C;}I;F02g(!}BahTuQ`1 zP)!g9h#!#$(rZ;hHR1x}0d~SO)8WtT3!ZKC1$;bwLGXLT%ohPGFYt01L?aishS;TI z%!oHmq@TP10n3K+JpU9wqy#8L8T0~Muy{gbNN`p!Ix#*25!0x~e1XqV#4&duC4Nwp znJ7<*DZoD@F@o{=;d7Kq`5YxsX2A;hK}D5MMXh9l=r-71VpsFS3cN31An+98kN@$5 z(t|3EZYNGU?-%kvKKGvSej(X1@|%zUe|-7lD<4CM?&bZBF|hLGkKYIQ_$IIT?dRjU z-@d@dVw=mie|v@Z7x{?i_&ekLbpUzLd(X%3y+^UUyvO8E<|Tjs7}5L1U%&9%XdfSV z1Ig;;d47I-zx2Kr7<1*FX zM*0}-cwd#p$h$tq;TOL@;(h*?KlsaEem&?e|!N)$y$p7;5-(T&0{@X9*YrhT8U;aA&UqAnS2pNed#rxv@{Qf!r z;G>T>ek|$Z!H>^>Kbyaf_uJ>*81jer{*SN!^)vbWFaP3~-anY%@1OnlyiED8kMgg- zjN^^^`_up8|K8_+8Rq}@c^StW`>*48#OICgz4G@l{z8-9B>%O3Aps>=u&_cHmvBW1G~sQ*Fp&pf%kWnG2;T37OL?pg4vLM)-@R)J-xAL_ z{Lu4K$`kTyVZ0*2L{%5`JcNY=wmboW?hK0*kt1?L1PyK}c&KO1VI84DDl~eT*WCV;!{%GaFBSbluu>COb!0eEah35nn)N43dqcu3h!W@ z-s;dv$r+clILYM05<<;ER4_yD72XJ(fJ|1_>B$>en@kcDlMmTd?-fD@xJlRrF_w^C zxVT{K-iG2j#riB=MWust4FgQY647K$F0$BdA=DeIRjOdIvIZ0XK%UKsK3n>S}Pax8r{kTlF}nR>?Yc; zv~01C+I*>61&y`X8V)626h#xabzl0kfKyBrO`S?i?2C+Q({~X%6-693ClJh|hLN}M zzI>7W&}gjD8Pif;%o0)EhI4wi7xJL>b|mT0&Zm>5jyv)?!eFV^yEJMZIBE`4tR;(= z4)j)UHpcoYi1OPQEVs*cQ7P1h<0c=}j8rUB8!x(+O7n1(l&JGC=us{^1fR7!KC zXsNfHIC?fu@8N1^y5BEr*@V`bjHTSgq76-~oI+|cqI94Wl znQP5gZG%1^x>fD1ZjaYZHL6s`F36)5D;vJdwwIfh3G^-Cvk5K8E2WhGLhWtV4Um1aG~gc5J!{*@#1v;fl?9X( z|7Etf+BAwO1?b+7-?uXHtTS^5RKgjwOUiWSOPOC*e!n>!cO5O2w#Rg*CK#Ft29$=o z5Ln_ISg(W4{scU9kxs7L`lC(pb0+ zJ+I=}XiwL-cL%qcOzOSWutA(6A3Bel?y_ge3X1jN;`VS{b<~*V(CLh;SV(>fruc$g&><@?iRXM6!vt`@SEiL)kr_|?@8um7xuI_BRzdg))nWSFZGQ*OQi_mkb zKkJ*o0T&7l+OXdo_TySqHCzTLm|FVsG6})ZxEWA$23YU+cbkD8FP7Ki22LC`aS>MA z^I=8H<_fw))Ail{uox)mVrvU#bWvLR#tYq9&!m%zZZyZs&F*+RZ^hNZc-gV(&6W+( z@@MF_^}LXAXR_Gb9B-yhTr0Wr=9hd)S3;Mm@?>1sa``-f%|Zhw2T9CL2% zW!;fkCIiuYW7q(Hw`A(o{%o^5+-;VPpACI7s8Xz)%Lao9qt~|upSWn!oP7nw-pop% zjnA6&6)P(#pFe4hJ5-;VWgQUe8BKF;uSaG^t&E8aluOCPMKI-zLBuXvC7NYjEw=Xu z+Lzg2d&4&Hf5ek?mMTp^^e#~9Qf`c9+r!Q6^`-_6^ms_cGCl3W!9-yI0coT}*p0!} za(8>6$5|$qYrA#3P)I3BUnJS4ofrNy#6PlicXv8&w`N=|PT}<>J(cnYBBl#+wn4Us zUG9!IPc-)0PqOKBV_dCjg+wat3#HoYewjxo3IkI5=5DvWxvj*N+)$Dn)MPdm3TqP@ zG?(lzMcVuH7TloSewB?SEmypTsgx25#cS(vwNRv_sMZ{ecMpf%^{yUGWcz)5JZdr% z4@K1Rs>88J#!;s~JMf;}wH`~TE`o{%WZ8HyTw2VVW|97}Nao=Z*!=Bw5s${L2@<-H zOsB)4WMeyZ@QNXF=uLcmyk0DBX31pS9^$G}6FD^+PBu1UyJ!+Y#5*+J+;8T~^(3B1 zIYXLy!um6a zV7}cT)ru~93)fjo1rz3SUK7tA?wMw1zT2*5yOplQ%|3p6Ba=~+k)$=B)x@i6plJ0c z?8#!c)s<9fKrpUE+ax8D~9u})onjb8*$PgEKSL)$#|wS>yRLcPTxjjTWuH2cbLv7PD_gN za#}tbR2nO~)=Nq$THScF+pL$zQ8b%u^hgvi=yDa0DXryzh!LJbjIaJ`JDo0Wx7lp6 z)Gyach*%>Ph+A_PS1&OKB5!^A8@jXr)6*H9jRAr`t7oFA;>5)(&oIO>(LOfw#eQGH z$=s!u%gkksbU2|+W<(oGHlZ$%-?tkm=C+(v@}heph~UOC9-*?wlqxD7*=^^m{obI3 z=1?M{*<3Ldjv9+8x)&=%o9)l8R|v-gs)*jR0pozlrUUUJ%_?D()E+mQ1NU~pEjgAF zDSc3>&?7NxFp4&tHY6O)jpdMbjB>a&QmB4X$wD|G?T?q-se_Z6Xl=XEUtBNT)y>h4 zvm$Z$=2fIiR3A-{rW`df_s)F1oULx}?5LvliFx4fFQq~ejV|GaMzEJh2JSUI6!$wL zp3#Tc9KgtHsc@n=bsfoj!+dCU-SuX^z2%yuinIkOdyj-7=1i^$@k(m7d$aXyvc5T1 zqDsCeIRLt9Dxs+A&S;|{87R=*?0W64u5X=KS_8M9o_(335{WaH8o^dnXCh>S?P9vR zIW*`>f{&JvL=KT0EsPh`ibF6kyY6r^r^m>#lTrypJ6rHGMf3cvq+R^$4H;g)pWi-+-N!UG zAWX2Ej#k@K^XFWOP+kQc%v1x>++a=@jv`lpirMjc=B{>+y<|2eb-G2G=qbUNI+)TS zg$}ynLLYAymn*Atlf*{quV*t_;4T&E@@m%%15GLtNjBz# zY7se3rgMF?*o?>PZxe3Y=1& z-jzMLkfz&$V9*>c79)4{xYaZ9BG3WMS1-kaacemi3da^^NsHNdvc5k+n;D9eCFEF& z1|y{fmw?HLL*QzNL?w3qDMEZ0&9L$f8 zop>SvfJ23IDrNjZZMs88E|MW2;i~IdZ}c&Y(Qb5U#;e;=f3$KvZx&RBAw9b5E(d*g z|2$47!&Ne}ut6*>c&QBb;|iTjB*&#bTrIo(#nZt`2MZJr=nUf|{9$XmXccp0%~8+; zpBZ;Y+lP&s2wEih<)LzB9BbXo>Z(SL9SKDAO1bLH4iDW#G(`#m5y^Zx7YO91+ku&r zz%pweU%Mz@k9#W`(MX@51(0DU0^!Pb+0^r5=Q~cH?!Rq!_c&A1;R@w~SZ$^e3Z#2G z7i|wUh1#k9YS!(z`^R1?ktEsDqJc>z9}MIt*L`{vaiK_59c|{F{_=EVrK37d4=tZ5 z+Q~rN*(_VdysV1KTX)fK4X+=zdOT|M8nwKhH?62Y(b~-$nkMcIr#_jk`_1Y8G)Sc5 zQt_R|xF`g|`uMt6Mpq$YsMZ><#;vRM(y3jImxI>$ z`eB_*g-!bGAZ|-$IH+N)Ku2~9iZi#pqNQ&+{o zY0-9O*20v35ehWA^;(8PwsP1PZS3cbT%M2;_(p@-v{f74yv((D5aPG8TA^x$eTnXV zQBxtE>X%A$v=}$4?(uo5#N$r43V$@Jg}~?ZWIrkAq^b?C)p#|mHfE>OFd0wQIu4i9 zs;Yj!I@^sc6}_`=R=VCZtJ8Bk8A;*hQi<<2)1UqNWtZ<6!Fa=vDP{tR=!4bwQatT6p{-WbdzgMLIE2NdlS9o0ZPZ z>#-IO=DQt-V0q2qnaXb4FQ~W$saYBo8DY#{w&_%RyT($E# zoQf5^OAEJJ?%#gBFGr#(0e)CP-3gzCYsYO%Q^hm-r7@n(ns)#2wl(6B5`|0|;?otp z2A$)wp=Q};#&KtpYGr)#%)jL6Q?}5d%ZQ{tgBW{1HfQk{uFPY)(w?8qs(^kl2z>S;caIo zA_bf%P-oThe~P#7WE`qEWIodg@49>06%%2D&~g?-#q^&iyGO_eipTZTcc(*3#@UvnuX7ngJ-eUaoc1Z+_*gBj-AT*?ic19(+O|GiyiawJk`Bh)zuuCaTu4h z$*MTxBXdqh3=)4-Sh{g}k?J28^&IDpN1x8-gR93h{uFhe|_40znqcNS#n#+gBF-`2HUK&-aqFe-u zi`zjtXR`D!&S*Stm0O#~$3E8-FE$oz*-o8@jP<@}W_bpDpwR?>WPAPi*j8e3obPyo zZ98!hGPekvED638KTJl$ss(3x>hUf@cv$u2a`HT6t`B`gr02|bUHXPMH&4&QOgu`6 z#43<&l{yO+m$&_LR%&AHI?vQgZRRsl5(!XOs8cB0>GPnmIP_)C1kLNy;kahBmXFV) zES53j6v+-}UHam-U&&b%f!MVP@1mpq}k}F|{IW@e8b)&vwpR=i;P(p!i%bo|c>D|c5f>VVobw`7m z(cmnWYARGB$I&1&KKJ=jb?+us_`OtfPsZb_SzA6n&b4HetU_w|%9V`IuZ|BBN5z4G z*5ghFO{2CrJufuwGTEoP^Tp184&=s1x0c6mz&Inf-!kfR-jz>AsG6_~WM-=uJcHj5 z8pEw#AF(d8Iy*gWFhz?vYIQvSn$M?>?q&`u7#h;@O_*DbvD{X zAU`~c!vx2MU7=%gQ?D%^pIBGi5G*c2BDo8Hetb8@86?l}t^o{q`S>(pJ|w`ii4ChJzCf3^e%-9H&ohm+6Ot^lZK}_&v38s$*bH`UJndJD70zqPJ_|IML3mER z@T>*!>|{RFUvwA%I~WhtU{Cd9K@=D4$HOStY0fu7N@s0wn33FmQLu5 zdzu>@=e2_DVHt01zolE#)633EL{*61AoNza{H*j2s|J_>n9DUh(e!*cE}IvA^(fT!T#mcNJbMxyl`RIR^%+<+}yTJ)pGFm^cEAmOTEL} zsZLjH!be7#2v77=qI$jWl*qIq|D`i?TP3}B`+DEv8P)`Lk6ntMCn|DLHT)h_h)-Qo z*joFS=kCv3LU^{xILWi9wZ0orLoT2>?dhar6l0Y1uS!H zI(OE!wd(rid6|nw4T4$_S~+{+*QfWhazVq*VYepJZbh%HUSM|dSc%+UuukNe!t^*5 zLZr&SKAd%Hy0d(In~UH<9V(Ld%3)}u`?;g#*+jcOo?TT7<=LYMu!u^u2`~;@yS&H_ zj+?rMi;6U|;d0O@7?ac2gB^=0Wc?SZLoov9sn+4TiBTcoe7)tcWf-I5>#2ew%Ee%8 zrxZR*HurlpKU2zix{Gn!&=I;1oj8X<<*J1D|9~`tw*(7VSN0~grae%O#Er3;2&a*!)>RKFF7Owqp3GlwX^>QABTjbj;`IX zl79@C%hSZl>v)p!f-gFTTG>2*-I_7)WhP}5>cx3(z{@a*kc~}u(??`aPVdKdDv}_Y zS)$IU6g*2bZ};62_GH1Rjkc3|UhUof^6cUug}+tGy~dZHKLxGD{p5?r%d~2Dy}}N2 zHZN~mD;~{?`hcRCzqn9G_v>1LAYI;S%~t(NzC1a-9@{@B;sj-Zd8!%VbD^P52}w<$ zY`mGE>G$?;&r>xXF7h&))I_0=<%4T!It?1Dy(Qf#)#~Q;b!#OFxuGSIu&R15+pw~- zrIj1AP2bKI-6JbYN8-2xsE4f?!Luai+AZQT)r`g%qggll`W^?`3Ll z|Nc76h9c4f)&_Vj@l&w8Ik_cFNYki6v7J(`vUqu4TSO~GtDqD*_xU34p0?F&t|V7s zG$-O=x)1NiM%|m zWs7*3OSe^qz4_#d?K>Cdlp~Q^V+Wzu3)5C!* zC59Cm)~3&WrN!gCjE!R!VEM$?6l?bQeP4_D6ZkxU1*~hAXQ|%(O-n_I*GtXuVqD4T z-NXCiFcA*xR9ecVPW%+E;+-P1n1E`vJD;`mth0XowlYGYG$oN`oL1S-XNAebbtQ{7 zM3{3tACwhieEN3m#KU2#+Ifa8I*YgV$3Y>h*~MaguyPx?vA1t;n*zo#QjuKuit_oQ zI6G}^iHPUR?a5+bDy7-!PdD|XKS_ZPx#4xqf0pVT_Z@K{5Oto+-D)=9*uK0j%}^jk z7DlDjE@yncq6_U4@U!wZ2irFk%YFQDXvRZfDI}$6MCGD&4u@Vot3!@lG}p;y8{4Sp?y3yqla&I-DogOwI$gb4LyXt;VrFz%TAV7&!!u) zM^@OMMhI5`DpoGe^OJ{dErSuPVM{EpN{ZIMXR~oe<(t&8cREJoJWzx9aao$Be0{K3 zG*zX%c=~=_!#6=9s@>_;)XOuae|Os?WKHm_Gg*zT3~cu6%R~=`bAT??x*aQi@!49Q z7G{P(pz2&LmYsaY96!DvdhuWc6NAk6h8{eRwRd-Y9UE8Iab>tpM%MpzRgPY!9lKTO zbvco9Z7f%fY3Iwm`RYo~Xv5>L4?`soDab%qZ6o~2U%Q4zn08U4TkWEuD)#F2+qN1D z#LzAr(m8S$XUg#I76ZS42<^<)<5EiP+;JcAb}C$JusO~6+2``?w7}s|G}PK)wdkmd zIfZJwi6D&DVW6gV$+Y)(-9om26lu=ZBPW@wZ(rV5PBah`(6(OBPP5zNa#M+Th{a!zdFDir0!Pm15{DP}|;n)7G{61W#TjU0J@pUpL~RD1e5wL9d>@I8P4` z`?jRJv)i-f&{Q;U+G@RTG$!U3x9cWlxgdRRvRy;&75K{U%uT`@pMZ%HF-KhZN1}7i;@HeYP*{;*&?00 zuP<{w5>zPVp%B(goL`#r=AV zb<#@X_U-G!hy_!Wgg5#im@Zu_nQPvCe;wz; zK~)N-q5s&K4~1oJDk=jx{l&bUPg(QlUpd-90<+Eryo`a8{W}K26-1`gWaU~ZrFHlI zI@Y3o6k+-RcdW=KUukummD5@g#Ml0O)zOmH^yT}<(!7D1dEcjG?|93MI9lY$+AXKE zo#VIHel{A$+yYyafzB@N^=S&PDj6Et8;fpEvF6Z-4M(=W)GNJyJ?}e*Bi%G}nIdLL z!(C4;CEGpz`Z7?%VTp1y>24l53zmr*z>z4*V4x*e+upo?Us>@;RuV{An&LapyT|Lg zk}FbM+nR32Rw_Sw{D;SOB9tVzjS`)%5&9|GI-IWbY=IO7)aOMrt5kR2f6VlFI1fZk zz1OcMFD}f*X8%erNmOmMF+6>2_ze=@b*j^5w??S`!V@?had;?~j?`XoBeGAL8xXQ%@B!s*#<68!*$@|9J1G!!Zj#jMM4c z$vKs=H`C_) z<;Qg?9KhzWO%f~N*}3844KFh)g%Uc{)KRtm@z=*jf-6goB599i>=OrjPs&V@K$+8- zubNuAe)Il5&V)lCHVAMl8>L5ga ziq`gzLtQ}?1!H(N@8}tO`}Lcv27*|7Aggv9<=kg3p4OEN3LC2Ea5f~w=RSVl5F=5^ zvK5qAEpU+=JZzh+9&ia~fSWa|4eq}`RHMNteiw`6(^BM9vUzvvd+L!|0xu)c84WUAyS^7{L|t`S?xKZOvw8Wp$c24H+}EOKWIlg3rjOei)n68_^x=F| zQuWExpY~=nkj9QLlPRkCKV=6Gd(n-_bg1=bE~;Da{u|DRAoeagU8iM4J|!AA$DxtS z6ZFTiFelHiw)^@%Oof5~$b;V9u~KINd-XWCRH7%8e@>=7BV#Te-?w_~QYG9_rm81@ zd7%v-w)K3@kWA4&sS}y}0G{r|FJr7s5U2}bly%O&0Cxbhtvhq;TBddT{?9o;ABizL?$^ljCHN59doh$VE!_5W#24%*TZpT*6e5Lsl`m*+o#b?cZ+@OgtX&V>Lz(%Ec_;D;p{b@YdWpafL|4-@8!=ZzzBG4wderuZA zI=(;G6aEOV~Ax+(!;Xs9usk1TfR{{5~V4<%rFf+wwq zKc!m7W3TA(>PCO+HnLjt_Uj8=F9ZZ5$BI7lDePkZ z3i})UM{h#6r@oOb@(fp+oWyK%_wA*Z_QTIB5Ot?46WTpYtXu&)s}L{i6f)N8`F&-? zeL1P0CoGip`3mF5T?>LG^`=#t+)K2Z5EyIT ze0}Qw917!FCRL$@HW#j~AKfzgb;-c(F9d6EzJ6V(;b2~9sEvMo?lb0(8##M?>fOBUQgrv}`)wr}Oh~~&yVuZypR&FC zyPl3P=Ve!}n6juBFTGSK1gN6mtQ(0>QRn(`g62quOSKQ7v9iVM+g6WYf_))hzgtm# zpNpf19X>1=5k-u%p_zvbzu)t+m`sS2CeBRh9FIiJbRcT#1MYn`Q`^12xuk6Bte#5o zG9d(W{WxdMQ~^4@@uF8$P50@2Uk(Km*aV~jV9Q+O`Vae7J_~w}g@Bn<(pvBS`(ry6 zidaBs!DQfQ@y5-E3@*X*-I+v)ZoYmUDZzkVr`HD@O*s#imyZjJj1V{)EVgH)jM*>m z2Q%VJ<1~TmHB|pawts)X0+lTyacF|V-n#$x+`uN3X82?*DTyNFWygf=y}fU=@TH1(2JrQ& zc6rG?yXIvj-1dzjIl`(we*S(mV@wDe9h{kB=mPWOKZ{>A=ogT>Kj&8psmumwpzdkWcL&uUi6{0la*7I&uoy z`2PFJ#%2&OU$WXvcBpkY40I+hUs~h(?X{x>LpW8Wu%wdu9J4paahY9|vWgLY zF0FF?@;*w%KXa^1sAXp_Le~6oQPI$Lm~?MS;=zaT2!{&P%TNyD5FpXrBhrjJEzh`D zcD^)ue817+zN~kwt$M-lQwPVJHWQ-4rhYXZ+M3=!etobLxK;2^aD(tY{ER2?s^lGO zy*-}Pi}}{g+jBD&3Ud=lc4(I47jftMFfPOOB-k*XwlEyGzr6QSkpKm#07o~8=0&X4 z{j@^WgOolG-3~^<;^BRzB`%7v4?(BR`-$q@ubbrPP^jM=y1h!y#LnH5QloHz1Q)XC z_i@Yih+x_2MrSx89}w})~f7z5fHUunY(o&Vfmr)Rj|^$Y3~jV#bB!{+KFTB&GgEka`kN&K&0*V&j~ zr#=c;4!n-g>;0xl{)SXX_ooC@iujbSH9P@Q!2=ea&IRf}Y&&{ZDwFFy7eOUn9`XUn zsuo;s_)wUgzBvpK({h0*v#%EP=Jo4yD;10oZpAolTFK8*XLC2PsNn~tq$N9@bzmRt zbO?=r&2LxIpF;T3r%oQ5f=LgixVOuzm#>pl^ini58{pY2u~lfgp3n0x8--|KW{P-J zb{LCU^bd<_Bi%W~cim$pttfI@3u* z%Qo=cHj=@x;Ko$@Z9D!`91U%VxJRw5!Wmj6ywY!92dS8!NsE4ph8DKwCt^QL8pNH^ zv_qQ5;^q59iTcs>$XjgJa_2#P`ru_mQMV))kt8#AdaK1Q^CXs7Jfr(Q=ll2DHs>UL zTYBygm7st8b|R+@FCclLsEnacsisUi1HdjjJ$A_*so%c6)RVyo8x68YyBs@X(#H=S z#iMCT8SKr=_hC8`FzYxSXj76o3s_7Dm5a>uYI8X45>t;jjQp9PyoF1U?eUwlyc$TZ5V;iSlD}X6iO>9wJUd6&EqHj`r^dH(K<*7_4D_uRNRlwM30+> zleq|&=BHU5|37MO<7(Ei+3DvW^K|6G1ii?j;7vOVpy{paWQO7-C-saN0S>nx8zu3X zkPS&8t(tz$!cLo(x6}Bts7``UAAj9LLb)d70p6F1llxktv16*{uBhDTYgWWD;c~VINqKj)ep4?P~|$E)hr)kD3l-W^Ybo_#BZzJb7-< zmizOq9ScTCE~PzCtET)hWNlBAFKU6XXqBp|enqWrU%s{?p;)c{Me>}hALC5Qn~gG6I1us1U;^{i1gL_ErlAlN1XY7SE(mJa3Mq zJ(0{nn#Pb#7G#nR5|%6;@qBwrfNt&h2#R*s|Gb`_^WzR$Q z_5H}olY~H;#?^G_WS!mH*9Nsv%{Dl704*uZXZPTZL;eD}00Z9jzrDXyaO)xpDfDaC z2?k_UlV6>LXK?fFhpu^jX;1-y>I{1ae7wvq6o0W}KK$0SHd` z63;N_gQWQhiC25fN9O$6j9ny&)S!sB8rh4mb;F!V3**iKJu-42X!a-SPXWW^jia20 z?VIDsQVqd1uwkxMLUoK24#s&GL6ufr&SG~zA_)>kT6V4&hi6{j+u=a8(dG<+3{=iS zWr8g5P1a?TQplXe72S;mgGBNer&-UOg-V-;NjY1P)F_<#;|99G%lBT)AC@L{6e=`w zgv0T~+gVARDBH}rCeOSNW5EE=lnjz-gtx9Ari>%ix;!&%=1eRXHy-d;NEjq=S}UCU z_4&hsh=vpo+Z}RkC`)?zF-rt5EgD1+E2|cW8qXe=7_Fpj^UQSAQjPJ`_vOz#L;oIW z$E06e=G@Z?I|2Fzw{kRTlT&c~vB?E4O4KMzubdLxW%RJY(w6P9+v9OtL-_o9rw4pF zGC=7hShGUs>CWl4tt%ygAZ(C}RLXUaKaPcvFAw%7A@fE#bRiLzZZRX!mFT5zucWmP zKc1|}MVi`RK^(E87s=-FNLZyLa=$j5kb+R(e|xP*eKAn+rIi_OxTv##7@27jGr(UH zg(~OZ^Xn%rgVi?4ESx?%j=6orcdRjInvJ;QYTjDB{yL-l#{!fVxSU#nyaPfs@Tfe1@uI$uu5THDmbn?WP#^ zsW5wvwQdG|xRTKV(x{d+xP>#Xy$XgL>BlMXXfbT9PIJ$D1PEAv+$U5y!x2Myp&?KKr0Z+`OY&00GbH5(joxHb(Tbzf zw_7uEnMP`ea$gF={Lm>13S|J8AEQyr(CfRm*LLdjM^v37OZy`B`hLpGOaPWzy-63v zYW?yyOb3J1)f1#?I=RnbV|G6yctf5Hk)3hBTCm*bZwocxV?rbz5X8O=}L zR8Dq?^5|xN)He0T?(LD+GGrCf)c&RG3P-|lYj7rA)A1QHc!01{6_xz2te z6)6<+SY2PL&2rMg zbal7u$f_D08u9c-U3+lzI88@`6);r=y~2!z@`F9KP&9``JGDC_Dqt7KTPqdFfG$mL zMY);}C(A2J3n+dOR@>-}uWF+kV)ik=Lu({TfowAx)dn}yI;CbbSR%b{IBs+|r)w<{ zpz@Gma9X9vZQ8C|7L_eB3=E;)pb)i|h$I9%oEel0Q37<^euXk71PrW?Y*F{-G)l&U zSk)b1%1TBgQ5@_>HZTV44W(qgap!7xTq%igk?IYBGAkvbT6^o(N*e8`S}?xuxZU48 z?1?fdJzy5ao2>*g_04s|P%*zcq_czJP@mnMTG42@4N!(4K;(l7Yj)koVMko9TBaXe|yP7m!+G%QfsEU2tO!0x64Kpx3c z4iOJ`)LK2>*}-tULu(RjC_9Utzg#uQ%)-|o)t}Q|@9@0&IUF)Nc9)z;i#ijvyPH^& zwMZW|7|FOXd3xytgJJ418tiSg;HMJm2C*u2I<{V=e!jMTc`yRObRWE0o$H(>jc2>z z6pMh5fLA(Nboz&vc{CiTcB(xP;_PxXq7QciFcsOf8lG&j|5mT3qCc1!)VhFS6deVC zh5g1Mr3JTc*{lzj-SN}w*zXU5sn{b>ThW6Nb9L9Jx{wuR zZ4~FyX;CgJFr`-6>Q1Mv)wh@0xi8(NM-fC>&0fUoheN$ceTmZ|*yk>~!^dA20ly!5 z>s8ExZTJJl<-_O;B^FqH#K_j;&hGuB1kbH*72Zd7Yy1+A``R%xiMbW zV@s;tCI#b8&X;s{w+(Xc=>~0^%I6mZXO5~$!pHtT6u7=f9(?JR8&L~iQ zdZ-5i*-@p9B-06>rS07{7>ssJCrf$gu1D+FQ~9$`A2(VwkSSHum#O+;ZD}f{7uae2 z`F65-epLOJrBNMtPOac1f|>Sl21rRAEx26k&o}d%r%fmrZVm_t0&il5sJ=duEoL-| zc%WKjj7$%2GhZm&>oF}|H4J~;Tpb!X^D8=DK1#S(o7*SNAJS%|w}Gl)ru}OBZUJlq zsjp6_>2CM??Ons4O1NDrnSo(c(b6`%a)y_XJKUIVcDLKxRwS81Qx`{|0g+V}yILk~ zkTcflxQCbT+d(Lr?5zgHL`EwXBOzmOH%MNF>+V&zHNE}y-|y@{DB5aVGn1KYv3MCX z<|GtcL6Uf(b4|yzy7cOrvA&HSBgK>xcmNp{>ShA)KBMX z|7KfN{{FxDAO5C5!J?B-)NcOWfBp~Dpk(rSXhbwFRP zS=s2{{&W!`a$f89M>n_6&wCQod(%!;Rf2yPxJYFU(4QvL{bsXY0FAmDR?^|izxTz+ zNHYih_HwabY!_{+6t+Vx?Y}q=2>Rx7P7#y4*st3)V?3<}|29IJd5VPh7xYAPyPnx; z;w{;;^W^ln+Kx7(KJ{BlrD3FkX{BT~*U#^-`wl_a@E`pOnP2&^zIyr7J(#7_Rv{ZS zZ7upKm~RjF`^|M9uU&)mej|Q)k;p>G+x=+<;_?@CI)&jtFR`@w_OvH*v#^YKBChJy zQdZB`TKm_xyKc`k6DcK~BAtiY`sVi6Z@>1PHX<_?3MSKqOeBr3;QQmQIRI}ctHjeO zT}`F3jn$u?5B(x5FY0N~aHzWgFy>GH>2ys6b*GV0e35iK&+IpE|K<9Ts)^>X6!%}m zBa;2v+yC?3L#r|CjLY$qUs00r3(#oZ{(QT&`t4yWLqRXadS?`EAOB(d0-|-t;v*}U zN(7axv-$DkbPFF~3ps{(+!s#Oc7Oh7AYBM+e5sg9Dt2-9_qoP$`;T8Y_;z|!dVp=C zL{q_B&wYM=*-8iEY^p?gUOJnMYWDWu|KsbdU13|5Eb(1-GG*WV!>{+-0oDsqopi|z z5JxvUi^o4dT~k5O)p#~lP}9i^t$Xo1uP|Ma@TShflztbtvn zUR)OJ?&0;@!?>X+;asC@mzAVHtY+QApZ|kvmGM056tz0#{P|C+;!>U7?+-?;Y!L{a znv=^D@W^F{_lp%D7Qi~CHP=YX#tNCN+kRelCT1-W@60=uDmj=&DT6O`>kiwCUbcd} zpwcRZNK{UTwZ-ZhxTMyi3aAGl67_60^66(|(RbZu-7ODoXE0t>HPxS`f?pf1MiaZ; z)fYsU6>y2Il$FUiO%(4dF}y}S&8$<%Y!@?rl?JhBDO;Ls;Mgp;zo@3bd3S*~sBF4J z8j*Lb9yws!LFqD1K(6bUxi+rVa&6|WTL9zt22L5Eo(Uj0&K>O=3V#MJpvXoTU` z2aLZ*F_lUAEF z7~waSFSwi#CW4qn*DDNq+H+Et+^*9(QTm(k(hBe(m~FUl2&Mtb&iLq!0^inhI?{7V z9Ej3L8%yc~E+4D2Mo&DVVd7(=1QtL!!e>C`N%lS!Iru1u-BH%s0pA(C0}`9@>ho=0 z(Wb#KO^gW4kVC;hWHeK{j(LtHkLwE*F{VuJ6*cc*k%M=|yeSN3)ZZ}l1lJDeGqgei zdsKLQ;HXN=O4dsc@2U-WHR$Yu4@(@0N;LvAVqr?Z95fs-2U$69rivPL1KcZ2m8N=v zq=qw!HYMyat03AZojaK}Bj5?9b{0@OZ=MVb@*6*lLrOCKyN})E2&6A2enEzjUtqM- z2!nO9HZ&G?0J9qGIcWez_a>>Q6j*OT7o@PrdzQJd)qI5eka(K>lXuA!IRth~uoeXl zmN&B}42T`YfMWWBpbx4Zv*PbOE+}sv{+djH^#~fCv_TQ%J$W~|?cV6LWbk&Eq7rft z#eeO=-SHlN*d`{<-@OxMwVqfL1Vk|VAp<#V0?@3V{w%U(0+Z)_0i{kFcOpADd+==u z5An1IR49uO@J4>YBxt(~J@6a2Fdy+DbSDlQ{wdA7Dg@l|c+nh|A=xAz@g~L>I3Xs$ z-hZG$@`=n>8gK9+bl`o!2u#3RiR?TyB^g;VZ)vguHvUKBQ&O-v6Zzp;rYpBho)!E? zKB5hj%ojjmpaJ-Z3nL5VaYp{YGh_|_UtM>?+}4$*3Hk?4baX^_O|4n!u+x?(E)LJcR|s1R<+V8krxN&oO{-9eP4EEvy(Kd z3~k$JL`Ra*<6sWJJd4oRRhbM*grx9KhJ{9pF@&t0_iyX!cmsk#DzVn63K@?+jYhWT~auP1vHBi1awN)T~~s^giH2q>Nxw*F!V*vz;YK|?y4&_?;v```t$B*Q()%wmMh}bfsd^f53c7h`FHe7@O(YdV38Q1QT-=SUB9EY!(t3@8Vc@vAbMcKipm|XU<}n z+u6)v>O^k7$W`btf=;flp%$&cYvn8XY(A~+2Jg`HlrdsF12#hSY@K9s`$Zv_%mBg{ z0CnQ9>d&q}vM@AGiii7q`MR9F2-PxYL+btV`oX?b|?#(ecLfY4GHmHpT>-FOD z?)E&~LI>ae=66L0LRA#Qq}m^?&bL?hSBq|aSTBC}H(%vYPVhO+jd*{(y}S7!-L5tq zmEQdIKb-K;oB%1CVPRa}0lea#Xutv?(m{40XN=YZE{e_V!^7=rZ65mN!*AZCtHn%F zO8Kx^?3`UaK3<|KTA~VGnZw~XYk3a*o0iZoSolim5jHCp& z^Lt-?CGOH097oRC?epDgFj*~!hOZ_n_drTyU<_Elj2qYU{@7W?f^s!5+;6S z_TBC6?Pk{PPRDbbw<0a~U0U7)Bh%^VY<+!y2Y6C^H)ME#OzFLYY*jcbL)H));D`HJ zr`iNL&lyxb5e=NKIxqn)h;+L9aJT4`OTERC2v|MIfcQe|Ap1%x-TLpa%( z*~0N*=D5UHO{6TfXBQ@ZUd!yax7Qbx*5hnO^wfOXJ~=opc2;*EZnwkYyQ9IwhpTZL z02)heZ#AzU{O+*Sy|{;$GA-}DX+QsTKdpgEM7q&lFB@-vvv<;lFEyX8`pjRqfBxwT zdWIbPdTn^wPyfSj4r{ZUn^|XiF--4QKK+k>S{w^Eo&u2>Zt4er|MhWWbxC=cT&{_& z*Z=-ci_ACK?y4^dblJ&%^HruXU64ly=g+Hrrtwmwv($F(vwuRx9nxV`yC_#KxGi`J}?TyFf=PD*b2urJGUSQ151N^ z(cWOOTHW0*x)KjpQwA~kK*zc2a8}EujIWTs!4^0&(-@VIwR2 zEt4y;{dDK6#rf^$=he79x~3g7`*ey2hcehILY|LHD2&<&C+6eL(~s997=Y)SAu^(V zGj*70jZX_lpot(#u>~&9CX1Wr+i|A~5MdthQ2l%=BPF+(N@Y(9_{KRH=F{c%$B(OF zqj!0E&X#%FEgv2pxBGyljs)_#wSc4saLP|llhfkxoNHM)==aP<5+aMy zX#McR-LP4moi7G*S2_)<8*^PX0||-MlsJe}V0!iO$E#kAeFQ?P>!@;ckZlZ4%ZAyj zxqpz445k;);($t(@U_%jpY`<7F&ih zPGwF?u#5>oD4C{L&X{h!iJ>DzzfL`Kn5_>Qg%rras4A!|2lMOakKi0@6GrzSTdSnt zWO6TO(giQ4PeTaCntQ$;G)kQ_z_qU8Iz+OfGtTV*<~2BTrXztFH;;FtMxlX)!3Em$ zdg(laWjQPG3FRSjl_~$~_Tj^vy>_;mbJj>*OdlRMMe3$A;2D!k0cdS^bq{ltvt_+> zSXxcTdxyp0w3%~Svjx^V;G3Jx@#W*)yj5<@;V#xOV%1gEn)OQ=QHVj)0uQ%S>#Xk{ zFNaMqp>rc8#vy;0E)OToyo?f-M=8MaHR_{_hx-lLe1dJHF_`ok$Ej@1Z78XLvS2~Y z=7U;ua{b{BbZu)2gpawjTT7>Mtw~>GIkRnqWSwCX=`625+@PM2zaWB=99}lwEUqQS zT3kf}Y8KJm&E3Pz1f1I$k1ht`R&-0SsVF)~cbqh53wqk%{O<0;zg@`1h&l$RCx_XZ zfb9~em1#zs0@Q$s^6qXsXhy&J!J#^5&GUFb!DHmrEt{cVZ#l|u*F=`lgfudy%cT!< ztudQ7RVj({LF-YIc7F$tw=ROkWh0ZRl5}1v5NnS8o&h2T%&+fnW>Dn3-Fs(zyKs;$ zG10Tg3$e%bG{bwsE_!o!=~Yhwr!;ZeHFJlV@^FO7gvbzJ&YTn|YuC3o0c{tAVyz)c zp3Gsc0UpLHS`9*r(0J4uqwW3eqFt*CfaG=<_bRDWzB^+tCh`O^kjxZL_!(h={k0ja z8y$Qo#$f1Yihj@I{0IDoY}AmU{bfDLF1soyW1sUV<6h# zbR@qxbyVoiP{{CsGmMk4Mo9H$S9cd+1UW)FA{K`l%vQ%Bdjcnp)Q5Nk&Lym}n-#T| z=EkLBQKeJGE-oG0i)=`Oz+6>7onG8sO}L*3yW-{sonllq0h=b!L{-qb;fRZJza^Jd z95q&tZhBz@&lx#pCwh*Lep+7U={T~`P-&}neB$dT(5 zQkI`l5MH-y58(mdsk@48sR=b*7DNMdRKjC}%%UGw*ch5kykUle-pI`0ZVro_54znykAg2=bM7cf|^VkBx+VG`C;>2h=fl2)*lN>lXR>CM9yE^Hr<8F_%| zGL<`>jhgTQ%$&}+5*q#Ud+~6IAy;_wU{FhCDr2&qTyudPwWtUr)!qH3UM>w6_MAM? z)68MMi%_Xhq^AMwm&)kizrMf3@77sxlt63m7LJaa8la9?0m8lGOdVW4@bi=!iy1kA zR_1CX9Cad#o=K$I3znY#`NRDf93u{xI^@+aX-GCL|&0q3|q$qD}?@HaN8~QFE!L)vX_& zR46nYF+9bQl*H&ZJ-=9qLmyyIvO&A8{BhBB)oerJ*?6|uZWx0)`0F?wTc=uT z5F{HV9vGJh;JGQxD!5agUWe;1wrdAE(#++9?aUcRr)2Li;>E%(pFl*wZpg zV9qX=i`Dhj%ndc0F1)*}vTVB46a9xF3{t#J97?Kv3@2@2sl-i|J2-AldNnxV#;)EN zFE`80-SxyEZDw(MRZc6h9$=~D=-)bPem1USaS**rX~**ITIIvz>U3B<$*P3KNoveF z$CL|Vd8HLud(B*`(4IGsQ)y5Dj7DeMo9oLfOL=j7Hf2$wGiS_TD|eJaLPo`(udi>f z*1UC>w~KKdD0~e-Yi}l%^C(~|yQB5phpR=Y)7gGFKZ7XKZe}xu-n0&Qy~LW>pWZ%w zxC9k3{d{@J#aVJg6kDrN`kUV#nbz^}`s3&8qy5VAj|L-8p)T#^TAN||>#q)EZq6om zKmE}A=AijQA(HQuM4ask%c=OUfexj zPJ&N_>-zX;FLhw=HzhrRR9s)*%*SmxD3f}2|922o(Wwc*n675?n|pqU_GC5d7e(S7 zWu=2s0$998SD!vXjp#2%Ju$qgO7S>dK#@T3on1ZC0q6AmN+#u`E(wTX3SwAZ@ljgV zQ;I+~AAu{L4VyIvg6SADGn=w4Ahc*WfylXPmSsS*T^GtCom-o$&!4ZRowj52IGxXy z-yNh|v%BpY%cqrk9+7dB3?u;|qK>FV!^P?X@Ew=CImJO(te?(D>j^uY-8|t0C<^#d zxIMgv*H`V&mh@z3rHAQMiB><`Jb*N7FE7vM?@Nt(KD!5gtk=6dV;&KOcmt3kfaK|t?WqzcM*?MAlKgJOmUV|LD>RD6Y3e8w zW;p(i8TjRek!CAF%aDUvROoN-E`VrkujGxkgs|>^ld7;a_BLzLSEKoMONMJ@jeWK* z@^XO)uCFr}Xzs}2C=;r+0&J7(DTDN4c_{#?-K!AO%P?%9{GPAL>(J)LT?t>=qy3{^ zXS&LLM1jfo;V-#V$siviAsptW$4 zjG07B)#2id8{T{k-&b2>u*CJCMl7E;mgmhDiJc_Iq;DM!gtLq$O+a$YY7LrQ%PrFx zEU|XFJwefmnrEbZa32s3b)qABNov3roF zM2w@zNIn1^j5_!cFvn3$nN)*2HNKM&E;BWIPX{IkOf+FXvRg;3E+eXZ{1m^cDvZcs z)eYNsB*pNgcou#jEYyAvn;XvrOE4}LtV&^m7TloX@T??e=RW54aDAvOX(KGtVfZIS z22qSL2)_wCvrog!j`TcfHv9qJHXi#c%-Oaa!*W=V^+w?^*fYP!7{&0!|t0pDqLaVxk;u)Th1xRk+Jaq=&OO{TmXHmF>;!}xQfED7j0W= z;W&wz@TG9OgbyHGlQCM+59MQ8V)(ST8>v`KF)gtU?U1A&No8DU-r5W4Zj6rw5@Q_g zC~c)^m+ed^V!Xl?WUgb(V$QW6UyT(JE(>F?nCWpRAV^jX7e=hL;3tYVk8KmkNXZg0 z(6KoDFQy|_M9g>6-DImIE;19Q7vi|X5#pV+7R|;)#gEY`U$NzU64MxokFj53bd`w; zlV-g|SR0Lj24eqlu!K7?nP?*tDTA@Pqf_xtNp<1cGhpGlQYo8Iw5hL-lNfaCLCNS} zd?8+ymq-Dfm8<4o^B7&zeQ)NwF)(_G#5*>l?84;jV`$?Qyj{Fx_@$x|Ua8nTk)9pi zPJ{0xOWIM^UK%^IG-@!kL-z-TPKNegaSl1{&SrQ$vB)l*dyvP9=xB180t1`SQ4H@Q z1818{3>AI=pMC^KP=k2-^;h4dKrYjX$K7nMF}%5c{z=FO)F*Q4+ppeam`!?2NAfu8XIDOZ z#BU=?AoII#zsuK7s#RDN!)&!Rzq|kGhx-kN*nIxzci$Wqa3fS^H=8N=l*z;AKYqTR z1xL@x;cve=dWScpb#^(Us*e|+fBM76)f8G(fkA%no3GPH92l1);nl;{=Rf`FgBz9l zTx8AthWDUK&=tT4Q}o9_{~7k(Df0qSiu5zCF-I{24A|KVH;SC2x;;{JDk z3$}uPLL5+Yy7||C`{@$<6-tt-*o?pW?|Vl~jSG5cb+rBS|B|-=L=8)FJD2@G|0}fN zk?89I$$b6O|M=6LWKfC-B&+;y|I1fjF{#aYr=)Ry`qzJXoC?54F9qN-^jN(I{a0V?t{PB-Z3wH>k8Gl*!Z@&7+3_-CwR_}QG z`JX>s57i(#xK%ny{r#J7B;!uyp|f+{{L@d5s}`@$gsD1zvj5c^0B~{;+y(R1;~)O; zuoO2lm^&kjM{mAP=&`NvN`e!6KKebadU;q$Ux{#HoyN$GApeq(O>v&YX5 z0k-q?(T6|&%T1&DtpKFLk*urKU;X_XE~~qno97>U``?!T`TzdoBA?kSWC-Q!MdzFU z_V+0!keki=^3w;rS6BbvAGW#g;47WbOV+J}zxwO6`CF|v+s}Vk<};mt`=5`^{o_Kn zw!eQco)!M_|M&`O8!l!N?>~PYLXG`jh${{Ur-kqSu~-t!^SA#1j1=VV<>lSyKmGfo z*pcm}(D73Y9N!%59X0ZqH~ZjOgCgSY(@+2Wr%$~~b@eef99?|M^diO!jmM5j-!z^1HwLx+ss0hCmaP$jZFAzIgb!#Uvj2Xdo`()td`B%x4-@7WWDO=(&AYL7V`RPGwH+f z{AqId-N9tu%BKk_*{{Dlp54!?seetK3f7Y6Ox(La8Z9^Z__CKD;;9W4;8iH)c1RgVs;JQ9GM zPAlJi{jPCw0s9YC4bvWX_Nd;Re){RBi$X3vUNpoX_3PPx{Ce+nGYME0@u5_&^9#X3 zmp}aY!!(!4PC-jnVd9&<)Oa%@h!Rn3RI#V>oG(6ncx+|&vXYewZRn-oXR7BHV|H1@ zea>e1&A|nA|9D$JK5R_sJmlf}{@eZb<&rB5k(~q+#MGTqXLkSebX6yuh?BC_4Zq&Q`MlQ_kl3+=`S^S*`t_tQZGJYd7T&!*ZlV!nGM1a%M{_^IC^)|S^y#6C zGY%Hya0XN3ySM2EzaZtHSc){f6`b7q@bdZl`(ZAfI(0;j$K}Gi@3Ph9iiJlGaEp6j zL1nG=Hc!uYJwcG*q+P33aP67;lBG=;8)Msqr|%Sg*7o7!{h;vsZ09{@?oqvR@HSmp z%o+Jm;_yDi>z3-n&BOEUKpbI*xo_~x`xwM z?PxDkTdE6WENh5TLl}aC&HeM;xO9@GRrN<_&FbOXOcgsj13ZFr2oKAV76;r<50VAb zg4z+0zej{|T*kOA0;mjuHR@`EQC!@9cvw`6hhm*ZgL$)VZ5Jox4!ti`IbG(GLaV(Q zabnTPr`YjF!!usEcWGg%%*LnHQnfQaqt?PTon1dXNuWPu>=+Nvy7j_-D&JqjrLv%1 z%F{W^Y8lY%!}FFm6kIg_uHf!>W%EE0AYgIBjlmytvMa^z(x@Knr>i*LIe(PuPnN4;8yHqlOi2h&2}7HX zSya<|>GDjx3z*0<0wl|@&4|8!_#|^W3k5CcPFtbcR~J%js zfD`i+wspEF+;RW}kmJGW#j#qB79S+?ABDFm>Pj;c@X_Mn+_ktKgWK+{?mj+DYbPlt zcT_@2i{<$u^0ZL3bSDrAU_AF0ch3)J^^=tJ`lPNScR$13-(GVbU*Nw&w>{tQ1T5aKc3)JEnXlIR%EB9ATwKKqdGd9`7P_f#m>; zy`yO_Rq>8p@5snHo^SB+6?==@SghG2a2LiNt(|wA+mK}@DV|bwwF>#&J8F?fmjlSc zkA4ZN24iUKC(HHlG+zWR{QNMkXOHwti?KcA;TW$kbDIr%nYYL`j zb_wr<=$O)s_8|~Drjbl8wWzzedwK-L0YuRR@d2dY87|>CrJD1;6U(c4QgF(7#d`Lb zM^F@ayK=anX{?skKfdMIv}+*_rQx|$sa`pQFr-f!ZWj;sv)#>NQV0InXp(|fz1new zzzVg#knui-zTZ0WilYGKuPAjYu~z4g8?)=DXF2$3)^miuLL@l#r$|#PwUW6eakvz6 z?ZxfK4`T7<#W*j=?HVpTvp55ety@-?HF#3!ZSJwAR?^3OWI~ME2x+n{kteNkaOUa! z#>gWaef)gYE~N|XUSm;F`F97o!FCBVo-#!uMTby1u1>C=K7kBLftDCe&N}1@jDK6{ zg^DF(3fnq&x{PksvKiePG9B9*>Dv1I%$~P_99|Mga>efE{`Pjz#~Wz(G9fV`+>G9c@C z&pLIxUv|U1E!a;`;Kc54lCU=qpKtlLPMBB68gxFVJLl_Jtt6F%AD(O|dv$#A{1Kp5 zn(u%wrQ15*BXL|ThUJn-ZAROTTKT|lKRwTcG|*2+b1D@2uNoLYrw5e2*s$Zqajv`m z@cFJ+KFnzlisNaJZgsYsSzQQXG$`y2X6SJH{QXt{5kF3ZD73O~-<<&K*C0aI_IT+v z%Rjkc1cIl-?!ep)s%hb3u=LdzSeHz?+W zB9%&z%{mh>bB$c4HNX9A_oP#tjg!^1UDpuL86d{=|l-9n7RXto}< zPu}hw4=y&+`BD1GX56m2#Y}lb!r8QVqMU*AMYs9;xBJD}B~n&oq&DJei@qam;J=qE zhTm3X!%CzN(k~>fDgc$$>~Wwul8;Y~!~L)<7!Dh=_^9IE+f4i7!Z?6^=CIlVJQtI5 z`TTj?${psph3Cs&>-TTo<-rv16VBb zP(l5mT^!>(7SS{)A7(2erB)!{_ui(vTR4Qg8_^&vn{uYu-#&l7I6XO#8#XfVt<2j! zGkvZ>Ax*H3zy#*g_1Vq$Pu@_T{cse5#ewic{5wFPVo2dgj_a9|_Ugmu+g^#c%yqYv zdB3-p?O&XqHE?i|TbAdmZYfilT#~Vy*&`^8Y}w}U?S6T6fo)J#j)%>5+B(j*&hEd5 z%)<>Up<+4ilq{Ol?ZtwOD$NZ#0q;>J8LXArA*J}mGw7TZy}pxxLknz z)Q+-%5hu(O<#&6j)AKFL2Z%>-bNIQf1tl!S;MOB+YsVoQ9FkIqb zv9j(=VKt?yxO%#j)0AGV^y;OmK`rCZj~6_aA=Ddi9G(9D?YqKa3!5x@)k8OwRCRXu z{oN2RqZDf|*o&&#=i60F-<^MR*@R#g?E6n}BVjW1MI%Aa+S@NJx95XO#Qg=}*;$J> zXL)bfD=E}cwjtcj{bZi!@-P@mAWyCZXH_THpe^e1vsg2i6!6r${pxBX+|uD7-qWx* zkDW#z;29TFq6bie%l&@0cRWJs3XMJ~|y~^Rc!`5meK^Ie< z>th3jAzSHRJU*}L`LtV27?%x=3SxS`9#+V(acM$2anY^rKW#h3bflIKX8oS9V*Nj& zPh5dRg@P(j#5Jab7V=p`MI{$8Gn18qM6tDA2fwHLgmkwWL3%=#`#7z|1=hu^-V@Mt zM2G_I6YX`uX8^G&^i~fa0THE(d?=%7PYA=oabMK8np}^Bl|{djYc6g+-n-@a;jj$$ zyETkpjn!%)R!P{n@aUxzvb-CrTuR(6utt)@!9jkqSq_TsaX0Om%(UWhZ)vF7g>=DC z4X0fv*I~8~)T_$L&fq?gHx0OCdi(JKXhbGB*n~6HQu}fD&fx)(LArF|aU)m2?q+I` zT{FRoR&O0gdu}#Y4zXk?J-u7RrvC8Bft<<%hSM+Jua<30Z$90R z%Ve=m&-{sXK1kPB>ob7Ba&>!B%O~$o%EODNkIP!_$oi!Jbx)5E4vX#?27(xL^3&AR z^w&=x;l-p22EllW#5&9g*c^*iAO#H(*&EN~SQu1NIV_Vy<5|^SbF*=V;*4Y{6j3kr zeR}l?Hd>amZ(zN2WBw{aD7!^>I3XzJkFaUOUsAG4%ng%h?|{U!Jr^e~G_KGyuU_OlTtWD7@y696?j+2>`fXu;RRTM!mH^w9{&nGZ$ z1Ob2V{ZfS{%QVi>ll?;%+-6etej$;p7kv`e(yt> z(tulVQ*$|oG(h#ua^CW0j*2WUr*z=;8EL?^3kcll?|b8U@3eSukZJ3BtrXHb6VkFT zPj7tv@o8B-K6HcAP};T@O~6f5WbXyMu_CtRoeGcNU#S2I)gbBmK`iy{q^eg8EWnuD z;El=M$ET@Lz@;MUs9m-6VwW2AfJPvFh<~v3o<70NJv7TP3ayhE_074nkr6q_{?OfI z+jFB%!q12w8ijg&6oRb-hHMz8$r|!iF0N)$-^r1#4~25JvPhh#8>F6z07*od^@_R9 z0#Ec1?>1wH;FNYbCXoBMAz_*1$)pLPvFd>NgmS?K#HtI&2H#3)z6}f*bJKOe%y0^J z*N-2s+eK$bFx6rvKiEI+Zr0OUOtVY~XH_-F#u~ye)hc?0i6*_Ds)#E9bq55YCq{pA zdQup!AF1vI3Ps0Sk5RDJtz9B{g`}IT1#6wQJ+PO78YV)LwRW#9lruj?WRY2ak%g3c?6ZJ$w14r|Z6l0ij(YY`52ICPD3mC3HCi>^8oB z2GMr>``D&}{OXzgqe@8FMbUdw)K(j}X@R`@axAE7)@v0^pkr@RB_Q((DK8?bIj5ox zrJ%YFgd|$V2k8booGX{!ONtinn~NLb$pliEEGwgsWBnd&<|D@}7J{Vf<$QPb@X6ZC zMC`@DHnog%Jqw`b81g;s4Qsi^_~!YZ%8}9a0Wj!#`XE)E+vaf$$wXOji{#x9&(CY& z?9k=RO~;LNls8mE**7vb#9qvMr4u_Is-zQ5aG|cBRvfb}Cz@E?60rISq?Oq5mqhz= zHdC|Xr$Ru|?@|>p;n4l!{bXrKODK^r!OG;1ioWN>Zs+$8^Fzu@xm*SaNwl9Es*W9x z7$==`eD!DDPUu0Wn{|leax|=Uup}`xA3wmHN)dg;6(rlVI@_Lg^R5wr1W>5lNMR*} z>Q5_SB2L~fw30QnNqf0BaE)|Jxt0y#SV$eagPqvzl2uIa!XoPZObttq_MB)BlS(>W z@8}fge{zkSV}OaJmmKTB4*Qo+A1%GZa1~(8&~J?ASzIHz&idi|>(kEJ(ek+H<#1GP(^=i*nO zxb6mhpAnRpp0|}15{6=Zb}k;j-!=?7ih@{FCsec1HW0x|4m7*epl92Q58vMk&~=Rr z`-@Jugj*|gplV*Mg-$VtR!#E#r{^)AY3kHq7I$eVjMRt|>_ggHu0jbPUVaQ@a;K1_ ztx2ML76FU*xf-nmN5{NdI62)seZD;{3T~&FkyDHN`?;>TqG}!^?e1=Kml7^vl^$hi z(tYPk?Er^7-pS^P=zGg-y^|GgKEk`ori!tXg#l;6esF0JLN7xMyvCGr(uHesZD#Vq zJ`BPsI_cc#ayu&Js5S#LvvA5bz?M9@Ytmp?M}nX#2YZ>uIj%=69Im^Ng~%q;>+d1D zW{xPa?$VBxepp#vtlB3qcdc}Yp{I^UI>e2;R6fgS>`=(R+dmn2KkVog77Qz|=Ym*x zze$ODieN@I5@IybV?=t{Jxz+cqquoofDiNeynb@P6wQ>^Zps_TORpIhs1WYb#EOy$ z&E|ekq*4O7pe(X!WQg=&{RCP%QP;${Y)KSc><2eIo71cvLsgt!0HTZi5M6gZWL=Z& z5XBe;u{_eqlKrPD8RT)Q%hN)X;b{C`RR?7-@>9qiSqUW5%hiB3{8E+3$x~bFVO&ff z)xc>pg`(kOGv5N}gmO)*4dL>H9Ps$*ntjFEn~gzy zRC6a{jXz&AQDo}9X+(LNoNVs`Gf*CNL4V@1=@c`i5v}Z^o_UvRM!0CJ78Zud)j1g2 zbr4(;Rq@-g=`Cpy)I0Yo(5}$JN1VP3$S8lzRI7d3v({rrZ!gpSJk!;haY%Lm_OLCg@n za>#z`i-(J0QBo0(z}1{3B3+!`efoUcJo+vr9pQZ5%w-*Hn^-?UO}O;g=(=5i^S9hXWU@w!bEhn2aWHnYY+W!FOlEm7G*?0o*X)V;iW{IJBi zSsE_+#Kj>+h++;Syi zK984U`|$X@E+4$jCtTFvD%@x@Ypi&XWo=$_ksxEK4sRcLEYgRE4ea7mUaxH0gxy-D zhbPsEYj)6|@9tNX!&H8>yjn1+ z#s&h)C}S~QK{+ePuTeZf1#)+Lw{Q$pC#y^Di5yIo2J!rqdxhJB8V|W4-|TE}?rtXq zlIe7@g&ucO$QD|#Mjacu`p`TJ+kwg4)w_Aca&a5-2@A ziuKO#t`*B<>yzbnBuW*&JQhXnL$$$eQjD3biK6flk3u$65!T7!!O0%<9P@T5a}uCy zL2ys_AI)yI%q{qKh->|dyZNA5 z$W~gD)tOg-s^pltSToZ>0Agsxx_Tla9%JjcQxSE}q6GWly%_Y!hg~kaY!avAGrmSv z2l+w$vjJG~>M8eC#I(x-?G4vhbs4gxp|Za=%1ti9){I*$?h;X@5dsF}4%I^#P$gFI z%F^U3(1sel*iLv3BqIn7Jr%MGUGsuPlX!DFn!`OR^GZmd;`1^idMv6)cz*cQP&m`m ziWTPkDKg}0m8di0p>s&KCue|+u?{AO>YDGYTm~D*K_OqNjxRUz;!X;1*`@;!jzI*DmASyS0KCMeadRKnOV#L+{FFuNr&-)L^+}1Uyk_ zKojJ!Q4Q9VrIuHhQvklP#=@xpy_a6wM1yuYPE*2RjBesk2;tJ!sRhTwJzsV zoHYmmT?soAl4s{9W?NQ0;83+BpH9L6{g0#|6te@2oQmwwklU?co+mE?R-FOE0f%3< zMZOglXJJu;++SomRBn;V0mfEx0O+;QyuyqoqHQG23*I7oot7hI8C4SgX>154Akv>o zWgNGNW`>f+XkYBga8gL}%}~>|?4`xEj~L2)K?I%b7~@4y1qN_7td@#=LbB)?tVE#_ zycLWJlP=1c(6Y&!$%-m6r7I|j(B$=^i;2-fam^aB~ zVNwzaEEo|V5`mwPHAUrBFZ1X?^bybykO(%ol|+S&rlos{rxS%Q(L+2}6?U17FOUd= z5hT`OBebl9{(*bewyB(+$!)1s^8LY?D(n7J71t9zl7dYSfKaJB&{SlX%$l}&c#|Su zOI&nYsQ&vfF?nsT<7pU7rjw~Opjw&GD?h6SG6v*bXbSRF^fF>2aToK0jmH!IE38$6 z!CBY4w2d$?S1&Ry1HhvfXdd3j=<{@AUKT*z*EqT=X&O3$dz#`k6xJ3Yj1eC^jKJwL z>#FR9UQ3Q7sp+ObN+rR2N^JIG@$&E`iwu<#-PCDmh+jJmM^wb7_5)1TF$5ZNIK_Nc z%0npk2#TjwIglV4+bd8x;@xdwR2aeRch;;pZ+T(8QLMO*6>8jKIE75YF)(=QCb05B z7s~`*a{+mxQsv_p&0;Gi&G&nj7K@ko%gJm8Qc=>{2xN)4=X8kg@`edn(sW0CD8t8T`N-@Ub()vF5of zr1t2H1yQ)9e7!hEga;@pfhi_*H>RiJzGVe>I>bnL1~Mz9C0mJzP2~u7Mc?>E6fnS- zfDl5D+v&`LMZE%3V(P#%geZcAJ%|_Z(!x)NP?ln-KtJ^O*iYrYTU&z7MPNJ5C9pv_ zpzjHlwmlWKL!#EX6DizDW3g2|?-TpoLjV4nWoDQQ%HI`QC6f?-lU`05* zv@&qEE)7vJagd3!aNtzAUkz`Z@q&gUpEZuW@mSn*+%Kh?qz8%bDr6Rw zt}CG}*)Te5^UJSEIy*R(85W26uCo-+o~Cuy#X@@(?3_SLS;^p1nlLqVwrrK^EaX~1 zj!5iGHiL@D?J&(JosFUa5dqn9Y#(y545b1m37G=icAXt{-^fvy+;==6ta8zZWPyL63%ZOOUh&WB}7eZxeEEiNF;aw zL_RMQ*tJ6gq|=UT$Kp&lx2MzCa3GWb(-Rz<;*9tz;B)kZa@t%@I(h&X+i)iGGs!}T z%=#X`w`q?AH@lr@W)wk;B3_I3Jb~Ld81sRzRCsflP?7C4oj+!S_h}LWz8gZPiGCKl zD9IWl9~2f#oo?XHoI+BWG+=>10PMEV^VocYg#aK((}>Tk?WPDN^}({7%D}Eo<_p9e z8H2@*YkF4vwW)3k?tha=pPYeA1e8>k8!LGdi6x5pWIwLs(2gua;u5 z*xp`F8DFZbWR6_LE0 zt9T*;05Pbv^gy~mJRn*wlWWbd9`85By@T9X>c{{(Bis1&`bzi`%l3S;5y+X7X1%z6 zepuz+yvt1%*TG?*%cSb_yX$^sAI8CQy#}z9%jChVe1AVr@4?g-GbC_ZHgj|JaM3Lu zrcb)_bCI>x<5USa_outT;laBAY;_wIb4N_)536?mh{Y8I)!DF;HTIWJpRVis@6!G0 z<<{w5kOn-uxn&#*g9o?byj{*jOxCBT%?Z5hAw0^lz!WZr#XYo!^zjK26Z^Dzk|_?h z54_Cj{r!drA8yNHE~U*6t1w5DIX@t+$ONy=0O4HKgtzr3!izd!SC2{)ncVeE<`~@k znzY5w(q7+ve!{J~2cbZlO)rpYtUp}#N+!9(&1|RSj)ayxeZK1+?jK6`-a@=Dr1xRC zJ|KBY9hbRSZKO&jUFYcfbWwWuF4v!K&u6FQlcRlL+P9pS>67LeB(F1=M!C-U!w(Ro>Pa6hfXk8Mns z3({H9}ovxO4IKOsldH4ByOrme{!x<}kvv_i_Us*lf3L8ovx1%z~!9%X4ryoBI z5BA<6r)T=A<}>foo$Dt&F$bB_m?u#LWZJ5_{r>Y+>FwKW%=)xdG#Y@0@5S*PWt(T4 zmC?u_9(T?^{P-L!1XbD9>tU@BFK{7BIe&1JXFEMx4r}Ry^7#7uAMYA_Zw?TjTnQFA zIoivP?w=No^g+7H(Yrt*1w4Ln|HJ3=97H;R?^~!q$4HzPPj>>X4q4YSpI0-AOPqZsMlI{J|-LmxNFg;meb{7CE7j1qM6MAsc zTmf{AEbEi@`u4-!y0Led>a8!YtUlNVaKUdUwe-7OeSUFH1j%Re%`?ey=L4`))#dqh z1lJYH&gRQyGk=g_BHg+`%czuPIT?uB(Q$sfhC7HlIFyyuIgkvVsuf5r$i7fQrt9s+ zdQ?p3%Zv4P%*Rqg5;B@0GvZ%hI|Su1 z;j#-Q@nX?GIpN`6E?Hk0i-`I`T_a>F($%HsXhbI0Mr1*eONWmlK)e{uPl|xLoDwBtL%o=t zomOE~5Jn-95H=DJHAf!om0HbRE3tsbTw1dXN0}bF8c1*?DMksl1*n$*Aj?DcM7FGe z5Yiz_AYxZJ8zlU{0o@7=sKknkyw?OQ^HyV5njM{$iGcukZc6qB;bW+AYpfBtszs3ES3a> z^o<72-b|^Wtan%os6L@rM^?WH4-?RAH6p|C6o&l>yfnLM;CNOcztN->37ac@g5hbt zAQ>~!j9KG=-ir4ZkVOGklg1ef$cQWeR1ae>#)4WyS`HhKa2ZB@tE0vK0%8@<37LMR zFD987Ts64yp3suX=<#uc-G#Xbl~ve=NRffyC14Hm7k$clWLYBTA&nC3NA;n9Lr_+9 z>|X-gm^>JOQ9VrDJ=W2&JtWJ z$Bbp7+At01P8XiF^XU|j5}j;7^TxtL)negiXbI>nBOdlEV92AT@a$@NKHvq1%XWbExY#E>*GlehfSNnUMCkBLCZP~L?n0~HSq zDp%nAwsp$YdWW%WD$hSVosICL)$?ous>r7J>g|?^}+M4++ky z9!d;zGH{nLh|t>|v0=Lk1F{1l`AVxtHsX-7u97YcnD_!g&cMa!N<~Nvs4QdB>c`To zsxV$$AeK^Cs#rea{1p%)In)Uft31?b#4|*$fRh?iG_6)fxiBf|!p?%}sEbhugBv`& z$RVt;2dS3%jIPZDNGYWoCOaamtuYZ2^=AewG97sZ*u+@KleK53hfU1!l^7eD&p<0o z=57h5rDPCnLvyAIw&bJ-4i1A5^WfMUFQ8;q!r18eVe3n_buV(>tqa%zHh<*WA};0l zmqb-Xyt*rzlxK>v)|r_YgyOw~)^WJSEJVs8ql00AkgTt2uxOmMidqeEA@vih3=EMaOdZP2yAzV<%-Cpdi24kb=xYFaJtB^==Mamd=4NI4AU&PD-yO#m=H` zBsLk_Syuyvj|S@%;SnUh6V?th+;x97r0ltB!mLXPkF&NDcz(8EKpJ>|U1gwQ@5i55 zmkSc!kDY1Uno4|QJ3~(c=1ClmLa!rh$h-k>6SnIBXZ}02z???l6XK)|my9Et=V)h^ zVK+9@%r$~*_&ogUonmSePm5C_$j?|&pi6^7fL+R}32rjr#2Cbwjf06)x10&AYXYK6 z25r}TES2y^hk?iS0y@LqNUl2WDjwEyeas*h>(@##fo|q#J{$+(m`E&l!q!;(QP{;b zAD0r_AA8%2r76H1^xs|K{*n$fs@3B9WIGig>0a*9?afnw&%giYh_Zhf9PFC(Lo9L14#3l`KV!O0zogicAzH zMWe}FtI7E^frRSO*BETRl-67qP zS6Yd$(xBUIYBb?qN1}19*hN93#xMnnn1${ef@-{trkw$7i&4-Tf)waeW6oXKo2Z;` ztw;8?m090Hj%Qp9QHj7J97|Y!TxU^Zh!o@4HEImeH)F>UG=Y)%Zt(eh1uul{SAsOj7sB7}W!k%f0k`Rv2vH)M=E;h;w#+BA z5=~bjq0dL}V;w4}X*NK6-CKiIbEQ~6a0SOPjvX)M0Oog9&^W3wv6Mnu@z!DoXMh!l zZ7;bH7$s^RRzZo%O}P$%<$fNF`4M2 z2n+FJU-}4=HZ+64TuELg8Ak6n5<<%P9%AiE8t!T zZ*U8V(xR$EYYeCMZb8zpv`q?)&22L{cEKeDUO7*aok*^?y}WiZhtnzadJ-%&P<{Y- zOr|!#GwFkHvSMnIy&YEZfEz8BCoIHCCw0lWMtQTp+z(Wzq)JJ`lTl~|T#P-iUc05M zZKo%sIdc=c#{QyOjYm^n0NZ8~2PsisFDLdFH3|htgrg{FgvN*hX0~jLI2y-zIOOAC zAqxUib_*HHaJDMO520k<_yrolsq@T@N>(W=$>kWZORf(SH4+L+PQWRnZ_Yo0I(%C` z2+9^AEpUbcSjny&MB=_WDFiMQw~-gM*gAkEn;J)`LS|E^gDaBvrJDm>=HhaGMeF3u z*d4YGUyL9YZ{+li_{T1vzHxP-xOrVDwCPUxVxlDJ&5dQ%k9wj0)}hUT=5!q(lnY0@ z2m}j&wnk8O^@Z5Z1TdPfoar^L2{$k12!kq+CFYB|lAt2RAqvAegcRoK%C3D{p7Yjy zN=VUuD5Fj{(-gkT4&iI*&;s%6T4%<0(*-s#Bv4<8Fq+T^lMA&g$!tj*E(Jtxs0R+Y zaM>ijb{8r?=fD*J9V6Ur2qe3eP>4vYj|ahz;*9P zfU7|5Ak#YQ0GJBGkJteIabzqJ1r(M7XRkU=HS5SPfG1jayn3Vt$% z7=Xi4-;5e!pom=|&pC*Y#_MC!li+08^@RKurHv2ukr+s202;OfC?-?w;-7fw*dC(V z2zH8BNp7G)`@J+{?Z%%7`XCh~AZcMN5I7M{1zMOtA%2Qi;xDtdW1a)23~sQ&Nk%VT z$#4da-R?yaV6xa^PRqdZGnSgCEE?g+(E$ zGpWO;QK>4UjiirJW%MEbL_f$B@y&S4U3Zf%CLNE?C4Gy3d>CU9|HQxXdhsW!N!}{? zDV{~)aaFTDHi>)*+fi6re%kib%oJA48y_Ann|DtFVNFMoX*H%(C`SG=AQbm;9{ds-9YwgR^ z*SU$Bc6CM7v3%l>Ctn6AntZKf_fb;hm%U5A61BV(e5vqD#lI+@e6suaS1*_p{biFc z-`PF?^2?X{Uw%*ONt*m+2Y=DpZbg0R&F+I=7ya_tmluC+DSk-49$Vno-${D$i$`DT z__=qUygW>by_9_&=wCLHluKTG_odzM$?zvD;iaCaFaC=OkH6ya%U{Xk-NU4w_%Zn~ zDVO~GQZ(9qdHDLz%QKa~K8kP0H+BzRpYPiLbuV@eMzvAT&#lIf{{Ll=lA4lQUmr#3 zr2OuO-QQoz|KeFP_Z|JhGJxA$`u$+OoF{^EI5^6RQ!Oa5H{uWL}= z17Ax1{Zf4QDEW@{?%(8t*Q%2z$)nx#~0UCY0$`gQboA0_of9Z5a$Y*+JZ{kvj6fAI6~|M924 zsN+k4*T;WR_g_9&em6$1AN=on@$>WlP0^PD@#$;PDEW(Ne_6yY8+TX!OJ#~B&tGbJ zd5YwCsd?Wt+JdC^Fci)K$cHjE)G^$Ukc&Y5m^Z0&z_EPIkd3^bO*NxYb zQRl9X_&3orcLGK7<=v<8fgvEJBtN`9+&xQv^;c3+^d?cuqqWyZR8mUr&ttf&CNTm0 E|3+j3h5!Hn diff --git a/xemacs-packages/gnus/etc/sounds/drumroll.au b/xemacs-packages/gnus/etc/sounds/drumroll.au deleted file mode 100644 index 64e829451b521412404b0af269c94184e69c4cde..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 6074 zcmc&&%ZlYXmd*Z(9#(%rLsLcF%6s!2krC%Z6wcXxgB z%iX7|+h6+qL%R-=#rJRDyng@Atz4F>(g#z2y6bPQKipjHjz=%bJT1-^@6MjTjkl)E zMcGeB+3)fC_GA4?>VB1FFBgmL;w(D53_NiU<6e9jo9e1j!(-_OA%g8HPVz+<^N?)> zRrbWYuBs1y@0}U4gY4r-lw}ZIre#bs%5%0;%#2T`v8i?JwVy&xN$wXcc}M+5($%T2 z`BXR7>89AJar+>Q>y7n{hiRIp3(tHhbDuU-bLuqJT`y~|S+pgqbXlzJLEL=4`gmxs zZ>8d7bs4>Re;K@4hnE}ip88;Gw4QEux7Rm!PoJ*k&?Sq@=-u*sd3l~LS3U1-T|cSA zalgAebdOF=rY_g#zj?meygIu`0{8eu-9CNX-~QKqXC)=1*evz=GG4nfm76kppLe7` z9Zt75^;O@;I$AlJ3bHDLJ_?sK5G-PPDz5HtKKA=7b!xJ07{1$V(ty{&(CA5ISzPP8 zq}_Gy)b`qz7fF(=1W!l%WwKq82-_z6V%Sv+7sYDh`_!nZtcOEa40f!2^F(zRxs6+G z-fqGR9mGkNMT|DpHo(0(3!lV2uTXkBWGLTzZCrQCa_yqToZ zrg_{~2bbBBB?XO=EJ_M4)Y!It+YI~04bpR6i($8yb{3DMqKbABpGQjVLEnYsmwaCaN&p4kOb}n!eE9Tcx-y5Pg|&L`xXK6x9T? z1WX#vCDpuhotTtCG`S>HQz9~IXlb0XQh6nRW7&&%R-#0hAorSd`Q7K9IcDo1`o9!8PG$|X=-M9OPPmiDO zcXexgx(I{d{NiG<*pxgKa_q-$w?97K-k+L-XK9#SrmN*LO_ziPsGwoob;o+#?eBNZ zqzR?V&3YT=2uhU2G{ho%y01?4-DA}>Cn>#KuU5-#5-r0;k`;PX>NJkWBha&|no-dV zm6;_Xby3a;FEbmv)4^)hxcUSr8G38VWD^z17CX+l@k4cZ+|_k|w39W-Sf=YdTAVGy zi*y@uuDT~#?QWhv-QEoCG_kXEbD73ba_NPzejuYQ2UYF+hw9{NjE@WFvLOuuggi$O zWit-mtEsM9r<~zwUSue+EGFDJT{@-ueyC)&rQvEyio6tM!7bBFv|jd;p15>9 zb4+u}$&5JEl%y!6Pzdzcm_`ZWsOLy&KrS_m1B%9&!JcNc9RcOqSOm%zr6~;43W;r` z@8lqyRZK8T{XjJ<%aQ>+7$P|5fG3)dUMTC4yo7Nps8yYFuYn?vZJDGP>IBA5VSLPnK)!P+kUE5+`S?B@(e1IU?F0>T16` zJ|6pKsM9##tS&Duf+)_ACrV9I)7Dkp97jkAmM1P=T;_{7DC4}uW}C5t&M;5Arq{8^ zQ9XH`s^SL~`;c%=bWKD0F*lw3wvLK`s9t%Md>$Ym1nx_M@p0lKk@_=L; z1Si*8S=Mw~^@b`r$!WBPIiGr#U^puXqmFpeTRnh~rm++VwLi?lesawZk;D_3_kH$66xIST3?83P8MJkr#$w z4U;;U=1K0G4pc*Ewtb&%QJWmFf!apQP3QZ%sXIM&NJ>dT*_&+v9wQTKUva6YX&jn* zs3yQXu|bJ^DpQ&XJ~0Xa9igjqC*5EM>n3Yws4Y0jxd$CF%e>^$Td5IcCWX}45LR$) zU6$ts&r4Qv-=DgD)sC$KelSCN0Z0R5hU+v*qX2mAWhL8VZN_@n?>cy5J;#eUNm-tf z3>|oF>v62?QGxKi<9+HNEwh!4bH*V8te0R#MMl(Q$|hvNq=m#L(kx6$4(T9$J4iK{ zNl8zzCMF7+`+-L!ivbanbA2~rzr7utcNt{`Ex<$ow-J@B2%w1>Ba|`979ODMVAdNw z0eviHLva)4EoS!=2sG5a0TZh^oj`uvm4-}l8HLe0Ei+{N&^GPU>F(#-FHJRCl4Kha zW#RkRXXoq7*9iq0p7hi8L%qMby88?e3dweJakjZ!l+k(Ua^Z%y8lRr_k2imAsq^&#o2Pjp`1z}WlujpRrS-UY0X&jQItU% z+a(KpKBie<+yD^hiqXCNBWEu~%kr(j}G_j`J?(Nl`Fs%%F@L zJoGwBnakeOnoJBZ%1n<07O8*)p@MOT2V0Cn_M@I^)Gz3U6$L;+#>$BTX{xj|nj7S3 zr<5m95`ri&kfquQq6?@V#z6^4V3tGY_-R%_23|P|Q{V0%+p02@rsu@^$>_*)hP?a{unlvX_&P)+eC%}G&&e(1m z!woP6kry3UfTu=MisUSD@*$jRF-gdGGgh!Bos#)vl9J?Muv&+kC@*qO#biLw{r<5# zJ=7DFy-3R1G1q0t<$!pSnp8+@ffq zQ~5}zl7{FF;Htdt$TYQTz*#`WIFe-0x=3O;JG<&fKbo1Q8qs^F33Ek`v0t}U_8@7d zgv!gQ=E_=VVU84Z2?1c{nhiL7Ak{Qzzd$p9!Ve{O9SI_!G*ECQM2m$OM&jVFr>o$Ijv%#*f-@uRM}m;3cRKAptPrjd6_X z(!lA;@yiko;H~Dg|W#$zcJdTb!e}i}mGV_4(nCzyJN8Z+G3z z?cRci;W`*WbTc zhC$@T@ynO14}bdc$Eyz?zZ{Qw@%q(^?_WRv&5O-)Nmdu7e)#3;=EIMF_|HENk3EsY z+lzPKfA{_C?=Dhkf$b_>_U5U4di>K*fB53vw8pg?eG5Ohu1&QQ#XX#KDguI z)778;_+$I{Fyxz;^yTHni}UD*^Vh)!dV2Dv!-!R9{U36w(Oc>A-ABw5ci~A)51&DlTvmbD-y{0hID`>QOy_S`k6Smpq|GhWeR$4@GzwaMGA& zYWG~%R8cX;J&jbz3z-4K?NoQI93`2?F|R;MQ~=k~Xv1+p0LSzrezdTzMm0gHi;UyQ zVAB#N9WQ>5j6z(DuC*+^E+~ht)E<;B64ksR^h%{35_yR?vp(juzPy{$tgUOku zIG9>dGK*K1mRKfo+JaUDY+BBAiP94z^8YLSgXYkEu2vjL@Iyf^Fe9X{K@SB7U=rYC zDTj>aP+8XDa58WP>EbMo2?Fs$Ng4xCK%qGbeo1l4clZg?C=1+%8iIeQX#>+9&H}b6 zq=~?mTGW}xs>MuN77^fFz>H^t;(!h#=p-Gs7cU&Z7_8%Q1mW|dQKs4e3n2SZ#)g9- zt)1O+pfxa)6I^3%13`=`_keqi8(@C^eUf7x9?rl^3o@Kx0B3RU-~(PbxQFjhMQ{%j z!2S6O|K?^qz&O6Z0%8Xn811l>8BNS=AAQg?OHp*=c!_DyIKv7im`$M_9WW_2ZobYo z;e`N7&4$oA|C`OvUBx`-?Bg8t+4$@SnqdfSUwh62W)Cp}-r?K)IA76@F0lUf22*Gj zXqjJqji!Ki-;7};==WE9-}wLAn!haoEwdF|zPg4%^XKdJ>!7(A>zJ+27QcPwJ08DY n=NI$;*}z{0&bP0=%y&HerOUjMuYa?<^N4Q)<{p3jV0Hfu_OT1a diff --git a/xemacs-packages/gnus/etc/sounds/explosion.au b/xemacs-packages/gnus/etc/sounds/explosion.au deleted file mode 100644 index 530e1fedb35a8936a920d32c9c9bd8a191353451..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 22400 zcmX85cX(9Sxi^~cuP?_o2!z^bx~A8y>3v4M7n(qH7u*SU5+`v^68n$)-Fr@s0|L~i z_qu2A>Ak4;f)I!*unjgC;}$!`IkwMT+^YxB^YDyDOMAWReSd9<|Le1-fA+JVk$(2G z!_R}y|LbQzBi8-@pTWQ2;~zi%_~@&5AAk7dH)r4c{G$^met7rBd)>!>b$j`(eSiPc zA8(xMeti4upU(FG?&|ih&%FG`t&JPE?tJz8-@pCp(W57i9Y1;OQ2(*h-`u%&<=X9g zw>K|e{pjD{Jl1#o^)qK)e(B|7C*J(q7oTl^^!>N@9`0{woDWaE`q{!CKg_Rp$ss0h z3klt9R9*`tyR?OzLd22HA;I*GE;Yp0W?goBVECu3isVO_qe5PUalC^lSp*zG zcBJpx!)X*wU0u${&?{^4o2sP2V2^}RugUHUo@PS|Da54W2{cF};nZNt%CU6Wa_;%2 zl+!diZZf*33NfG2Xc!qWg>EW1G+s;Zl$yjALzL>$3NjvB!(y|@SPY>#5efPn=CMnI z!y^~}^1+bFY_y_h1$9C;hl0o87*q_F#i3z$l~fXmL>gbDtrvD?LNJW_%!42N$N&9b zL&jj#@Akl%iI0Q~D!*^NmLZn1YKYi9B|HA@=g&U3qf!j(hepOm!21skjf@*c$2`Tb z(>HsjM?j<2;4qcdH57JTQ}2VgC%oFG(aJPpLE}5COaGY3u7C9X>g9Iz-~T3Ku@~VO z>@r$hW`k+;!k9a?*~`RMm+jnBjoGsYgU1nAN}aGdWHURhMxWOdK)rJTTR81^1`*hX zoc(?+n5*ypTE`UjGAUvffzKy03@Q~3F$fnVBF}8uu zy}z!L*KtXZ?9jTJBRVu2K?AdO8|gwEne9>4>SPiLPb!nhnH(L9&Eu^cJE@{_M2%|2 z3v+?MOcY5w+!4eyGGefdUA$M_}M92$)?MLU|PxQ;y@b#Jq*p z<$xE7qXFkk)}pr}{+RR9_`sis$1V)$4MTRB>_cJ&wsOaF&;0M7|NQ5>C|Im?ZohEW z5t^UaKyxXRIovqwNl#hK_K}Mt#>vkD_IRCY%3y_E>+gsktw>~e9+AMpU@EKd)fF^a zStV1=q#Si4uzU2PUO#m4!i6!51Ia{-OhPRgL*TPGd56j4P3+@|0}{3Gn?48G6tJlD>>M5Z6#KWrjGZs z3-;K9%-!2p5NFWi%@$XVJb!=we^OZ_;4*oavKchqwU$3A)0z&JgHna9kiJB!$W`hU|{f~-mLduk7otEe<}qHMY!XSPVe!MIe+3|?;G7Lo~*ux zM#tc)D=PLpTT+Il(YTBn$(J(wc+NhKx&|(d4_`8Q#zw~UBg1;Xs)5M?)dk# zaur;Obo(Seam=gelXIYwvk&clL#CG6-q z?#;2->unSgdH1gB%3XViRQ~;@71WV%jE|0u54(eQvooEK%;cVLxYovJ)T0p*nXe$? ziDl&^Jf27cO%$4p2K9*Lg5B+LnfxCHi;L;BCFQi(EM{wX?fbo7*0BX#B3Y~v(=h}t zkANlBkZD|zS{rj@eV#;4UCWc}ID9%I?+W`tXZG0b7KbN<=4T_Y$7c0}5q~P4&~>&J zX4>ODDu~X*SC*HRm+aWFtGuGRlEfxb)Y9eHR5oZBHCxR?0|OVv2hLp@)sK&kBjclR zFmvx0ODZ<2s=T7SqOxqy?n*9+0P)D><<+})6UbHg?Sqk&&OSE$mx}}c`5%A&uXE>z zMhC`_WYBwn!mr#}3ck_Kl8VZmJBj4-GP+h3H;!2bKe%w|gAWF+CSw70#>p$AIrn)XCdi<0hNw z!dTFgI3&&Q1o6B9ix%noa5%!Fp`{3fG@j@=m=AF^7s;h`x z&@D;a7f(Sey;ONh#e2M_Dj={g>I(#um(ytK`qW)*!9JBYFH$I+>dLBWOeK*(rN05g zrml!LkRL5nqn=4rCv%lbRWT48H)KPB1u0KJ#uG6(BB2J7{L=0A7{VX~BUJ6Isw%I+l~z^|#eCtc-M@{7k@#eO);X%TjT$`$6Pyah zPs~p0I<{_4B=bkQW!(kU8_{^?eU*v_wf1!C>OVs>okFHUz$8?ZRqXn=lFIT*ELl8f zF$@_De>r#l++WUraDMnA=(jzYK>kRl$FGx$S49;iyY`fqKldy^6qpJkjUZ2j5>CsQ z-fkQo89#sCI6i2OPtPkMh|zj&L%MI0Cznu#LIM_p!QmKu!KTfFj9oM#5sfr9Cxj$y z?ad^N(-x~`#B927 zY54rW*x2yE1${b~7gA_AEFNE7T19D^D$0lz<(TryN(_-C*^HT;DBKhXO4Ts&TmTlG2hAJZ^V6t^)T{ZD&l|I3F#- z_F^Vl$Q5IwBYLlMd<--_i`C)Fpf`)_KVISS<*gEKC$YS$ytKOFxr%BM2hUY0(Lz6* zS@8Kx#&E=K17l@$WO&#ZT1^H|H8%-3SPY)8P)mq4cq{>1UE88=KX#<<&@5=5-r!BE z5w-+YvjOBrG}+P8qHg-}YptfCgHz!^Keb01hVC?({gC_If`9UW#A+3*uc`R9zjKioZ*;V%3&!2hj zxm{J2)of|4{B$np@OuXa^rM$9jSY_2y|$5Y)9|Qo((n9;P1sXWUQ$D;uBM0ym>Ri6 zL1$1os@jg(?80QmaPH#yfsp}|e~w+-&LA?FbRLWHi=X&Hp{|2Xtob76cSXI$rRz#D zha+ryJ7%?543=1z@?mG=pYBe^7am^k$RZE8LJdRmszAu%L6BM~*5=ah`m9J|h0~;{ zs-QFRqHb=%mo<-!4ULUoGzZ<_J=|X8FpKuuex`_4wzIU7K&`?sxdaNtV5eOccSXqPg!S_#;y zaxf06=?q#^y|~+JcDQ1381|S(3|@31Fnh~&`>4^m`qP@<>`Mm|Tq3EmnycwjHow!z zh3Hj8FrMCJ_GHdSUA;pU06B93hsMfm4j5kiez` z%&cBdA(rtmgVo@1=siQD`hg3hHWQ4xKFoV3mD?);nr)fB|G2ForBfZv=6{L66NA2^PdUC5y_Y*UD>fRTa(}$n28}W}Q@gM9aWdS7S>` z>G(Q;(Fe|-`}2Tl%;1WmjS2~#NTO5ewM+sNQVJn4x3NK2OrfFV%3KKX+U)+!cT8eU zB~e7Jm99rKp-4KNzdf;b_*y=YI#hHR!DgE6=oP2=;jNi_LMn$!1S_qm+ynjs5V{9b z!@rkAEaq{&%QQH6@xsWM!DMqdtl@{=U@#CsCYK~!9-UZ2BlEh|ol6?Aj6$RVTCuYP zL#QJ10NAVR_+$3KcbOs*@S2A&f~EhT|L6bwUw=Lao-a~Q#Fswv>@z>#vAd+20i}@j zg~BEuhbiB^yP^aKk-C=(wxD}>aNyFY#fKhwF|&5kYe5aerXeF@cFn}wILiR`SK~3I zrR7*GLrmsNp~ri>eR0`lJd#G-etUd=UP`0Y&_y@W%N~nuY{Y7JMo>SBcme&?G}hCJ z#PV{msk=ba!E(^#Z-M~sj$ZupU(OE<8%>^>)zvkK&Mqk-V#`bM)fiRrw)SX`_IgoO zH-osHMx)zgn(BD_r>@S};>}xM|9*X&Q7f;msw%}Qo~&E-L!&OU$rtZF0lVUbt&Vg- zuF~?M8?_WXmRMCoBS_WL*@)Nf|7&C0DLG%j>(Z%PiZ-)hcofvU$vo!IcgF4zYe;;2 z>FzxhWyAwKW}Q!;KAtL~lkZFy?{GyThEk(zIo5OQNiXc0Kuk89FKjdg)e0F~(<3?N zaAzWL=H7H{4g#ZtfUDSpBhfVVaz3Ph>a;zduO>6`WPUypo`o%L%gCjR!{DreW0iCl zx|@lWr8{;$_w3H+c9a5kK%h{>EnV{k#A^VnJO9C-KR7=yFfce`hJQsUD=*)*t9%au zs_B}W_xUDUxwUixgMWHoPu7!rJrwsLGRbL(e~hZBCDM3&CY8hGHZ8%9kxQ2@TsU`O zeB5reKc<1IsU|QLy$@$X%d^PwyInL2Q^@1A-ca&nA{ql%&7$LUAw^p>pACjRqk~5M z@TlG4Nc8keXhPM^3XgF4++TNyMYedBo#~JuV+|IUJu_);##UO~n=8 zzqYwB?Ll4>){yWx9F|B1W2dsB8jB;=_B7p&1yP65WEdYA9=$Lya(-a&(wNB`O#ezH zgrrIp#Hu0SFl8mrKJ(1aODamsC_Hxal}VSuI5v1;aOlFI(WxJ^hlBf)?(GLxvkw;{ zex!ip>T0R@$|@3>fUB;qs=#0|ST>}~gyR_`5Ge2L6SHbc`X<_bAfJfKV^Wq@!A`Xgx6<#aiNiBJ@_m@J^g4dBBW z2&Y4Sn|npZWJ4T$p0*^jFJ&0B8O&~@ z2hGG%uh)qfL~>7M(~Y5lAdi^A82YZgP7qHb6&%F1y)53+iw)gB<1wE9^9O(a&;R(Z zfl=31_fZ)~pyZ1vJbq=#&Rr#CyLS`WRE2~AHP

. - -1999-12-28 12:20:18 Shenghuo ZHU - - * webmail.el (webmail-hotmail-article): Don't insert message id. - -1999-12-28 Kai.Grossjohann@CS.Uni-Dortmund.DE (Kai Gro,A_(Bjohann) - - * nnimap.el (nnimap-split-fancy): New variable. - (nnimap-split-fancy): New function. - -1999-12-28 Simon Josefsson - - (nnimap-split-rule): Document symbol value. - -1999-12-28 Simon Josefsson - - * nnimap.el (nnimap-retrieve-headers-progress): Let - `nnheader-parse-head' parse article. - (nnimap-retrieve-headers-from-server): Don't request ENVELOPE, - request headers needed by `nnheader-parse-head'. - -1999-12-23 Florian Weimer - - * gnus-msg.el (gnus-group-posting-charset-alist): Correct default - value (crosspostings are handled), improve documentation. - - * smiley.el: Declare file coding system as iso-8859-1. - - * nnultimate.el: Dito. - - * message.el: Dito. - - * gnus-cite.el: Dito. - - * gnus-spec.el: Dito. - -1999-12-21 Florian Weimer - - * gnus-msg.el (gnus-group-posting-charset-alist): New layout. - (gnus-setup-message): No longer make `message-posting-charset' - buffer-local. - (gnus-setup-posting-charset): Reflect the new layout of - `gnus-group-posting-charset-alist' and `message-posting-charset'. - - * message.el (message-send-mail): Bind `message-this-is-mail' and - `message-posting-charset'. - (message-send-news): Dito, and honour new layout of - `message-posting-charset'. - (message-encode-message-body): Ignore `message-posting-charset'. - - * mm-bodies.el (mm-body-encoding): Consider - `message-posting-charset' when deciding whether to use 8bit. - - * rfc2047.el (rfc2047-encode-message-header): Back out change. - (rfc2047-encodable-p): Now solely for headers; use - `message-posting-charset'. - -1999-12-20 14:10:39 Shenghuo ZHU - - * nnwarchive.el (nnwarchive-type-definition): Set default value. - -1999-12-19 22:49:13 Shenghuo ZHU - - * nnagent.el (nnagent-server-opened): Optional. - (nnagent-status-message): Optional. - -1999-12-19 Simon Josefsson - - * gnus-cite.el (gnus-article-toggle-cited-text): Restore beg and - end (referenced by instructions in - `gnus-cited-opened-text-button-line-format-alist'). - -1999-12-18 Simon Josefsson - - * imap.el (imap-starttls-open): Typo. - -1999-12-18 16:43:37 Shenghuo ZHU - - * mm-util.el (mm-charset-after): Non-MULE case. - * mail-prsvr.el (mail-parse-mule-charset): New variable. - * rfc2047.el (rfc2047-dissect-region): Bind it. - -1999-12-18 Florian Weimer - - * mml.el (mml-generate-multipart-alist): Correct default value. - - * mm-encode.el (mm-use-ultra-safe-encoding): New variable. - (mm-safer-encoding): New function. - (mm-content-transfer-encoding): Use both. - - * mm-bodies.el (mm-body-encoding): Use mm-use-ultra-safe-encoding. - * qp.el (quoted-printable-encode-region): Dito. - -1999-12-18 14:08:48 Shenghuo ZHU - - * webmail.el (webmail-hotmail-article): Snarf the raw file. - -1999-12-18 14:08:12 Victor S. Miller - - * webmail.el (webmail-hotmail-list): raw=0. - -1999-12-18 11:14:51 Shenghuo ZHU - - * gnus-agent.el (gnus-agent-enter-history): Back-compatible in - group name. - -1999-12-18 11:02:00 Shenghuo ZHU - - * gnus-agent.el (gnus-agent-expire): Convert to symbol if stringp. - -1999-12-18 Simon Josefsson - - * imap.el: Don't autoload digest-md5. - (imap-starttls-open): Bind coding-system-for-{read,write}. - (imap-starttls-p): Check if we can find starttls.el. - (imap-digest-md5-p): Check if we can find digest-md5.el. - -1999-12-17 Daiki Ueno - - * base64.el (base64-encode-string): Accept 2nd argument - `no-line-break'. - - * imap.el: Require `digest-md5' when compiling; add autoload - settings for `digest-md5-parse-digest-challenge', - `digest-md5-digest-response', `starttls-open-stream' and - `starttls-negotiate'. - (imap-authenticators): Add `digest-md5'. - (imap-authenticator-alist): Setup for `digest-md5'. - (imap-digest-md5-p): New function. - (imap-digest-md5-auth): New function. - (imap-stream-alist): Add STARTTLS entry. - (imap-starttls-p): New function. - (imap-starttls-open): New function. - -1999-12-18 01:08:10 Shenghuo ZHU - - * gnus-agent.el (gnus-agent-enter-history): Bad group name. - -1999-12-17 19:36:47 Shenghuo ZHU - - * rfc2047.el (rfc2047-dissect-region): Use mapcar instead of - string-to-x function. - -1999-12-17 13:08:54 Shenghuo ZHU - - * rfc2047.el (rfc2047-fold-region): Fold a line more than once. - -1999-12-17 11:54:41 Shenghuo ZHU - - * webmail.el: Enhance hotmail-snarf. - -1999-12-17 10:38:10 Shenghuo ZHU - - * rfc2047.el (rfc2047-dissect-region): Rewrite. - -1999-12-16 22:59:22 Shenghuo ZHU - - * webmail.el (webmail-hotmail-list): Search no-error. - -1999-12-15 22:07:15 Shenghuo ZHU - - * nnwarchive.el: Support nov-is-evil. - * gnus-bcklg.el (gnus-backlog-request-article): Buffer is optional. - Set it if non-nil. - * gnus-agent.el (gnus-agent-fetch-articles): Use it. - -1999-12-15 08:55:19 Shenghuo ZHU - - * nnagent.el (nnagent-server-opened): Redefine. - (nnagent-status-message): Ditto. - -1999-12-14 23:37:44 Shenghuo ZHU - - * rfc1843.el (rfc1843-decode-region): Use - buffer-substring-no-properties. - * gnus-art.el (article-decode-HZ): New function. - -1999-12-14 22:07:26 Shenghuo ZHU - - * nnheader.el (nnheader-translate-file-chars): Only in full path. - -1999-12-14 16:21:45 Shenghuo ZHU - - * mm-util.el (mm-find-charset-region): mail-parse-charset is a - MIME charset not a MULE charset. - -1999-12-14 15:08:03 Shenghuo ZHU - - * gnus-ems.el: Translate more ugly characters. - * nnheader.el (nnheader-translate-file-chars): Don't translate - the second ':'. - -1999-12-14 10:40:33 Shenghuo ZHU - - * gnus-art.el (gnus-request-article-this-buffer): Use all refer - method if cannot find the article. - -1999-12-14 01:13:50 Shenghuo ZHU - - * gnus-art.el (gnus-request-article-this-buffer): Don't use refer - method if overrided. - -1999-12-13 23:38:53 Shenghuo ZHU - - * mail-source.el (mail-source-fetch-webmail): Parameter - dontexpunge. - -1999-12-13 23:31:17 Shenghuo ZHU - - * webmail.el: Support my-deja. Better error report. - -1999-12-13 18:59:33 Shenghuo ZHU - - * nnslashdot.el (nnslashdot-date-to-date): Error proof when input - is bad. - * gnus-sum.el (gnus-list-of-unread-articles): When (car read) - is not 1. - -1999-12-13 18:22:08 Shenghuo ZHU - - * nnslashdot.el (nnslashdot-request-article): A space. - -1999-12-13 17:20:25 Shenghuo ZHU - - * nnagent.el: Support different backend with same name. - -1999-12-13 13:14:42 Shenghuo ZHU - - * nnslashdot.el (nnslashdot-threaded-retrieve-headers): Support - archived group. - (nnslashdot-sane-retrieve-headers): Ditto. - (nnslashdot-request-article): Ditto. - -1999-12-13 11:41:32 Shenghuo ZHU - - * nnweb.el (nnweb-insert): Narrow to point. - -1999-12-13 10:59:42 Shenghuo ZHU - - * nnweb.el (nnweb-insert): Follow refresh url. - * nnslashdot.el: Use it. - -1999-12-13 10:39:53 Shenghuo ZHU - - * nnweb.el (nnweb-decode-entities): Decode numerical entities. - (nnweb-decode-entities-string): New function. - - * nnwarchive.el (nnwarchive-decode-entities-string): Rename to - nnweb-* and move to nnweb.el. - * nnwarchive.el: Use nnweb-decode-entities, etc. - * webmail.el: Ditto. - - * nnslashdot.el: Use nnweb-decode-entities-string. - (nnslashdot-decode-entities): Remove. - -1999-12-13 10:40:56 Eric Marsden - - * nnslashdot.el: Decode entities. - -1999-12-12 Dave Love - - * gnus-agent.el (gnus-category-edit-groups) - (gnus-category-edit-score, gnus-category-edit-predicate): Replace - expansion of setf, fixed. - -1999-12-12 12:50:30 Shenghuo ZHU - - * gnus-agent.el: Revoke last Dave Love's patch, because of - incompatibility of XEmacs. - -1999-12-12 12:27:03 Shenghuo ZHU - - * mm-uu.el: Change headers. - * rfc1843.el: Ditto. - * uudecode.el: Ditto. - -1999-12-07 Dave Love - - * gnus-agent.el (gnus-category-edit-predicate) - (gnus-category-edit-score, gnus-category-edit-score): Expand setf - inside backquote to avoid it at runtime. - -1999-12-07 Dave Love - - * binhex.el: Require cl when compiling. - -1999-12-04 Dave Love - - * gnus-cus.el (gnus-group-parameters): Allow nil for banner. - -1999-12-04 Dave Love - - * mm-util.el (mm-delete-duplicates): New function. - (mm-write-region): Use it. - - * mml.el (mml-minibuffer-read-type): Use mm-delete-duplicates. - - * mailcap.el (mailcap-mime-types): Require mm-util. Use - mm-delete-duplicates. - - * imap.el (imap-open, imap-debug): Avoid mapc. - - * nnvirtual.el (nnvirtual-create-mapping): Likewise. - - * gnus-sum.el (gnus-summary-exit-no-update): Avoid copy-list. - (gnus-multi-decode-encoded-word-string): Avoid mapc. - - * gnus-start.el (gnus-site-init-file): Avoid ignore-errors at - runtime. - - * gnus.el (gnus-select-method): Likewise. - - * nnheader.el (nnheader-nov-read-integer): Likewise. - - * mm-view.el (mm-inline-message): Require cl when compiling. - Avoid ignore-errors at runtime. - (mm-inline-text): Avoid mapc. - -1999-12-12 10:36:51 Shenghuo ZHU - - * gnus-art.el (article-decode-charset): Widen is bad. - -1999-12-12 10:17:42 Shenghuo ZHU - - * mm-util.el (mm-charset-after): `charset-after' may not be defined. - -1999-12-12 Florian Weimer - - * rfc2047.el (rfc2047-encodable-p): New parameter header used to - indicate that only US-ASCII is permitted. - (rfc2047-encode-message-header): Use it. Now, Gnus should never - use unencoded 8-bit characters in message headers. - -1999-12-12 03:08:15 Shenghuo ZHU - - * ietf-drums.el (ietf-drums-narrow-to-header): Make it work with - CRLF. - -1999-12-11 14:42:26 Shenghuo ZHU - - * webmail.el: Require url-cookie. - -1999-12-11 14:21:23 Shenghuo ZHU - - * nnwarchive.el (nnwarchive-make-caesar-translation-table): A - new function to make modified caesar table. - (nnwarchive-from-r13): Use it. - (nnwarchive-mail-archive-article): Improved. - -1999-12-11 12:30:20 Shenghuo ZHU - - * webmail.el (webmail-url): Use mm-with-unibyte-current-buffer. - -1999-12-10 16:22:24 Shenghuo ZHU - - * nnweb.el (nnweb-request-article): Return cons. - -1999-12-10 16:06:04 Shenghuo ZHU - - * gnus-sum.el (gnus-summary-setup-default-charset): Typo. - -1999-12-10 12:14:04 Shenghuo ZHU - - * mm-util.el (mm-with-unibyte): New macro. - * nnweb.el (nnweb-init): Use it. - -1999-12-09 20:39:49 Shenghuo ZHU - - * mm-util.el (mm-charset-after): New function. - (mm-find-mime-charset-region): Set charsets after - delete-duplicates and use find-coding-systems-region. - (mm-find-charset-region): Remove composition. - - * mm-bodies.el (mm-encode-body): Use mm-charset-after. - - * mml.el (mml-parse-singlepart-with-multiple-charsets): Ditto. - -1999-12-09 17:47:56 Shenghuo ZHU - - * mm-util.el (mm-find-mime-charset-region): Revoke last change. - * mml.el (mml-confirmation-set): New variable. - (mml-parse-1): Ask user to confirm. - -1999-12-09 Simon Josefsson - - * gnus-start.el (gnus-get-unread-articles): Make sure all methods - are scanned when we have directory mail-sources (the mail source - is modified in that case, so we must scan it for all - groups/methods). - -1999-12-09 12:05:28 Shenghuo ZHU - - * nnml.el (nnml-request-move-article): Save nnml-current-directory - and nnml-article-file-alist. - -1999-12-09 10:20:07 Shenghuo ZHU - - * gnus-group.el (gnus-group-get-new-news-this-group): Binding - nnmail-fetched-sources. - -1999-12-09 10:19:01 Shenghuo ZHU - - * mm-util.el (mm-find-charset-region): Use the last charset. - -1999-12-08 Per Abrahamsen - - * gnus.el (gnus-select-method): Made the option list prettier. - -1999-12-08 Florian Weimer - - * gnus-msg.el (gnus-group-posting-charset-alist): Use iso-8859-1 - for the `de' newsgroups hierarchy, as it is common practice there. - - -1999-12-07 16:17:12 Shenghuo ZHU - - * nnwarchive.el (nnwarchive-mail-archive-article): Fix - buffer-string arguments. Fix references. - -1999-12-07 15:04:18 Shenghuo ZHU - - * gnus-agent.el (gnus-agent-confirmation-function): New variable. - (gnus-agent-batch-fetch): Use it. - (gnus-agent-fetch-session): Use it. - -1999-12-07 12:32:43 Shenghuo ZHU - - * mm-util.el (mm-find-mime-charset-region): Delete nil. - -1999-12-07 11:45:10 Shenghuo ZHU - - * mm-util.el (mm-find-charset-region): Don't capitalize. Delete - nil. - -1999-12-07 Per Abrahamsen - - * nnslashdot.el (nnslashdot-request-list): There were two - top-level body-forms. Put a `progn' around them. - - * gnus.el (gnus-select-method): Use `condition-case' - instead of `ignore-errors', since cl may not be loaded when the - form is evaluated. - -1999-12-06 23:57:47 Shenghuo ZHU - - * nnwarchive.el: Support www.mail-archive.com. - -1999-12-06 23:55:55 Shenghuo ZHU - - * nnmail.el (nnmail-get-new-mail): Remove fetched sources before - do anything. - -1999-12-06 Simon Josefsson - - * utf7.el: New file, written by Jon K Hellan. - - * imap.el (imap-use-utf7): Renamed from `imap-utf7-p', change - default to t. - -1999-12-06 04:40:24 Lars Magne Ingebrigtsen - - * nnslashdot.el (nnslashdot-request-delete-group): New function. - - * gnus-sum.el (gnus-summary-refer-article): Work for lists with - current. - (gnus-refer-article-methods): New function. - (gnus-summary-refer-article): Use it. - -1999-11-13 Simon Josefsson - - * nnimap.el (nnimap-retrieve-groups): Return active format. - - * nnimap.el (nnimap-replace-in-string): Removed. - (nnimap-request-list): - (nnimap-retrieve-groups): - (nnimap-request-newgroups): Quote group instead of escaping SPC. - -1999-12-05 Simon Josefsson - - * imap.el: Use format-spec for ssl program. - * imap.el (imap-ssl-arguments): Removed. - (imap-ssl-open-{1,2}): Removed. - -1999-12-04 Per Abrahamsen - - * gnus-start.el (gnus-site-init-file): Use `condition-case' - instead of `ignore-errors', since cl may not be loaded when the - form is evaluated. - -1999-12-04 11:34:22 Shenghuo ZHU - - * mm-bodies.el (mm-8bit-char-regexps): Removed. - (mm-7bit-chars): New variable. - (mm-body-7-or-8): Use it in both cases. - -1999-12-04 Michael Welsh Duggan - - * gnus-start.el (gnus-site-init-file): Don't use cl macros in - defcustom definitions. - -1999-12-04 Simon Josefsson - - * mm-decode.el (mm-display-part): Let mm-display-external return - inline or external. - (mm-display-external): For copiousoutput methods, insert output in - buffer. - -1999-12-04 03:29:13 Shenghuo ZHU - - * nntp.el (nntp-retrieve-headers-with-xover): Goto the end of - buffer. - -1999-12-04 08:31:10 Lars Magne Ingebrigtsen - - * gnus-audio.el: An M too far. - - * gnus-msg.el (gnus-setup-message): One backtick too many. - - * gnus-art.el (gnus-mime-view-part-as-type): mailcap-mime-types is - a function, not a variable. - -1999-12-04 08:14:08 Max Froumentin - - * gnus-score.el (gnus-score-body): Widen before requesting. - -1999-12-04 08:06:13 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-prepare-flat): Comment fix. - -1999-12-04 03:01:55 Shenghuo ZHU - - * mail-source.el (mail-source-fetch-webmail): Bind - mail-source-string. - -1999-12-04 07:18:23 Matt Swift - - * gnus-uu.el (gnus-uu-mark-by-regexp): Doc fix. - (gnus-uu-unmark-by-regexp): Ditto. - - * gnus-group.el (gnus-group-catchup-current): Would bug out on - dead groups. - -1999-12-04 01:34:31 Lars Magne Ingebrigtsen - - * gnus-msg.el (gnus-setup-message): Allow the charset setting to - do their real thing. - - * nnmh.el (nnmh-be-safe): Doc fix. - - * gnus-sum.el (gnus-summary-exit): Write cache active file. - - * nntp.el (nntp-retrieve-headers-with-xover): Make sure the entire - status line has arrived before we count it. - - * mailcap.el (mailcap-mime-data): Removed save-file from audio/*. - - * gnus-sum.el (gnus-thread-header): Fixed after indent. - Whitespace problems. - - * gnus-win.el (gnus-configure-windows): Error fix. - - * gnus-demon.el (gnus-demon-add-nntp-close-connection): Add the - right function. - - * gnus.el: Fixed all the doc strings to match the FSF convetions. - Indent all functions. Fix all comments to match the comment - conventions. Double-space after full stop. - -1999-12-04 01:14:55 YAMAMOTO Kouji - - * nnmail.el (nnmail-split-it): I redefined nnmail-split-fancy's - value to divide received mails into my favorite groups and I met - an error. It takes place if the length of a element "VALUE" in - nnmail-split-fancy is less than two. - -1999-10-10 Robert Bihlmeyer - - * mml.el (mml-insert-part): New function. - -1999-09-29 04:48:14 Katsumi Yamaoka - - * lpath.el: Add `sc-cite-regexp'. - -1999-12-02 Dave Love - - * mm-decode.el: Customize. - -1999-12-03 Dave Love - - * nnslashdot.el, nnultimate.el: Don't lose at compile time when - the W3 stuff isn't available. - -1999-12-03 Dave Love - - * imap.el, mailcap.el, nnvirtual.el, rfc2104.el: Don't require cl - at runtime. - -1999-12-04 00:47:35 Dan Christensen - - * gnus-score.el (gnus-score-headers): Fix orphan scoring. - -1999-12-01 Andrew Innes - - * nnmbox.el (nnmbox-read-mbox): Count messages correctly, and - don't be fooled by "From nobody" lines added by respooling. - - * pop3.el (pop3-movemail): Write crashbox in binary. - (pop3-get-message-count): New function. - - * mail-source.el (mail-source-primary-source): New variable. - (mail-source-report-new-mail-interval): New variable. - (mail-source-idle-time-delay): New variable. - (mail-source-new-mail-available): New internal variable. - (mail-source-fetch-pop): Clear new mail flag, when mail from - primary source has been fetched. - (mail-source-check-pop): New function. - (mail-source-new-mail-p): New function. - (mail-source-start-idle-timer): New function. - (mail-source-report-new-mail): New function. - (mail-source-report-new-mail): New internal variable. - (mail-source-report-new-mail-timer): New internal variable. - (mail-source-report-new-mail-idle-timer): New internal variables. - -1999-12-04 00:39:34 Andreas Schwab - - * gnus-cus.el (gnus-group-customize): Customize fix. - -1999-12-04 00:38:24 Andrea Arcangeli - - * message.el (message-send-mail-with-sendmail): Use - message-make-address. - -Fri Dec 3 20:34:11 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v5.8.2 is released. - -Fri Dec 3 20:09:41 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v5.8.1 is released. - -1999-11-11 Hrvoje Niksic - - * mml.el (mml-insert-tag): Don't close the tag. - (mml-insert-empty-tag): New function. - (mml-attach-file): Use mml-insert-empty-tag instead of - mml-insert-tag. - (mml-attach-buffer): Ditto. - (mml-attach-external): Ditto. - (mml-insert-multipart): Ditto. - -1999-12-03 08:49:53 Shenghuo ZHU - - * nnfolder.el (nnfolder-request-article): Return -1 if not find - the article number. - -1999-12-03 01:12:41 Shenghuo ZHU - - * gnus.el (gnus-find-method-for-group): The method of a new group - is not the native one. - -1999-12-03 01:26:55 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-button-embedded-url): Always call browse-url. - -1999-12-02 18:00:15 Lars Magne Ingebrigtsen - - * nnultimate.el (nnultimate-retrieve-headers): Use - mm-with-unibyte-current-buffer. - (nnultimate-request-article): Ditto. - -1999-12-02 14:57:46 Shenghuo ZHU - - * nntp.el (nntp-retrieve-groups): Set to process buffer. - -1999-12-02 11:14:50 Shenghuo ZHU - - * mm-util.el (mm-with-unibyte-current-buffer): New macro. - * nnweb.el (nnweb-retrieve-headers): Use it. - (nnweb-request-article): Use it. - - * nnweb.el (nnweb-dejanews-create-mapping): Set a default date in - case matching failed. - -1999-12-02 John Wiegley - - * mail-source.el (mail-source-keyword-map): Add backslash to - Delete-flag. - -1999-12-02 07:24:35 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-group-charset-alist): Default nnweb groups to - Latin-1. - (gnus-group-charset-alist): No, don't. - - * nnweb.el (nnweb-init): Make the buffer unibyte. - -1999-12-01 23:02:48 Shenghuo ZHU - - * mail-source.el (mail-source-set-common-1): Fix to get the - default value. - -1999-12-02 00:27:46 Lars Magne Ingebrigtsen - - * nnslashdot.el (nnslashdot-read-groups): Unibyte. - - * nnultimate.el (nnultimate-request-list): Use unibyte. - - * gnus-uu.el (gnus-uu-grab-articles): Bind - gnus-display-mime-function to nil. - - * message.el (message-send-mail-with-sendmail): Use the - user-mail-address variable. - - * gnus-art.el (gnus-ignored-headers): More headers. - - * message.el (message-shorten-1): Use list. - -1999-12-01 21:59:36 Lars Magne Ingebrigtsen - - * gnus-msg.el (gnus-configure-posting-styles): Ignore nil - signatures. - - * nnweb.el (nnweb-dejanews-create-mapping): Get the data. - (nnweb-dejanews-create-mapping): Do the properish date. - -1999-12-01 17:41:21 Shenghuo ZHU - - * mail-source.el (mail-source-common-keyword-map): New variable. - (mail-source-bind-common): New macro. - (mail-source-fetch): Support plugged mail source. - * gnus-int.el (gnus-request-scan): Use them. - -1999-12-01 21:59:36 Lars Magne Ingebrigtsen - - * mm-view.el (mm-inline-message): Check whether charset is a - string. - - * nnslashdot.el (nnslashdot-request-post): Insert

's. - - * message.el (message-mode-map): Changed keystroke for - message-yank-buffer. - -1999-11-26 Hrvoje Niksic - - * message.el (message-shorten-references): Cut references to 31 - elements, then either fold them or shorten them to 988 characters. - (message-shorten-1): New function. - (message-cater-to-broken-inn): New variable. - -1999-12-01 21:47:10 Eric Marsden - - * nnslashdot.el (nnslashdot-lose): New function. - -1999-12-01 21:08:48 Lars Magne Ingebrigtsen - - * mm-view.el (mm-inline-message): Not the right type of charset is - being fetched here. Let the group charset rule. - (mm-inline-message): Ignore us-ascii. - -1999-11-24 Carsten Leonhardt - - * mail-source.el (mail-source-fetch-maildir): work around the - ommitted "file-regular-p" in efs/ange-ftp - -1999-12-01 19:59:25 Lars Magne Ingebrigtsen - - * mml.el (mml-generate-mime-1): Don't insert extra empty line. - (mml-generate-mime-1): Use the encoding param. - - * gnus-sum.el (gnus-summary-show-article): Don't bind gnus-visual. - - * gnus-cache.el (gnus-cache-possibly-enter-article): Require - gnus-art before binding its variables. - - * gnus-art.el (gnus-article-prepare-display): Run the prepare - after the MIME. - -1999-12-01 19:48:14 Rupa Schomaker - - * message.el (message-clone-locals): Use it. - - * gnus-msg.el (gnus-configure-posting-styles): Make - user-mail-address local. - -1999-11-20 Simon Josefsson - - * gnus-start.el (gnus-get-unread-articles): Scan each method only - once. - -1999-12-01 17:37:18 Lars Magne Ingebrigtsen - - * message.el (message-generate-new-buffer-clone-locals): Use varstr. - (message-clone-locals): Ditto. - - * gnus-sum.el (gnus-summary-enter-digest-group): Have the digest - group inherit reply-to or from. - -1999-12-01 13:04:09 Shenghuo ZHU - - * gnus-sum.el (gnus-summary-show-article): Support numbered ARG - for charset. - (gnus-summary-show-article-charset-alist): New variable. - - * mm-bodies.el (mm-decode-string): Support gnus-all and - gnus-unknown. - (mm-decode-body): Ditto. - * rfc2047.el (rfc2047-decode): Ditto. - -1999-12-01 17:37:18 Lars Magne Ingebrigtsen - - * mail-source.el (mail-source-delete-incoming): Change default to - t. - -Wed Dec 1 16:31:31 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.99 is released. - -1999-12-01 14:28:49 Lars Magne Ingebrigtsen - - * dgnushack.el (dgnushack-compile): No webmail under Emacs. - - * gnus-sum.el (gnus-summary-refer-article): Wrong interactive - spec. - - * gnus-msg.el (gnus-configure-posting-styles): Eval `eval'. - (gnus-configure-posting-styles): No, don't. - (gnus-configure-posting-styles): Allow overriding files. - - * gnus-art.el (gnus-header-button-alist): Use browse-url - directly. - - * mm-decode.el (mm-inline-media-tests): Check feature vcard. - - * gnus-msg.el (gnus-summary-yank-message): New command and - keystroke. - - * message.el (message-yank-buffer): New command. - (message-buffers): New function. - - * gnus-sum.el (gnus-summary-catchup-and-goto-next-group): Select - next group in a more normal fasion. - - * mml.el (mml-boundary-function): New variable. - (mml-compute-boundary): Use it. - - * nnmh.el (nnmh-active-number): Skip past files that have buffers - that exist for them. - - * gnus-async.el (gnus-async-prefetch-next): Cancel timers. - (gnus-async-timer): New variable. - -1999-11-30 02:07:18 Lars Magne Ingebrigtsen - - * nnultimate.el (nnultimate-request-list): Be more lenient with - root addresses. - -1999-11-28 20:22:37 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-treatment-function-alist): Do - gnus-treat-capitalize-sentences. - -1999-11-30 09:07:53 Shenghuo ZHU - - * webmail.el (webmail-hotmail-article): Hotmail changes the - format. - -1999-11-29 Simon Josefsson - - * mm-decode.el (mm-display-external): For `copiousoutput' methods, - switch to buffer after calling program. - (mm-display-external): Use `shell-command-switch' instead of "-c". - -1999-11-27 15:21:25 Lars Magne Ingebrigtsen - - * nnultimate.el (nnultimate-possibly-change-server): Don't always - read groups file. - - * nnslashdot.el (nnslashdot-request-article): Convert

to -

. - -1999-11-24 20:18:24 Lars Magne Ingebrigtsen - - * message.el (message-mode): Doc fix. - -1999-11-24 09:25:00 Shenghuo ZHU - - * gnus-art.el (article-emphasize): Check group variable. - * rfc1843.el (rfc1843-decode-article-body): Ditto. - -1999-11-24 00:11:27 Shenghuo ZHU - - * mm-decode.el (mm-save-part-to-file): Inhibit jka-compr for any - type. - -1999-11-23 17:21:05 Shenghuo ZHU - - * webmail.el: Support www.netaddress.com, i.e. usa.net. - -1999-11-23 Hrvoje Niksic - - * mml.el (mml-quote-region): Insert ! after the hash. - -1999-11-23 05:08:23 Shenghuo ZHU - - * gnus-group.el (gnus-group-warchive-address-history): Change to - nil. - -1999-11-23 02:33:13 Shenghuo ZHU - - * webmail.el: Support mail.yahoo.com. - - * mail-source.el (mail-source-fetch-webmail): Add password check. - (mail-source-keyword-map): Use `subtype'. - -1999-11-22 04:35:43 Shenghuo ZHU - - * mail-source.el (mail-source-keyword-map): Add webmail. - (mail-source-fetcher-alist): Ditto. - (mail-source-fetch-webmail): New function. - * webmail.el: New file. - -1999-11-21 12:20:02 Shenghuo ZHU - - * nnwarchive.el (nnwarchive-request-group): Print 0 if it is nil. - -1999-11-21 12:19:11 Shenghuo ZHU - - * mailcap.el (mailcap-parse-mailcap): Don't skip double semicolon. - -1999-11-20 12:54:25 Lars Magne Ingebrigtsen - - * nnultimate.el (nnultimate-request-list): Add fetch-time slot. - (nnultimate-prune-days): New function. - (nnultimate-create-mapping): Use it. - (nnultimate-request-group): Only fetch the groups list if it has - not been done before. - (nnultimate-retrieve-headers): Don't write groups. - (nnultimate-create-mapping): Off-by-one error. - -1999-11-19 12:17:25 Lars Magne Ingebrigtsen - - * nnslashdot.el (nnslashdot-sane-retrieve-headers): Fix to match - threaded subjects. - -1999-11-20 02:22:52 Shenghuo ZHU - - * nnwarchive.el: Lots of changes make agent happy. - -1999-11-19 21:37:41 Shenghuo ZHU - - * gnus-start.el (gnus-get-unread-articles): Assert group is in - hashtb. - -1999-11-19 19:53:08 Shenghuo ZHU - - * mm-decode.el (mm-display-external): Write region with binary - mode. - -1999-11-18 14:52:05 Shenghuo ZHU - - * nnweb.el (nnweb-dejanews-create-mapping): Bind `text'. - -1999-11-18 14:35:01 Shenghuo ZHU - - * mm-uu.el (mm-uu-dissect): Use fake charset `gnus-decoded'. - (mm-uu-test): Now it is in restricted region. - - * gnus-art.el (article-decode-charset): Don't mm-uu-test. - - * mm-view.el (mm-view-message): Fix buffer leak. - (mm-inline-message): Support 'gnus-decoded. - - * mm-bodies.el (mm-decode-body): Ditto. - - * rfc2047.el (rfc2047-decode-region): Ditto. - -1999-11-18 Matthias Andree - - * imap.el (require): Added autoload for base64-encode-string. - -1999-11-17 Per Abrahamsen - - * gnus.el (gnus-refer-article-method): Made list value - customizable. - -1999-11-17 13:09:37 Shenghuo ZHU - - * gnus-sum.el (gnus-summary-recenter): set-window-start with - NOFORCE in Emacs case. - -1999-11-17 13:04:01 Shenghuo ZHU - - * gnus-art.el (gnus-request-article-this-buffer): Set - gnus-newsgroup-name. - -1999-11-16 23:53:22 Shenghuo ZHU - - * gnus-xmas.el (gnus-xmas-summary-recenter): set-window-start with - NOFORCE. - -1999-11-17 Simon Josefsson - - * gnus-start.el (gnus-get-unread-articles): Check server before - scanning. - -1999-11-16 10:01:03 Lars Magne Ingebrigtsen - - * gnus.el (gnus-valid-select-methods): nnslashdot is news. - - * nnslashdot.el (nnslashdot-login-name): New variable. - (nnslashdot-password): Ditto. - (nnslashdot-request-post): New function. - - * gnus-art.el (gnus-treat-buttonize): More testing. - - * mm-encode.el: Another CVS test. - - * gnus-art.el (gnus-treat-emphasize): Change default. - (gnus-treat-buttonize): Ditto. - (gnus-treat-buttonize): This is a test. - - * gnus-sum.el (gnus-build-old-threads): Bind mail-parse-charset. - (gnus-build-sparse-threads): Ditto. - (gnus-build-all-threads): Ditto. - - * nnheader.el (make-full-mail-header): Make into a subst. - - * dgnushack.el (dgnushack-compile): Skip all w3-dependent files - unless w3 is supplied. - - * gnus.el (gnus-refer-article-method): Doc fix. - - * gnus-sum.el: Do not accept a prefix. - (gnus-summary-refer-article): Accept a list of select methods. - -1999-11-15 21:28:40 Shenghuo ZHU - - * Makefile.in: Change `^ *' to `\t'. - -1999-11-11 Matt Pharr - - * message.el (message-forward): Pay attention to prefix argument - again and forward all headers when it is set, regardless of the - value of message-forward-ignored-headers. - -1999-11-15 20:44:50 William M. Perry - - * dgnushack.el (dgnushack-compile): Vpath file. - - * Makefile.in (SHELL): VPATH support. - -1999-11-15 20:37:17 Lars Magne Ingebrigtsen - - * gnus-ems.el: Check for cygwin32. - -1999-11-14 18:15:28 Shenghuo ZHU - - * mm-decode.el (mm-display-external): Use 'non-viewer. - -1999-11-14 15:21:06 Shenghuo ZHU - - * base64.el (base64-encode-string): An alias for base64-encode for - compatibility. - -1999-11-14 01:58:18 Shenghuo ZHU - - * nntp.el (nntp-retrieve-groups): Erase nntp-sever-buffer before - nntp-inhibit-erase. - -1999-11-13 Simon Josefsson - - * gnus-start.el (gnus-get-unread-articles): Use - nnfoo-retrieve-groups to find new news, if available. - (gnus-read-active-file-2): New function. - (gnus-get-unread-articles): Use it. - (gnus-read-active-file-1): Ditto. - -1999-11-13 17:59:18 Lars Magne Ingebrigtsen - - * mm-util.el (mm-find-mime-charset-region): Make sure - find-coding-systems-for-charsets is fbound. - - * gnus-ems.el: Typo fix. - -1999-11-13 Florian Weimer - - * mm-util.el (mm-find-mime-charset-region): Use UTF-8 if - it's available and makes sense. - -1999-11-12 19:56:23 Fabrice POPINEAU - - * gnus-score.el (gnus-score-save): Translate score file. - -1999-11-13 Simon Josefsson - - * mail-source.el (mail-source-keyword-map): For IMAP mail source, - added fetchflag and dontexpunge keywords. - (mail-source-fetch-imap): Use them. - -1999-11-12 Per Abrahamsen - - * gnus-start.el (gnus-level-subscribed, gnus-level-unsubscribed, - gnus-level-zombie, gnus-level-killed): Changed from `defcustom' to - `defconst'. - - * gnus-cus.el (gnus-group-parameters): Changed from `defcustom' to - `defconst'. - Mention that it is both for group and topic parameters. - (gnus-extra-topic-parameters): New constant, including `subscribe' - parameter. - (gnus-extra-group-parameters): New constant. - (gnus-group-customize): Use them. - - * gnus.el (gnus-select-method): Added default value and tag. - (gnus-refer-article-method): Added `DejaNews' customization option. - -1999-11-12 05:04:43 Lars Magne Ingebrigtsen - - * gnus-int.el (gnus-server-opened): Ignore denied servers. - - * gnus-ems.el (gnus-mule-max-width-function): New backquote - syntax. - - * nndoc.el (nndoc-mime-digest-type-p): Reinstated. - - * nnslashdot.el (nnslashdot-group-number): Changed default. - - * nnweb.el (nnweb-dejanews-create-mapping): Work with new deja. - (nnweb-dejanews-wash-article): Removed. - (nnweb-type-definition): Fetch by id. - - * gnus-msg.el (gnus-configure-posting-styles): Don't insert unless - we mean it. - - * nnslashdot.el (nnslashdot-group-number): Doc fix. - (nnslashdot-request-list): Use Ultramode as well. - (nnslashdot-date-to-date): Be more lenient. - (nnslashdot-threaded): New function. - -1999-11-11 17:40:54 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-mime-internalize-part): Doc fix. - -1999-11-11 14:32:48 Steinar Bang - - * nnweb.el (nnweb-type-definition): /=dnc - -1999-11-11 10:58:38 Lars Magne Ingebrigtsen - - * nnultimate.el (nnultimate-retrieve-headers): Work with american - dates. - (nnultimate-retrieve-headers): Wrong ordering. - -1999-11-11 07:31:51 Matt Pharr - - * message.el (message-forward-as-mime): New variable. - -1999-11-11 05:24:13 Lars Magne Ingebrigtsen - - * gnus-util.el (gnus-dd-mmm): Beware buggy dates. - -1999-11-10 16:50:01 Shenghuo ZHU - - * mail-source.el (mail-source-movemail-and-remove): New function. - (mail-source-keyword-map): Add `function' for `maildir'. - (mail-source-fetch-maildir): Use it. - -1999-11-10 13:48:10 Shenghuo ZHU - - * nnwarchive.el: New file. - * gnus-group.el (gnus-group-make-warchive-group): New function. - * gnus.el (gnus-valid-select-methods): Add `nnwarchive'. - -1999-11-10 12:13:30 Lars Magne Ingebrigtsen - - * nnultimate.el (nnultimate-retrieve-headers): Work for multi-page - subjects. - -1999-11-10 11:33:23 Rajappa Iyer - - * gnus-salt.el (gnus-pick-article-or-thread): Don't move point. - -1999-11-10 05:22:56 Lars Magne Ingebrigtsen - - * nnultimate.el (nnultimate-open-server): Do address. - (nnultimate-forum-table-p): New function. - - * nnweb.el (nnweb-insert-html): Renamed. - (nnweb-insert): New function. - - * nnultimate.el (nnultimate-insert-html): New function. - - * nnslashdot.el (nnslashdot-retrieve-headers): Don't do anything - if nov is evil. - (nnslashdot-retrieve-headers): use the sane version instead. - -1999-11-09 00:13:25 Lars Magne Ingebrigtsen - - * nnslashdot.el (nnslashdot-request-article): Fold case. - - * nnultimate.el: New file. - - * nnslashdot.el (nnslashdot-retrieve-headers): Skip the article - unless wanted. - - * gnus-start.el (gnus-active-to-gnus-format): Catch errors. - (gnus-read-active-file-1): Separated into own function. - (gnus-read-active-file): Catch quits. - - * nnslashdot.el (nnslashdot-request-article): Search better on - first article. - (nnslashdot-request-list): Fold case. - (nnslashdot-retrieve-headers): Ditto. - -1999-11-08 05:33:15 Lars Magne Ingebrigtsen - - * gnus.el: Autoload gnus-subscribe-topics. - -1999-11-07 22:56:46 Shenghuo ZHU - - * gnus-agent.el (gnus-agent-save-group-info): Remove backslash - before dot. - * gnus-util.el (gnus-write-active-file): Ditto. - -1999-11-07 22:31:10 Shenghuo ZHU - - * nnheader.el (nnheader-replace-duplicate-chars-in-string): New - function. - * gnus-cache.el (gnus-cache-file-name): Use it. - * gnus-agent.el (gnus-agent-group-path): Use it. - * nnmail.el (nnmail-group-pathname): Use it. - -1999-11-07 21:07:55 Shenghuo ZHU - - * gnus-start.el (gnus-active-to-gnus-format): Don't insert backslash - if cooked. - * gnus-util.el (gnus-write-active-file): Write cooked active file. - * gnus-agent.el (gnus-agent-save-group-info): Ditto. - * gnus.el (gnus-short-group-name): "..." proof. - -1999-11-07 20:03:16 Shenghuo ZHU - - * gnus-srvr.el (gnus-browse-foreign-server): Keep using `read' to - support nnslashdot. - -1999-11-08 00:06:02 Lars Magne Ingebrigtsen - - * nnslashdot.el (nnslashdot-retrieve-headers): Don't fetch too - many articles. - (nnslashdot-generate-active): New function. - (nnslashdot-request-newgroups): Use it. - - * gnus-start.el (gnus-active-to-gnus-format): Intern strings group - names. - - * nnslashdot.el (nnslashdot-request-newgroups): New function. - (nnslashdot-request-list): Not moderated. - -1999-11-07 Simon Josefsson - - * nnimap.el (nnimap-open-server): Remove error signal if - nnimap-server-buffer is nil (the check should've been `boundp'). - - * imap.el (imap-log): - * nnimap.el (nnimap-debug): Disable debugging by default. - -1999-11-07 01:17:53 Lars Magne Ingebrigtsen - - * gnus-start.el (gnus-subscribe-newsgroup-method): Doc fix. - - * gnus-topic.el (gnus-subscribe-topic): New function. - - * nnslashdot.el (nnslashdot-request-list): Give out extended group - names. - - * gnus-start.el (gnus-ignored-newsgroups): Disregard bogus chars - if starting with a quote. - -1999-11-07 13:06:11 Shenghuo ZHU - - * gnus-srvr.el (gnus-browse-foreign-server): Support backslash in - group name. - -1999-11-07 01:17:53 Lars Magne Ingebrigtsen - - * nnslashdot.el: New file. - - * nnheader.el (nnheader-insert-header): New function. - - * gnus-art.el (gnus-mime-internalize-part): Bind - mm-inlined-types. - - * nndraft.el (nndraft-request-expire-articles): Do all the backup - files. - -1999-10-29 David S. Goldberg - - * emacs-mime.texi (Customization): Document mm-inline-override-types - -1999-10-29 David S. Goldberg - - * emacs-mime.texi (Customization): Document mm-inline-override-types - -1999-10-29 David S. Goldberg - - * emacs-mime.texi (Customization): Document mm-inline-override-types - -1999-10-26 Katsumi Yamaoka - - * smiley.el (gnus-smiley-display): Use `smiley-toggle-buffer'. - (smiley-toggle-buffer): New function. - (smiley-buffer): Don't quote the function. - (smiley-toggle-extents): Ditto. - -1999-11-07 01:00:32 Lars Magne Ingebrigtsen - - * gnus-topic.el (gnus-topic-goto-missing-topic): Work even in - empty buffers. - -1999-11-06 23:16:24 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-mode-map): Use the summary article - edit. - -1999-11-06 22:56:49 Jens-Ulrik Petersen - - * gnus-group.el (gnus-group-read-ephemeral-group): Doc fix. - -1999-11-06 21:40:30 Lars Magne Ingebrigtsen - - * gnus-uu.el (gnus-uu-mark-thread): Don't move point around. - -1999-10-07 Katsumi Yamaoka - - * gnus-art.el (gnus-treat-predicate): Examine whether the argument - is list or not before condition. - -1999-10-07 Yoshiki Hayashi - - * gnus-art.el (gnus-treat-predicate): Work for (typep "something"). - -1999-11-06 19:18:14 Kevin the Bandicoot - - * gnus-art.el (gnus-emphasis-alist): New value. - -1999-11-06 13:57:13 Shenghuo ZHU - - * gnus-srvr.el (gnus-browse-foreign-server): Use both `read' and - `buffer-substring'. - -1999-11-06 04:24:30 Lars Magne Ingebrigtsen - - * gnus-art.el (article-date-ut): Keep the updated timer. - (gnus-emphasis-underline-italic): Doc fix. - - * gnus-msg.el (gnus-post-method): Doc fix. - (gnus-post-method): Change default. - -1999-11-06 04:12:13 Francisco Solsona - - * message.el (message-newline-and-reformat): Improvements. - -1999-11-06 03:51:24 Lars Magne Ingebrigtsen - - * message.el (message-newline-and-reformat): Don't insert too many - newlines. - (message-newline-and-reformat): Work even if not sc. - - * mm-view.el (mm-inline-message): Insert a delimiter at the end. - - * mm-decode.el (mm-inline-media-tests): Only if diff mode. - -1999-11-06 03:48:02 Toby Speight - - * mm-view.el (mm-display-patch-inline): New function. - -1999-11-06 03:47:54 Robert Bihlmeyer - - * mm-view.el (mm-display-patch-inline): New function. - -1999-11-06 02:17:54 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-read-move-group-name): Subscribe to the - group. - - * message.el (message-forward): Narrow to the right header. - - * gnus-sum.el (gnus-summary-limit-to-age): Protect against bogus - dates. - - * gnus-msg.el (gnus-configure-posting-styles): Use the - user-full-name function. - - * mm-bodies.el (mm-body-encoding): Use the choosing function. - (mm-body-charset-encoding-alist): Default to nil. - - * message.el (message-elide-ellipsis): Fix typo. - (message-elide-region): Ditto. - (message-elide-region): Don't insert a newline first. - -1999-11-05 20:28:27 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-cut-thread): Also cut for numberp - gnus-fetch-old-headers. - (gnus-cut-threads): Ditto. - (gnus-summary-initial-limit): Ditto. - (gnus-summary-limit-children): Ditto. - - * gnus-msg.el (gnus-configure-posting-styles): Allow `header' - matches. - -1999-11-06 Simon Josefsson - - * gnus-art.el (article-decode-encoded-words): - (gnus-mime-display-single): Don't assume gnus-summary-buffer is - live. - - * gnus.el (gnus-read-method): Add methods from - `gnus-opened-servers' to completion. Map entered method/address - into existing methods if possible. - - * gnus-group.el (gnus-group-make-group): Simplify method. - - * gnus-srvr.el (gnus-browse-unsubscribe-group): Simplify method. - - * mml.el (mml-preview): Remove mail-header-separator before - encoding. - -1999-11-05 20:28:27 Lars Magne Ingebrigtsen - - * message.el (message-read-from-minibuffer): New function. - -Fri Nov 5 19:10:02 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.98 is released. - -1999-11-05 01:27:49 Shenghuo ZHU - - * gnus-agent.el (gnus-agent-expire): Remove bad line in NOV. - -1999-11-04 22:20:35 Shenghuo ZHU - - * mml.el (mml-generate-mime-1): Read attached binary file in - binary mode. - -1999-11-03 16:08:56 Shenghuo ZHU - - * gnus-sum.el (gnus-summary-toggle-header): Fix arg bug. - -1999-11-03 15:27:38 Shenghuo ZHU - - * mailcap.el (mailcap-viewer-lessp): Fix bug. - -1999-11-02 17:28:33 Shenghuo ZHU - - * gnus-sum.el (gnus-summary-search-article): Fix loop search bug. - -1999-10-31 21:24:59 Shenghuo ZHU - - * gnus-art.el (gnus-article-mime-match-handle-first): New function. - (gnus-article-mime-match-handle-function): New variable. - (gnus-article-view-part): Make `b' customizable. - -1999-10-29 14:30:07 Shenghuo ZHU - - * gnus-sum.el (gnus-article-get-xrefs): Test eobp. - -1999-09-27 Hrvoje Niksic - - * mm-decode.el (mm-attachment-override-types): Exclude text/plain. - -1999-10-26 23:27:44 Shenghuo ZHU - - * mm-decode.el (mm-dissect-buffer): CTE may come without CTL. - -1999-10-26 21:44:05 Shenghuo ZHU - - * gnus-srvr.el (gnus-browse-foreign-server): Use - `buffer-substring' instead of `read'. - -1999-10-23 Simon Josefsson - - * nnimap.el, imap.el, rfc2104.el: New files. - - * gnus.el (gnus-valid-select-methods): Add nnimap. - - * gnus-group.el (gnus-group-group-map): Add - gnus-group-nnimap-edit-acl, gnus-group-nnimap-expunge. - (gnus-group-nnimap-expunge): New function. - (gnus-group-nnimap-edit-acl): New function. - - * gnus-agent.el (gnus-agent-group-mode-map): Add - gnus-agent-synchronize. - (gnus-agent-synchronize): New function. - (gnus-agent-fetch-group-1): Check if server is open. - - * nnagent.el (nnagent-request-set-mark): Save marks. - - * mail-source.el (mail-source-keyword-map): New imap mail-source. - (mail-source-fetcher-alist): Map to imap fetcher function. - (mail-source-fetch-imap): New function. - - * gnus-art.el (article-hide-pgp): Hide all headers, not just - Hash:. - -1999-10-22 11:03:00 Shenghuo ZHU - - * gnus-topic.el (gnus-topic-sort-topics-1): New function. - (gnus-topic-sort-topics): New function. - (gnus-topic-make-menu-bar): Add sort-topics. - (gnus-topic-move): New function. - (gnus-topic-move-group): Move the topic if no group selected. - -1999-10-13 21:31:50 Shenghuo ZHU - - * gnus-art.el (gnus-article-setup-buffer): Fix buffer leak. - -1999-10-13 12:52:18 Shenghuo ZHU - - * mm-view.el (mm-inline-message): Fix leaving group bug. - -1999-10-07 17:59:49 Shenghuo ZHU - - * gnus-msg.el (gnus-post-method): Use normal method if current is - not available. - -1999-10-07 17:09:34 Shenghuo ZHU - - * nnmail.el (nnmail-insert-xref): Dealing with empty articles. - (nnmail-insert-lines): Ditto. - -1999-10-07 Shenghuo ZHU - - * nnfolder.el (nnfolder-insert-newsgroup-line): Insert a blank - line. - - * message.el (message-unsent-separator): One more separator. - -1999-10-06 Shenghuo ZHU - - * nnfolder.el (nnfolder-request-move-article): For empty article, - search till (point-max). - (nnfolder-retrieve-headers): Ditto. - (nnfolder-request-accept-article): Ditto. - (nnfolder-save-mail): Ditto. - (nnfolder-insert-newsgroup-line): Ditto. - -1999-10-05 Shenghuo ZHU - - * qp.el (quoted-printable-encode-region): Check eobp. - -1999-10-03 Shenghuo ZHU - - * nntp.el (nntp-retrieve-headers-with-xover): Fix hanging problem. - -1999-10-02 Shenghuo ZHU - - * nntp.el (nntp-send-xover-command): Wait for nothing if not - wait-for-reply. - -1999-09-29 Shenghuo ZHU - - * mm-uu.el (mm-uu-forward-begin-line): Change the regexp. - (mm-uu-forward-end-line): Ditto. - -1999-09-29 Didier Verna - - * binhex.el (binhex-decode-region): don't consider the value of - `enable-multibyte-characters' in XEmacs. - - * gnus-start.el (gnus-read-descriptions-file): ditto. - - * mm-util.el (mm-multibyte-p): ditto. - (mm-with-unibyte-buffer): ditto. - (mm-find-charset-region): use `mm-multibyte-p'. - - * mm-bodies.el (mm-decode-body): ditto. - (mm-decode-string): ditto. - - * lpath.el ((string-match "XEmacs" emacs-version)): Don't define - `enable-multibyte-characters' in XEmacs. - -1999-09-29 Shenghuo ZHU - - * mm-util.el (mm-binary-coding-system): Try binary first. - -1999-09-14 Shenghuo ZHU - - * rfc1843.el (rfc1843-decode-article-body): Don't decode twice. - -1999-09-10 Shenghuo ZHU - - * gnus-art.el (article-make-date-line): Add time-zone in iso8601 - format. - (article-date-ut): Find correct insert position. - -1999-09-03 Shenghuo ZHU - - * mm-uu.el (mm-uu-dissect): Do not dissect quoted-printable - forwarded message. - -1999-09-27 20:33:41 Lars Magne Ingebrigtsen - - * gnus-topic.el (gnus-topic-find-groups): Work for unactivated - groups. - - * message.el (message-resend): Use message mode when prompting. - - * gnus-art.el (article-hide-headers): Mark wash. - (article-emphasize): Ditto. - -1999-09-27 19:52:14 Vladimir Volovich - - * message.el (message-newline-and-reformat): Work for SC. - -1999-09-27 19:38:33 Lars Magne Ingebrigtsen - - * gnus-msg.el (gnus-group-posting-charset-alist): 2047 in de.*. - - * gnus-sum.el (gnus-newsgroup-ignored-charsets): Add x-unknown. - -1999-10-20 David S. Goldberg - - * mm-decode.el mm-inline-override-types: New variable - - * mm-decode.el (mm-inline-override-p): New function - - * mm-decode.el (mm-inlined-p): Use it - -1999-10-20 David S. Goldberg - - * mm-decode.el mm-inline-override-types: New variable - - * mm-decode.el (mm-inline-override-p): New function - - * mm-decode.el (mm-inlined-p): Use it - -Mon Sep 27 15:18:05 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.97 is released. - -1999-09-01 Brendan Kehoe - - * gnus-sum.el (gnus-summary-catchup-and-goto-next-group): Use - gnus-summary-next-group, not gnus-summary-next-article. Only give - 3 args. - -1999-09-25 08:07:57 Lars Magne Ingebrigtsen - - * gnus-agent.el (gnus-agent-fetch-group-1): Look in the group - buffer for params. - - * gnus-xmas.el (gnus-xmas-summary-recenter): Display one more - line. - - * message.el (message-forward-ignored-headers): New variable. - - * gnus-art.el (gnus-article-prepare-display): Nix out - gnus-article-wash-types. - - * gnus-agent.el (gnus-agent-create-buffer): New function. - (gnus-agent-fetch-group-1): Use it. - (gnus-agent-start-fetch): Ditto. - - * gnus-sum.el (gnus-summary-exit): Don't use - `gnus-use-adaptive-scoring'. - - * mail-source.el (mail-source-fetch-pop): Only store password when - successful. - - * gnus-nocem.el (gnus-nocem-scan-groups): Message better. - -1999-09-24 18:43:23 Lars Magne Ingebrigtsen - - * message.el (message-reply): Use it. - (message-dont-reply-to-names): New variable. - - * nntp.el (nntp-open-telnet): Don't erase-buffer. - - * mm-util.el (mm-preferred-coding-system): Typo fix. - - * message.el (message-bounce): Work for non-MIME. - - * gnus.el (gnus-short-group-name): Short the right parts of the - name. - -1999-09-24 18:17:48 Johan Kullstam - - * mm-encode.el (mm-qp-or-base64): New version. - -1999-09-10 Shenghuo ZHU - - * gnus-art.el (article-make-date-line): Fix time-zone bug. - -1999-09-09 Shenghuo ZHU - - * gnus-art.el (gnus-article-add-buttons): Don't delete markers out - of restricted region. - (gnus-mime-display-single): Set beg at correct point. - -1999-09-09 Shenghuo ZHU - - * nnmail.el (nnmail-process-maildir-mail-format): Typo. - -1999-09-09 Jens-Ulrik Petersen - - * gnus-msg.el (gnus-configure-posting-styles): Let - `gnus-posting-styles' have its say in posting-style: local - variable `styles' is already bound to `gnus-posting-styles' so - don't rebind it to nil. - -1999-09-24 18:10:56 Robert Bihlmeyer - - * gnus-score.el (gnus-summary-increase-score): Allow editing of - Message-ID. - -1999-09-08 Shenghuo ZHU - - * mm-encode.el (mm-encode-content-transfer-encoding): Fold - quoted-printable-encode-region. - - * qp.el (quoted-printable-encode-region): Assume charset - encoded. Fold every line in the region. - -1999-09-02 Shenghuo ZHU - - * gnus-srvr.el (gnus-browse-foreign-server): Read the first line - of active file. - -1999-09-01 Didier Verna - - * message.el (message-mode): allows whitespaces between multiple - instances of the fill character ">". - -1999-09-24 18:02:50 Kim-Minh Kaplan - - * mm-encode.el (mm-qp-or-base64): Fix. - -1999-09-01 12:18:01 Katsumi Yamaoka - - * message.el (message-send): Too much and. - -1999-09-24 17:58:07 Andreas Schwab - - * gnus-art.el (gnus-mime-view-part-as-type): Renamed. - -1999-08-28 12:44:20 Lars Magne Ingebrigtsen - - * gnus-score.el (gnus-score-headers): Work for nil scores. - -1999-08-27 20:46:11 Lars Magne Ingebrigtsen - - * gnus-cache.el (gnus-cache-write-active): Write full names. - - * gnus-util.el (gnus-write-active-file): Accept full name. - - * mm-decode.el (mm-inlinable-p): Use string-match on the types. - (mm-assoc-string-match): New function. - (mm-display-inline): Use it. - - * gnus-group.el (gnus-group-set-info): Work for nil group params. - - * gnus-msg.el (gnus-configure-posting-styles): Allow eval. - -1999-08-27 19:08:10 Florian Weimer - - * mml.el (mml-generate-multipart-alist): New variable. - -1999-08-27 15:30:02 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-treat-predicate): Work for (not 5). - -1999-08-27 Peter von der Ahe - - * message.el (message-send): More helpful error message if sending - fails - -1999-09-06 Robert Bihlmeyer - - * gnus-score.el (gnus-summary-increase-score): "Lars" was broken - in newer emacsen, where ?r isn't equal 114. - -Fri Aug 27 13:17:48 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.96 is released. - -1999-08-17 Simon Josefsson - - * gnus-start.el (gnus-groups-to-gnus-format): Only use agent - to get active info if method is covered by agent, otherwise - active info is lost. - -1999-08-17 Simon Josefsson - - * gnus-sum.el (gnus-summary-move-article): Report backend errors. - -1999-08-09 Dave Love - - * mm-util.el: Use `defalias', not `fset' for dummy functions. - -1999-08-09 Simon Josefsson - - * gnus-art.el (gnus-ignored-headers): Remove "X-Pgp-*" - (already matched by "^X-Pgp"), removed duplicate - X-Mailing-List, added several new junk headers. - -1999-08-01 Simon Josefsson - - * gnus-art.el (article-decode-charset): Don't assume - gnus-summary-buffer is live. - -1999-08-27 15:07:43 Paul Flinders - - * smiley.el (smiley-deformed-regexp-alist): Fix % smileys. - -1999-08-27 15:02:58 Florian Weimer - - * gnus-score.el (gnus-home-score-file): Work with absolute path - names. - -1999-07-17 Shenghuo ZHU - - * gnus-sum.el (gnus-articles-to-read): Return cached articles if - nothing else in the group. - -1999-07-16 Shenghuo ZHU - - * gnus-bcklg.el (gnus-backlog-enter-article): Check the size of - the article. - -1999-07-15 Shenghuo ZHU - - * mm-uu.el (mm-uu-dissect): Fix for base64 message. - -1999-07-15 Shenghuo ZHU - - * mm-uu.el (mm-uu-forward-end-line): Support forwarded message - from mutt. - -1999-07-14 Shenghuo ZHU - - * mm-bodies.el (mm-decode-content-transfer-encoding): Delete - whitespace. - -1999-07-14 Shenghuo ZHU - - * mm-util.el (mm-text-coding-system-for-write): New variable. - (mm-append-to-file): New function. - (mm-write-region): New function. - - * gnus-art.el (gnus-output-to-file): Use it. - * gnus-util.el (gnus-output-to-rmail): Ditto. - (gnus-output-to-mail): Ditto. - * gnus-uu.el (gnus-uu-binhex-article): Ditto. - -1999-07-14 Shenghuo ZHU - - * nnmail.el (nnmail-find-file): Use mm-auto-mode-alist. - - * nnheader.el (nnheader-insert-file-contents): Revert and use - mm-insert-file-contents. - (nnheader-find-file-noselect): Use mm-auto-mode-alist. - (nnheader-auto-mode-alist): Removed. - - * mm-util.el (mm-inhibit-file-name-handlers): New variable. - (mm-insert-file-contents): Add a new parameter for inserting - compressed file literally. - - * mml.el (mml-generate-mime-1): Insert non-text literally. - - * gnus.el: Change most mm-insert-file-contents back to nnheader. - -1999-07-13 Hrvoje Niksic - - * gnus-art.el (gnus-unbuttonized-mime-types): Fix docstring. - -1999-08-27 14:53:42 Oleg S. Tihonov - - * gnus-sum.el (gnus-group-charset-alist): Default fido7 to - koi8-r. - -1999-07-11 Shenghuo ZHU - - * mml.el (mml-insert-mime): Decode text. - (mml-to-mime): Narrow to headers-or-head. - -1999-07-11 Shenghuo ZHU - - * mm-view.el (mm-inline-text): Check - w3-meta-content-type-charset-regexp. - -1999-07-10 Simon Josefsson - - * gnus-agent.el (gnus-agent-fetch-group-1): Search topics for - predicate. - -1999-07-10 Alexandre Oliva - - * gnus-mlspl.el: Documentation fixes. - -1999-08-27 14:42:14 Rui Zhu - - * gnus-sum.el (gnus-summary-limit-to-age): Prompt better. - -1999-08-27 14:40:52 Michael Cook - - * gnus-art.el (gnus-article-setup-buffer): Kill all local - variables. - -1999-08-27 14:39:34 Hrvoje Niksic - - * nnmail.el (nnmail-get-new-mail): "Done". - -1999-08-27 14:38:14 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-kill-all-zombies): Only prompt when - interactive. - -1999-07-12 Shenghuo ZHU - - * gnus-art.el (article-decode-charset): Fix broken CT. - -1999-07-12 Shenghuo ZHU - - * gnus-agent.el (gnus-agent-fetch-group-1): Recreate agent - overview buffer if it is killed. - -1999-08-27 14:26:03 Eric Marsden - - * gnus-art.el (article-babel): New version. - -1999-08-27 14:22:39 Jon Kv - - * nnfolder.el (nnfolder-request-list-newsgroups): Faster expiry. - -1999-07-10 Mike McEwan - - * gnus.texi (More Threading): Document new variable - `gnus-sort-gathered-threads-function'. - -1999-07-10 Mike McEwan - - * gnus.texi (More Threading): Document new variable - `gnus-sort-gathered-threads-function'. - -1999-07-11 Andreas Jaeger - - * gnus-uu.el (gnus-uu-digest-mail-forward): Delete file after - usage. - -1999-07-10 Shenghuo ZHU - - * mm-util.el (mm-running-xemacs): Removed. - (mm-coding-system-p): New function. - (mm-binary-coding-system): Safe guess. - (mm-text-coding-system): Ditto. - (mm-auto-save-coding-system): Ditto. - -1999-07-11 11:02:03 Lars Magne Ingebrigtsen - - * mm-encode.el (mm-qp-or-base64): Also consider control chars. - (mm-qp-or-base64): Reversed logic. - - * mm-decode.el (mm-save-part-to-file): Let coding system be - binary. - -1999-07-15 Mike McEwan - - * gnus-agent.el (gnus-agent-fetch-group-1): Allow 'agent-score' to - be set in topic parameters. - -1999-07-10 Mike McEwan - - * gnus-sum.el (gnus-sort-gathered-threads-function): New variable. - (gnus-sort-gathered-threads): Allow the user to specify the - function to use when sorting gathered threads. - - * gnus-agent.el (gnus-agent-get-undownloaded-list): Don't - mark cached articles as `undownloaded'. - -Tue Jul 20 02:39:56 1999 Peter von der Ahe - - * gnus-sum.el (gnus-summary-exit): Allow gnus-use-adaptive-scoring - to have buffer local values. - -1999-07-25 Matt Pharr - - * gnus-group.el (gnus-group-make-doc-group): Notice when user - types 'g' for 'guess group type. - -1999-07-30 Simon Josefsson - - * nnmail.el (nnmail-remove-list-identifiers): Remove whitespace - after each regexp in nnmail-list-identifiers, not just after last - one. - - * gnus-sum.el (gnus-list-identifiers): New variable. - (gnus-summary-remove-list-identifiers): New function. - (gnus-select-newsgroup): Use it. - (gnus-summary-wash-hide-map): Bind - `gnus-article-hide-list-identifiers' to W W l. - (gnus-summary-make-menu-bar): Add list-identifiers command. - - * gnus-art.el (gnus-treat-strip-list-identifiers): New variable. - (gnus-treatment-function-alist): Add variable. - (article-hide-list-identifiers): New function. - (mapcar): Add function. - (gnus-article-hide): Use it. - -Fri Jul 9 22:21:16 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.95 is released. - -1999-07-09 21:46:05 Lars Magne Ingebrigtsen - - * mm-decode.el (mm-mailcap-command): New function. - (mm-display-external): Use it. - - * gnus-art.el (article-make-date-line): Work for India. - - * mm-encode.el (mm-qp-or-base64): Typo. - - * gnus-topic.el (gnus-topic-goto-topic): Made into command. - -Fri Jul 9 19:28:29 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.94 is released. - -1999-07-09 21:19:23 Stainless Steel Rat - - * pop3.el: New version. - -1999-07-09 20:01:44 Lars Magne Ingebrigtsen - - * mm-encode.el (mm-qp-or-base64): New function. - (mm-content-transfer-encoding): Use it. - - * gnus-util.el (gnus-parse-netrc): Allow quoted names. - -1999-07-08 Shenghuo ZHU - - * mm-decode.el (mm-display-external): Fix typo and use 'non-viewer. - - * mailcap.el (mailcap-mailcap-entry-passes-test): Add needsterminal. - -1999-07-09 18:52:22 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-mime-view-part-as-media): New command and - keystroke. - - * mailcap.el (mailcap-mime-types): New function. - - * nnmh.el (nnmh-request-group): Update nnmh-group-alist. - - * message.el (message-goto-eoh): Really go to the end. - -1999-07-09 18:40:23 Puneet Goel - - * message.el (message-make-date): Do the right thing in with - sub-hour time zones. - -1999-07-09 18:36:21 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-make-menu-bar): Removed double bug - report. - -1999-07-08 Shenghuo ZHU - - * nnfolder.el (nnfolder-request-rename-group): Create directory. - -1999-07-08 Shenghuo ZHU - - * mailcap.el (mailcap-parse-mailcap): Skip \;. - (mailcap-parse-mailcap-extras): Fix "nonterminal;" and empty name, - and use t as default value. - -Wed Jul 7 18:40:30 1999 Shenghuo ZHU - - * gnus-sum.el (gnus-get-newsgroup-headers): Don't assume - gnus-summary-buffer is live. - -1999-07-09 17:44:03 Robert Pluim - - * mm-util.el (mm-enable-multibyte): Check whether var bound. - -1999-07-09 17:31:39 Lars Magne Ingebrigtsen - - * message.el (message-bounce): Do MIME bounces MIMEy. - - * gnus-sum.el (gnus-summary-read-group-1): Update mark positions. - -1999-07-08 08:41:10 Lars Magne Ingebrigtsen - - * mailcap.el (mailcap-mime-extensions): Changed patch to - text/x-patch. - - * mm-decode.el (mm-display-external): Wrong placement of paren. - -Wed Jul 7 13:09:51 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.93 is released. - -1999-07-08 Alexandre Oliva - - * gnus-cus.el (gnus-group-parameters): New entries for - gnus-group-split. - - * gnus-mlspl.el: Renamed functions and variables so as to - start with gnus-group-split. - * gnus.el: Adjust autoload entries. - -1999-07-07 Alexandre Oliva - - * gnus-mlspl.el: Removed trailing t from comment and provide. - Renamed functions and variables to start with gnus-mlsplit. - Added autoload comments. - * gnus.el: Added autoload entries. - -1999-07-06 05:37:46 Alexandre Oliva - - * nnmail.el (nnmail-split-it): Search the regexp multiple times, - so that matches excluded by RESTRICTs do not cause the whole split - to be ignored. This also fixes a long-standing bug in which a - split with \N substitutions wouldn't cause cross-posting as - expected. - - * nnmail.el (nnmail-split-fancy): Document RESTRICT clauses. - (nnmail-split-it): Implement them. - - * nnmail.el (nnmail-split-fancy): Document ! splits. - -1999-07-07 10:41:11 Stainless Steel Rat - - * pop3.el: New version. - -1999-07-05 Simon Josefsson - - * gnus-srvr.el (gnus-browse-foreign-server): Use read. - -1999-07-07 10:37:26 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-mime-display-alternative): Do treatment. - -1999-07-06 Shenghuo ZHU - - * gnus-util.el (gnus-write-active-file): Use real name. - - * gnus-agent.el (gnus-agent-expire): Update active file - method by method. - -1999-07-06 Shenghuo ZHU - - * nndraft.el (nndraft-request-article): Use difference - coding-systems for queue and drafts. - - * gnus-sum.el (gnus-summary-setup-default-charset): Special-case - nndraft:drafts. - - * mm-util.el (mm-auto-save-coding-system): New coding system. - - * message.el (message-draft-coding-system): Use it. - -1999-07-06 Shenghuo ZHU - - * mm-uu.el: More customizable and less aggressive. - -1999-07-07 07:53:23 Lars Magne Ingebrigtsen - - * gnus-start.el (gnus-groups-to-gnus-format): Only gnus-active - when plugged. - - * mml.el (mml-generate-mime-1): Don't insert nofile files. - (mml-insert-mml-markup): Accept a nofile. - (mml-insert-mime): Insert nofile. - - * gnus-art.el (gnus-treat-strip-blank-lines): Removed. - - * mm-decode.el (mm-handle-media-type): New function. - (mm-handle-media-supertype): New function. - (mm-handle-media-subtype): New function. - Use new functions throughout. "/")) - -1999-05-18 03:03:50 Katsumi Yamaoka - - * gnus-art.el (gnus-treat-predicate): Typo. - -1999-07-07 06:21:36 Lars Magne Ingebrigtsen - - * gnus-score.el (gnus-summary-score-entry): Made un-interactive. - -1999-07-06 17:57:16 Lars Magne Ingebrigtsen - - * gnus-art.el (article-date-ut): UT! Default it! - -Tue Jul 6 10:59:24 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.92 is released. - -1999-07-06 12:30:59 Johannes Weinert - - * gnus-sum.el (gnus-summary-catchup-and-exit): Doc fix. - -1999-07-06 07:41:07 Lars Magne Ingebrigtsen - - * nntp.el (nntp-retrieve-groups): Don't do anything when not - connected. - - * gnus-start.el (gnus-active-to-gnus-format): Only save active - when plugged. - - * mm-view.el (mm-inline-message): Ignore remove-spec. - - * gnus-agent.el (gnus-agent-write-active): Check whether orig sym - is bound. - - * gnus-msg.el (gnus-summary-mail-forward): Rename From_ lines. - - * nndoc.el (nndoc-guess-type): Remove blank lines at the start. - - * nnfolder.el (nnfolder-read-folder): Remove blank lines at the - start. - - * message.el (message-fill-yanked-message): Remove `t' arg. - - * gnus-group.el (gnus-group-kill-group): Message killing of - groups. - - * mm-util.el (mm-preferred-coding-system): New function. - (mm-mime-charset): Use it. - - * mml.el (mml-generate-mime-1): Charset-encode message parts. - -1999-07-06 07:03:31 Alexandre Oliva - - * gnus-mlsplt.el: New file. - -1999-07-06 05:47:57 Lars Magne Ingebrigtsen - - * mm-decode.el (mm-inline-Media-tests): Changed from forms to - functions. - (mm-attachment-override-p): Take a handle instead of a type. - (mm-inlined-p): Ditto. - (mm-automatic-display-p): Ditto, - (mm-inlinable-p): Ditto. - - * nndraft.el (nndraft-request-expire-articles): Delete backup - files. - - * mailcap.el (mailcap-parse-mailcap): Regexp-quote stuff. - - * gnus-sum.el (gnus-summary-limit-to-extra): Typo. - -1999-07-06 05:37:46 Alexandre Oliva - - * nnmail.el (nnmail-split-it): Allow .*. - -1999-07-05 05:04:57 Lars Magne Ingebrigtsen - - * mm-decode.el (mm-inline-large-images-p): Renamed. - - * gnus-art.el (article-date-ut): Always look in the current buffer - for the Date header. - - * mml.el (mml-validate): New command. - - * mailcap.el (mailcap-possible-viewers): Revert to string-match - since we are dealing with regexps. - -Sun Jul 4 06:31:01 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.91 is released. - -1999-07-04 04:35:28 Lars Magne Ingebrigtsen - - * gnus-agent.el (gnus-agent-save-active-1): New function. - (gnus-agent-save-active): use it. - (gnus-agent-save-groups): Ditto. - - * gnus-cache.el (gnus-cache-write-active): Use it. - - * gnus-agent.el (gnus-agent-write-active): Use it. - - * gnus-util.el (gnus-write-active-file): New function. - - * gnus-agent.el (gnus-agent-write-active): New function to keep - lower boundaries and canceled groups. - (gnus-agent-save-groups): Use it. - (gnus-agent-save-active): Use it. - (gnus-agent-save-group-info): Only write active files. - (gnus-agent-expire): Update active file. - - * mm-decode.el (mm-inlinable-part-p): Removed. - (mm-user-display-methods): Default to nil. - (mm-user-display-methods): Removed. - (add-mime-display-method): Removed. - (mm-automatic-display): Renamed. - (mm-automatic-display-p): Use it. - (mm-inlined-types): New variable. - (mm-inlined-p): New function. - - * message.el (message-reply): Bind message-this-is-mail. - -1999-07-03 13:16:31 Michael Klingbeil - - * smiley.el (smiley-buffer): Fix for NT. - -1999-07-03 11:26:47 Lars Magne Ingebrigtsen - - * mm-encode.el (mm-encode-buffer): Check whether we have 7bit. - - * message.el (message-check-news-header-syntax): Protect against - nil froms. - - * mm-util.el (mm-auto-mode-alist): New. - - * mml.el (mml-generate-mime-1): Ditto. - - * gnus.el: Use mm-insert-file-contents throughout instead of - nnheader. - - * mm-util.el (mm-insert-file-contents): New function. - -Sat Jul 3 07:35:35 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.90 is released. - -1999-07-03 09:31:10 Sven Fischer - - * mailcap.el (mailcap-possible-viewers): Use string=. - -1999-07-01 Shenghuo ZHU - - * mm-uu.el (mm-uu-forward-begin-line): New variable. - (mm-uu-forward-end-line): New variable. - (mm-uu-begin-line): Handle forwarded message. - (mm-uu-identifier-alist): Ditto. - (mm-uu-dissect): Ditto. - -1999-06-29 Shenghuo ZHU - - * lpath.el: Two free variables. - -1999-07-02 Shenghuo ZHU - - * nnheader.el (nnheader-file-coding-system): Use raw-text. - * gnus-agent.el (gnus-agent-file-coding-system): Ditto. - * gnus-cache.el (gnus-cache-coding-system): Ditto. - - * nnfolder.el (nnfolder-file-coding-system): Use mm-text-coding-system. - (nnfolder-file-coding-system-for-write): New variable. - (nnfolder-active-file-coding-system): New variable. - (nnfolder-active-file-coding-system-for-write): New variable. - (nnfolder-save-active): New function. - (nnfolder-save-buffer): Use them. - (nnfolder-possibly-change-group): Ditto. - (nnfolder-request-list-newsgroups): Ditto. - (nnfolder-request-create-group): Ditto. - (nnfolder-request-expire-articles): Ditto. - (nnfolder-request-move-article): Ditto. - (nnfolder-request-accept-article): Ditto. - (nnfolder-request-delete-group): Ditto. - (nnfolder-request-rename-group): Ditto. - (nnfolder-possibly-change-folder): Ditto. - (nnfolder-read-folder): Ditto. - (nnfolder-request-list): Remove pathname-coding-system. - (nnfolder-possibly-change-group): Use nnmail-pathname-coding-system. - - * nnmail.el (nnmail-file-coding-system): Use raw-text. - (nnmail-file-coding-system-1): Removed. - (nnmail-find-file): Use nnmail-pathname-coding-system. - (nnmail-write-region): Ditto. - - * nnmbox.el (nnmbox-file-coding-system): New variable. - (nnmbox-file-coding-system-for-write): New variable. - (nnmbox-active-file-coding-system): New variable. - (nnmbox-active-file-coding-system-for-write): New variable. - (nnmbox-save-buffer): New function. - (nnmbox-save-active): New function. - (nnmbox-request-scan): Use them. - (nnmbox-request-expire-articles): Ditto. - (nnmbox-request-move-article): Ditto. - (nnmbox-request-accept-article): Ditto. - (nnmbox-request-replace-article): Ditto. - (nnmbox-request-delete-group): Ditto. - (nnmbox-request-rename-group): Ditto. - (nnmbox-request-create-group): Ditto. - - * mm-util.el (mm-text-coding-system): raw-text or -dos. - (mm-running-ntemacs): Removed. - - * nnml.el (nnml-file-coding-system): Use nnmail-file-coding-system. - -1999-07-02 Shenghuo ZHU - - * nnfolder.el (nnfolder-read-folder): Use nnheader-file-coding-system. - -1999-07-01 Shenghuo ZHU - - * qp.el (quoted-printable-encoding-characters): Support lower case. - -1999-07-01 Shenghuo ZHU - - * rfc2047.el (rfc2047-encode): Fold before B-encoding. - (rfc2047-b-encode-region): Encode line by line. - -1999-07-03 09:20:16 Lars Magne Ingebrigtsen - - * mm-util.el (mm-find-mime-charset-region): Fix. - -1999-06-30 KOSEKI Yoshinori - - * mm-util.el (mm-mime-mule-charset-alist): Fix iso-2022-jp(-2) bug. - (mm-find-mime-charset-region): Ditto. - -1999-07-03 09:15:35 Simon Josefsson - - * gnus-sum.el (gnus-summary-move-article): Fix something or - other. - -1999-06-29 Shenghuo ZHU - - * gnus-sum.el (gnus-newsgroup-ephemeral-charset): New variable. - (gnus-newsgroup-ephemeral-ignored-charsets): New variable. - (gnus-summary-enter-digest-group): Use them. - (gnus-summary-setup-default-charset): Ditto. - -1999-06-15 Shenghuo ZHU - - * base64.el (base64-run-command-on-region): Use unibyte buffer. - -1999-06-15 Shenghuo ZHU - - * gnus-msg.el (gnus-configure-posting-styles): Fix bug when - gnus-newsgroup-name is nil. - -1999-06-15 Shenghuo ZHU - - * rfc2047.el (rfc2047-encode): Chop the tail newline. - -1999-06-15 Shenghuo ZHU - - * gnus-art.el (article-emphasize): Use correct - gnus-article-emphasis-alist. - -1999-06-15 Shenghuo ZHU - - * mm-view.el (mm-inline-text): Fix text/html bug. - -Mon Jun 28 17:54:01 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.89 is released. - -1999-06-24 Shenghuo ZHU - - * nnmail.el (nnmail-file-coding-system-1): For NTEmacs in Windows. - * message.el (message-draft-coding-system): Ditto. - * mm-util.el (mm-running-ntemacs): Ditto. - -1999-06-23 Shenghuo ZHU - - * gnus-xmas.el (gnus-xmas-summary-recenter): A blank line may - cause problem. - -1999-06-23 Shenghuo ZHU - - * mm-view.el (mm-inline-text): Ignore error in w3-region. - -1999-06-23 Shenghuo ZHU - - * mml.el: require mm-decode. - -1999-06-23 Shenghuo ZHU - - * gnus-art.el (gnus-display-mime): Treat as head only if necessary. - -1999-06-23 Shenghuo ZHU - - * mm-view.el (mm-inline-image): Fix image undisplayer. - -1999-06-22 Shenghuo ZHU - - * mml.el (mml-insert-multipart): Error in compeling-read. - (mml-insert-tag): Match tags. - -1999-06-19 Shenghuo ZHU - - * gnus-cache.el (gnus-cache-braid-nov): Fix coding-system bug. - (gnus-cache-braid-heads): Ditto. - (gnus-cache-retrieve-headers): Ditto. - -1999-06-16 Shenghuo ZHU - - * gnus-draft.el (gnus-draft-send): Fix encoding bug. - -1999-06-16 10:17:29 Katsumi Yamaoka - - * gnus-art.el (gnus-article-read-summary-keys): Convert key events - to string under XEmacs. - -1999-06-28 19:34:03 Petersen Jens-Ulrik - - * gnus-start.el (gnus-find-new-newsgroups): Doc fix. - -1999-06-22 Shenghuo ZHU - - * mm-view.el (mm-inline-message): Fix message view bug. - * gnus-art.el (gnus-article-prepare): Ditto. - -1999-06-16 Shenghuo ZHU - - * gnus-cache.el (gnus-cache-possibly-enter-article): Fetch headers. - -Tue Jun 15 04:13:01 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.88 is released. - -1999-06-15 04:13:45 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-save-parts): Destroy handles after - usage. - - * nnmail.el (nnmail-get-new-mail): Save info. - -Mon Jun 14 01:15:59 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.87 is released. - -1999-06-14 02:46:05 Lars Magne Ingebrigtsen - - * mail-source.el (mail-source-fetch-file): Use prescript-delay. - (mail-source-run-script): New function. - (mail-source-fetch-pop): Use it. - -1999-06-13 09:52:11 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-setup-highlight-words): Moved here. - -Sun Jun 13 07:30:40 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.86 is released. - -1999-06-13 08:51:25 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-treat-translate): New variable. - (gnus-treat-predicate): Accept a list of regexps. - (gnus-article-treat-custom): Allow a list of regexps. - -1999-06-09 Markus Rost - - * gnus/gnus-group.el (gnus-permanently-visible-groups): Fix custom - type. - -1999-06-13 05:15:52 Lars Magne Ingebrigtsen - - * gnus-art.el (article-babel): Narrow a bit. - - * gnus-agent.el (gnus-agent-get-undownloaded-list): Was too slow. - -1999-06-12 Simon Josefsson - - (gnus-agent-get-undownloaded-list): Operate on all articles, not - only unread ones. - (gnus-agent-fetch-headers): Fetch headers from unread and marked - articles, not only unread ones. - -1999-06-13 03:01:35 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-limit-to-extra): New command and - keystroke. - - * gnus-art.el (gnus-article-x-face-command): Ditto. - - * gnus-uu.el (gnus-uu-default-view-rules): Default to "display". - - * gnus.el (gnus-method-simplify): Accept server names. - -1999-06-13 02:36:15 Per Abrahamsen - - * gnus-art.el (article-babel-prompt): New function. - (article-babel): New command. - -1999-06-13 01:01:52 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-part-wrapper): Go to part. - - * mml.el (mml-generate-mime-1): Don't insert literally. - - * gnus-util.el (gnus-parse-netrc): Skip lines with #'s. - (gnus-netrc-syntax-table): Removed. - (gnus-parse-netrc): Don't use syntax table; just use whitespace. - -Wed May 5 13:51:13 1999 Shenghuo ZHU - - * mm-view.el (mm-inline-text): Fix charset for text/html. - -Wed May 5 01:15:08 1999 Shenghuo ZHU - - * message.el (message-draft-coding-system): Use emacs-mule-dos. - -1999-06-12 07:29:39 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-split-incoming): Return the number of split - mails. - (nnmail-process-babyl-mail-format): Ditto. - (nnmail-process-unix-mail-format): Ditto. - (nnmail-process-mmdf-mail-format): Ditto. - (nnmail-process-maildir-mail-format): Ditto. - - * mail-source.el (mail-source-callback): Return the number from - the callback. - - * message.el (message-send-mail): Generate Lines. - - * mail-source.el (mail-source-call-script): New function. - (mail-source-call-script): New function. - -Sun May 2 02:00:27 1999 Shenghuo ZHU - - * gnus-sum.el (gnus-summary-setup-highlight-words): New function. - (gnus-select-newsgroup): Use it. - (gnus-group-highlight-words-alist): New variable. - (gnus-newsgroup-emphasis-alist): New variable. - (gnus-summary-local-variables): Use it. - * lpath.el: Use it. - * gnus-art.el (article-emphasize): Use it. - (gnus-emphasis-highlight-words): New face. - * gnus-cus.el (gnus-group-parameters): New parameter. - -Sun May 2 01:00:02 1999 Shenghuo ZHU - - * gnus-cache.el (gnus-cache-possibly-enter-article): Remove - parameter `headers'. - (gnus-cache-enter-article): Ditto. - (gnus-cache-update-article): Ditto. - * gnus-sum.el (gnus-summary-move-article): Ditto. - (gnus-summary-mark-article-as-unread): Ditto. - (gnus-summary-mark-article): Ditto. - -1999-06-12 03:59:56 Lars Magne Ingebrigtsen - - * gnus-msg.el (gnus-message-insert-stylings): Removed. - (gnus-posting-style-alist): Removed. - (gnus-message-style-insertions): Ditto. - (gnus-configure-posting-styles): Reimplementation. - - * mail-source.el (mail-source-fetch): Error the message. - - * gnus-msg.el (gnus-inews-do-gcc): Do mml and encoding. - -Sat Jun 12 00:19:57 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.85 is released. - -1999-04-20 Michael Cook - - * gnus-cite.el (gnus-cite-attribution-prefix): Tweak for MS - Outlook citation regex. - -1999-06-12 02:09:49 Lars Magne Ingebrigtsen - - * nndoc.el (nndoc-mime-parts-type-p): Accept space before - semicolon. - -1999-05-24 Simon Josefsson - - * gnus-range.el (gnus-remove-from-range): Document range1 - modification, protect range2. - -1999-05-24 Simon Josefsson - - * gnus-sum.el (gnus-update-marks): Protect lists from - gnus-remove-from-range, don't sort twice. - -1999-05-21 Simon Josefsson - - * gnus-start.el (gnus-read-descriptions-file): Protect if no - function in backend. - -1999-05-15 Simon Josefsson - - * gnus-sum.el (gnus-valid-move-group-p): Check for a - request-accept-article function in the backend instead of using - the 'respool capability. - -1999-04-18 Hrvoje Niksic - - * mm-bodies.el (mm-decode-content-transfer-encoding): Handle - spurious whitespace at eob. - -1999-06-12 02:02:06 Adrian Aichner - - * nnmail.el (nnmail-get-new-mail): Check right variable. - -1999-06-12 01:57:39 Karl Kleinpaste - - * mailcap.el (mailcap-mime-data): Fix rfc822. - -1999-06-11 23:48:50 TOZAWA Akihiko - - * nndoc.el (nndoc-nsmail-type-p): New function. - (nndoc-type-alist): Recognize nsmail. - -1999-05-12 Mike McEwan - - * gnus-art.el (gnus-treatment-function-alist): Display `x-face' - *before* `article-hide-headers' deletes the information. - -1999-05-22 00:26:46 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-save-parts): New command and - keystroke. - (gnus-summary-save-parts-1): New function. - (gnus-summary-iterate): Buggy. - - * mm-decode.el (mm-save-part-to-file): Made into own function. - -1999-05-11 05:53:16 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-set-info): Resist nils. - -1999-05-04 19:26:08 Lars Magne Ingebrigtsen - - * mailcap.el (mailcap-mime-data): Ditto. - - * gnus-uu.el (gnus-uu-default-view-rules): Ditto. - - * gnus-art.el (gnus-article-x-face-command): Default to ee. - -1999-05-02 Gareth Jones - - * gnus-art.el (article-make-date-line): Put X-Sent below Date if - gnus-article-date-lapsed-new-header is t. - -Sat May 1 20:27:43 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.84 is released. - -1999-05-01 22:23:21 Lars Magne Ingebrigtsen - - * gnus-msg.el (gnus-bug-message): Mime change. - -1999-04-22 Simon Josefsson - - * gnus-sum.el (gnus-update-marks): Process null mark lists. - -1999-04-21 Hrvoje Niksic - - * mm-bodies.el (mm-decode-content-transfer-encoding): Recognize - `x-uue'. - -1999-03-04 Aaron M. Ucko - - * mail-source.el (mail-source-fetch-pop): Only prompt for password - when authentication is 'password. - -1999-05-01 22:17:55 - - * gnus-win.el (gnus-configure-windows): Accept a setting. - -1999-04-21 20:51:13 Lars Magne Ingebrigtsen - - * mm-util.el (mm-quote-arg): Moved here. - - * mm-decode.el (mm-quote-arg): Quote more chars. - -1999-04-18 20:12:49 Lars Magne Ingebrigtsen - - * nnheader.el (nnheader-parse-head): Message-ID in In-Reply-To - with newlines would create buggy .nov files. - - * gnus-art.el (gnus-article-date-lapsed-new-header): Default to nil. - - * qp.el (quoted-printable-encode-region): Encode whitespace at the - end of lines. - - * message.el (message-mode): Doc fix. - - * gnus-art.el (article-hide-headers): Delete the hidden headers. - - * gnus-msg.el (gnus-setup-posting-charset): Default group to "". - - * gnus-art.el (article-date-ut): Rewrite. - - * mm-decode.el (mm-preferred-alternative-precedence): Reverse the - order. - - * gnus-msg.el (gnus-message-insert-stylings): Remove duplicate - headers. - - * gnus-art.el (gnus-article-date-lapsed-new-header): Doc fix. - -1999-04-18 Didier Verna - - * gnus-art.el (gnus-article-date-lapsed-new-header): new variable. - (article-date-ut): use it. - -1999-04-18 20:06:20 Lars Magne Ingebrigtsen - - * mail-source.el (mail-source-fetch-pop): Call script - asynchronously. - -Sun Apr 18 12:40:04 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.83 is released. - -1999-04-18 10:55:57 Lars Magne Ingebrigtsen - - * gnus-draft.el (gnus-draft-mode): Use mml minor mode. - - * gnus-cite.el (gnus-dissect-cited-text): Off-by-one error. - - * gnus-uu.el (gnus-uu-mark-thread): Save hidden threads. - - * gnus-art.el (gnus-mime-inline-part): Don't do a charset param. - - * gnus-msg.el (gnus-bug): Use application/x-emacs-lisp. - - * message.el (message-generate-headers): Accept continuation - headers. - -1999-04-18 10:48:57 Renaud Rioboo - - * gnus-demon.el (gnus-demon-time-to-step): Not strings. - -1999-04-18 08:21:52 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-treatment-function-alist): use - maybe-hide-headers. - - * message.el (message-inhibit-body-encoding): Typo. - (message-resend): Inhibit encoding. - - * gnus-sum.el (gnus-summary-toggle-header): Decode rfc2047. - - * gnus-art.el (article-remove-cr): Use re-search. - - * rfc2231.el (rfc2231-parse-string): Allow broken elm MIME - headers. - - * mm-decode.el (mm-quote-arg): Quote '. - - * gnus-ems.el (gnus-x-splash): Would place splash wrongly. - - * mm-decode.el (mm-insert-part): Use multibyte for text. - - * gnus-start.el (gnus-read-newsrc-file): New variable. - (gnus-read-newsrc-file): Use it. - -1999-04-17 18:51:54 Lars Magne Ingebrigtsen - - * nnvirtual.el (nnvirtual-request-expire-articles): New function. - - * gnus-group.el (gnus-group-expire-articles-1): Made into own - function. - -Sat Apr 17 16:41:30 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.82 is released. - -1999-04-15 Hrvoje Niksic - - * gnus-sum.el (gnus-group-charset-alist): Include Croatian groups - for iso8859-2. - -1999-04-17 18:23:50 Lars Magne Ingebrigtsen - - * mm-util.el (mm-charset-synonym-alist): Remove iso-2022-jp-2 from - synonym alist. - -1999-04-17 18:03:38 Adam P. Jenkins - - * gnus-sum.el (gnus-summary-local-variables): Mark as global. - -1999-04-17 18:02:05 Ettore Perazzoli - - * mail-source.el (mail-source-fetch): Ask before bugging out. - -1999-03-19 Hrvoje Niksic - - * uudecode.el (uudecode-decode-region-external): Don't assume - uudecode-temporary-file-directory ends with a slash. - -1999-03-18 Simon Josefsson - - * gnus-sum.el (gnus-update-marks): - (gnus-update-read-articles): - (gnus-summary-expire-articles): Check server. - -1999-03-16 Simon Josefsson - - * mml.el (mml-preview): New function. - -1999-04-17 17:10:21 William M. Perry - - * mail-source.el (mail-source-fetch-file): Return the right - value. - -1999-04-17 07:52:17 Lars Magne Ingebrigtsen - - * mml.el (mml-insert-parameter): New function. - (mml-insert-parameter-string): New function. - - * nnmail.el (nnmail-get-new-mail): Say how many new articles. - - * gnus-art.el (gnus-mime-multipart-functions): New variable. - (gnus-mime-display-part): Use it. - - * mm-decode.el (mm-alternative-precedence): Removed. - (mm-discouraged-alternatives): New variable. - (mm-preferred-alternative-precedence): New function. - - * nnmail.el (nnmail-get-new-mail): Use mail-sources. - - * mail-source.el (mail-sources): New variable. - - * gnus-art.el (article-remove-cr): Remove several trailing CRs. - - * mm-decode.el (mm-valid-image-format-p): New function. - (mm-inline-media-tests): Use it. - (mm-valid-and-fit-image-p): New function. - - * gnus-agent.el (gnus-agent-fetch-groups): Error when unplugged. - (gnus-agent-fetch-group): Ditto. - -1999-04-12 Didier Verna - - * nnmail.el (nnmail-article-group): in case of a group name - containing "\\n" constructs, be sure to pass the expanded value to - nn*-save-mail. - -Sat Apr 17 05:40:45 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.81 is released. - -1999-04-16 15:54:02 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-get-split-value): Reverse result. - -1999-04-03 00:17:24 Lars Magne Ingebrigtsen - - * gnus-start.el (gnus-always-read-dribble-file): Doc fix. - -1999-04-02 15:33:43 Lars Magne Ingebrigtsen - - * mml.el (mml-insert-tag): Insert concluding part. - - * message.el (message-send-mail): Encode later. - (message-send-news): Ditto. - - * nnfolder.el: Don't use mail delim. - -1999-03-28 19:14:27 Lars Magne Ingebrigtsen - - * gnus-cus.el (gnus-group-customize): Put point at min. - - * mm-view.el (mm-inline-text): Allow toggling html. - -1999-03-28 17:11:15 William M. Perry - - * mail-source.el: Added prescript and postscript to file. - -1999-03-28 13:46:00 Lars Magne Ingebrigtsen - - * nnmail.el: Reverted. - - * gnus-msg.el (gnus-setup-posting-charset): Didn't work. - (gnus-setup-posting-charset): Did work. - -1999-03-28 13:19:50 Jae-you Chung - - * gnus.el (gnus-short-group-name): Use - gnus-group-uncollapsed-levels. - -1999-03-28 13:11:43 Lars Magne Ingebrigtsen - - * gnus-cite.el (gnus-dissect-cited-text): Don't remove overlays. - -1999-03-26 13:18:45 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-treat-strip-headers-in-body): New variable. - (article-strip-headers-from-body): New command and keystroke. - -1999-03-14 16:09:10 Lars Magne Ingebrigtsen - - * mail-source.el (mail-source-fetch-pop): Check for symbol first. - - * nnheader.el (nnheader-insert-file-contents): Bind - enable-local-eval to nil. - (nnheader-find-file-noselect): Ditto. - - * nnmail.el (nnmail-article-group): Don't remove long lines. - (nnmail-remove-long-lines): New function. - (nnmail-split-header-length-limit): Removed. - - * mml.el (mml-generate-mime-1): Use unibyte buffers. - - * gnus-group.el (gnus-group-kill-all-zombies): Query user. - -1999-03-06 07:20:05 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-generic-mark): New function. - - * nnmail.el (nnmail-split-header-length-limit): Increased. - (nnmail-article-group): Allow nil. - - * gnus-cite.el (gnus-cite-parse-wrapper): Inhibit point-motion. - - * nndoc.el (nndoc-generate-mime-parts-head): Insert real headers - first. - - * mml.el (mml-minibuffer-read-type): Include types from - mailcap-mime-data. - - * nndraft.el (nndraft-request-article): Would clobber Japanese. - -1999-03-05 Hrvoje Niksic - - * mml.el (mml-insert-tag): New function. - (mml-read-file): Renamed to mml-minibuffer-read-file to avoid - confusion with functions like `mml-read-tag'. - (mml-read-type): Ditto with `mml-minibuffer-read-type'. - (mml-minibuffer-read-description): Ditto with - `mml-minibuffer-read-description'. - (mml-attach-buffer): New function. - (mml-mode-map): New entry for /. - (mml-minibuffer-read-type): Accept DEFAULT. - - * mml.el (mml-quote-region): Narrow the region. - - * message.el (message-mode-menu): message-mime-attach-file is now - mml-attach-file. - -1999-03-05 21:24:23 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-treatment-function-alist): Do emphasis earlier. - -1999-03-05 21:08:10 Robert Bihlmeyer - - * mml.el (mml-attach-buffer): New command. - -1999-02-27 Simon Josefsson - - * gnus-sum.el (gnus-update-marks): Call gnus-remove-from-range - with a proper range. Compress range. - - * gnus-range.el (gnus-remove-from-range): Protect arguments. - -1999-03-05 20:59:54 Lars Magne Ingebrigtsen - - * mm-decode.el (mm-get-image): Create a temporary file for xbms. - -1999-03-04 04:20:25 Lars Magne Ingebrigtsen - - * gnus-picon.el (gnus-picons-x-face-file-name): Removed. - (gnus-picons-convert-x-face): Removed. - (gnus-picons-article-display-x-face): Removed. - (gnus-picons-x-face-sentinel): Ditto. - (gnus-picons-display-x-face): Ditto. - -Thu Mar 4 01:38:00 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.80 is released. - -1999-03-02 16:04:30 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-mm-display-part): Narrow to the part itself. - - * gnus-sum.el (gnus-with-article): Moved here. - - * mail-source.el (mail-source-fetch-pop): Ask for password even - when program. - -1999-02-28 13:16:12 Lars Magne Ingebrigtsen - - * gnus-msg.el (gnus-bug): Add description. - - * mml.el (mml-insert-mml-markup): Insert disposition. - - * message.el (message-send-mail): Always encode mail headers. - - * smiley.el (gnus-smiley-display): Goto body. - -1999-02-28 13:15:47 Petr Konecny - - * smiley.el (gnus-smiley-display): Don't search to blank line. - -1999-02-28 00:38:40 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-treat-article): Only run the highlight stuff - when requested. - - * nnmail.el (nnmail-current-spool): Removed. - - * gnus-salt.el (gnus-tree-inhibit): New varible. - - * gnus.el (mm-util): Required. - -1999-02-27 23:44:52 paul stevenson - - * gnus-sum.el (gnus-summary-toggle-header): Narrow to head first. - -1999-02-27 17:17:47 Lars Magne Ingebrigtsen - - * mail-source.el (mail-source-bind): Doc fix. - -1999-02-26 20:35:57 Lars Magne Ingebrigtsen - - * message.el (message-mode): Doc fix. - - * mm-encode.el (mm-content-transfer-encoding-defaults): Use 8bit - encoding. - - * gnus.el (gnus-methods-equal-p): Moved here. - - * mail-source.el: pop at 110. - - * pop3.el (pop3-movemail): Use write-region instead of - append-to-file to avoid excessive messaging. - -1999-02-27 lantz moore - - * nnmail.el (nnmail-get-new-mail): honor suffix for spool-files of - type directory. - -1999-03-04 Robert Bihlmeyer - - * gnus-art.el (article-hide-boring-headers): Field names must not - contain whitespace. - -Fri Feb 26 18:54:16 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.79 is released. - -1999-02-26 18:11:04 Lars Magne Ingebrigtsen - - * gnus-cite.el (gnus-cite-toggle): Don't remove highlighting. - - * mml.el (mml-mode): Don't use add-minor-mode. - - * message.el (messgage-inhibit-body-encoding): New variable. - (message-encode-message-body): Use it. - -Fri Feb 26 17:00:25 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.78 is released. - -1999-02-26 07:45:30 Lars Magne Ingebrigtsen - - * message.el (message-mode): Switch on MML mode. - - * mml.el: Included commands and functions. - (mml-mode-map): New keymap. - - * message.el: Removed the insertion commands and functions. - - * gnus-ems.el (gnus-mule-cite-add-face): Removed. - - * gnus-sum.el (gnus-summary-sort-by-chars): New command and - keystroke. - - * gnus-art.el (gnus-narrow-to-page): Revert. - - * gnus-cite.el (gnus-cite-delete-overlays): New function. - (gnus-cite-parse-maybe): Always reparse. - - * message.el (message-encode-message-body): Don't insert - "multipart warning". - - * gnus-art.el (gnus-article-treat-head-custom): New variable. - -1999-02-25 Miles Bader - - * mail-source.el (mail-source-fetch-pop): Return 1 for success. - - * nnmail.el: Require mm-util. - -1999-02-26 07:39:33 Justin Sheehy - - * nnmail.el (nnmail-get-new-mail): Only get mail for the one - group. - -1999-02-26 07:38:08 SeokChan LEE - - * mm-bodies.el (mm-body-charset-encoding-alist): Add euc-kr. - -1999-02-21 Simon Josefsson - - * gnus-msg.el (gnus-extended-version): Better regexp. - -1999-02-25 Didier Verna - - * nnmail.el (nnmail-split-it): new syntax: `(! FUNC SPLIT)'. FUNC - is called with the result of SPLIT and should return a new split. - - * gnus.texi: update the doc. - -1999-02-23 Didier Verna - - * gnus-picon.el (gnus-picons-display-bar-p): when picons are - displayed in the article buffer, output bars if - `gnus-picons-display-article-move-p'. - -1999-02-20 Aaron M. Ucko - - * mail-source.el (mail-source-fetch-pop): Typo. - -1999-02-26 07:15:12 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-toggle-header): Save restriction. - -1999-02-23 03:07:58 Lars Magne Ingebrigtsen - - * gnus-cite.el (gnus-cite-parse-wrapper): Always parse. - -1999-02-21 11:11:39 Lars Magne Ingebrigtsen - - * mml.el (mml-insert-buffer): New function. - - * message.el (message-forward): Insert the buffer in the buffer. - -Sun Feb 21 01:20:50 1999 Shenghuo ZHU - - * mm-view.el (mm-inline-message): Insert part in narrowed region. - -Sat Feb 20 23:09:40 1999 Shenghuo ZHU - - * gnus-sum.el (gnus-summary-toggle-header): Save restriction. - -Sat Feb 20 21:34:28 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.77 is released. - -1999-02-20 17:32:17 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-displaying-mime): New variable. - (article-narrow-to-head): New function. - - * mail-source.el (mail-source-fetch-pop): Include pre/postscript. - Default to pop instead of pop3. - -1999-02-19 16:16:04 Lars Magne Ingebrigtsen - - * gnus-art.el (article-hide-pgp): Goto body. - - * gnus-uu.el (gnus-uu-digest-mail-forward): Don't kill buffer. - - * gnus-cite.el: Don't use goto-line. - - * gnus-art.el (gnus-article-treat-html): Removed. - (gnus-treat-article): Save restriction. - -1999-02-17 Per Abrahamsen - - * message.el (message-send-mail): Don't untabify. - (message-mode): Don't use tabs for indentation. - -1999-02-19 14:54:13 Lars Magne Ingebrigtsen - - * message.el (message-send-mail): Don't untabify. - - * nnml.el (nnml-save-mail): Typo fix. - -1999-02-19 Per Abrahamsen - - * message.el (message-cite-function): Add - `message-cite-original-without-signature' customization option. - -1999-02-18 Per Abrahamsen - - * nnmail.el (nnmail-fix-eudora-headers): Mark as option to - `nnmail-prepare-incoming-header-hook'. - -1999-02-19 14:41:43 Justin Sheehy - - * gnus-util.el (gnus-make-sort-function-1): Typo fix. - -1999-02-19 14:40:37 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-get-new-news): Require nnmail. - -1999-02-18 Michael Cook - - * Recognize Microsoft Outlook's cite attribution conventions. - -1999-02-19 14:33:11 James H. Cloos, Jr. - - * gnus-sum.el: Bind M. - -1999-02-19 14:31:29 Neil Crellin - - * mail-source.el (mail-source-fetch-pop): Bind pop3-port. - -1999-02-15 Didier Verna - - * gnus-picon.el (gnus-group-display-picons): ensures that - `article-goto-body' really goes to the article body. - -1999-02-19 12:57:19 Lars Magne Ingebrigtsen - - * mm-view.el (mm-inline-text): Bind url-standalone-mode. - - * gnus-msg.el (gnus-summary-mail-forward): Create unique names. - - * mm-view.el (mm-view-message): Enable multibyte. - -1999-02-11 18:37:15 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-get-new-mail): Message later. - - * mm-util.el (mm-find-charset-region): Revert to checking - multibyte. - -1999-02-11 Matt Pharr - - * gnus-msg.el (gnus-bug): Encode environment info as a MIME - attachment. - -Thu Feb 11 04:58:51 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.76 is released. - -1999-02-06 Felix Lee - - * gnus.el (gnus-group-change-level-function): Typo. - -1999-02-11 05:47:51 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-nov-skip-field): Removed. - (gnus-nov-field): Ditto. - (gnus-nov-parse-extra): Ditto. - (gnus-nov-read-integer): Ditto. - -1999-02-05 09:44:20 Katsumi Yamaoka - - * nnheader.el (nnheader-nov-read-message-id): New macro. - (nnheader-parse-nov): Use it. - - * gnus-sum.el (gnus-nov-read-message-id): New macro. - (gnus-nov-parse-line): Use it; use `(eobp)' instead of - `(eq (char-after) ?\n)'. - -1999-02-11 05:16:26 Lars Magne Ingebrigtsen - - * gnus.el (gnus-other-frame): Always pop up a new frame. - -Wed Feb 10 01:03:43 1999 Shenghuo ZHU - - * gnus-range.el (gnus-range-add): Rewrite. - -1999-02-02 18:12:00 Carsten Leonhardt - - * nnmail.el (nnmail-split-incoming): Added detection of maildir - format. - (nnmail-process-maildir-mail-format): New function. - - * mail-source.el (mail-source-fetch-maildir): New function. - (mail-source-keyword-map): Add default for maildir method. - (mail-source-fetcher-alist): Changed "qmail" to "maildir". - -1999-02-10 02:29:28 Lars Magne Ingebrigtsen - - * mail-source.el (mail-source-fetcher-alist): Remove apop. - - * nndoc.el (nndoc-type-alist): Remove MIME-digest. - (nndoc-mime-digest-type-p): Removed. - -1999-02-09 15:25:52 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-read-summary-keys): Set the point - where it is supposed to be. - (gnus-treat-play-sounds): New variable. - - * gnus-sum.el (gnus-newsgroup-ignored-charsets): New variable. - - * gnus-art.el (article-display-x-face): Narrow to head. - (gnus-article-washed-types): New variable. - (article-hide-pgp): Is not a toggle. - (gnus-article-hide-text-type): Save types. - (article-decode-charset): Use it. - - * nnmail.el (nnmail-get-new-mail): Ignore procmail. - - * message.el (message-forward-start-separator): Removed. - (message-forward-end-separator): Removed. - (message-signature-before-forwarded-message): Removed. - (message-included-forward-headers): Removed. - (message-check-news-body-syntax): Don't check forward. - (message-forward): Use MIME. - - * nnvirtual.el (nnvirtual-request-article): Bind - gnus-article-decode-hook to nil. - -1999-02-06 16:55:25 Lars Magne Ingebrigtsen - - * mml.el (mml-parse-singlepart-with-multiple-charsets): Check for - us-ascii. - -1999-02-04 00:00:35 Lars Magne Ingebrigtsen - - * format-spec.el (format-spec): Be more robust. - - * message.el (message-encode-message-body): Default - mail-parse-charset to mail-parse-charset. - - * gnus-sum.el (gnus-summary-edit-article-done): Don't encode. - (gnus-summary-edit-article): Bind mail-parse-charset. - - * mml.el (mml-read-tag): Ignore white space after end of tag. - - * message.el (message-goto-body): Also work in separatorless - articles. - - * mml.el (mml-translate-from-mime): New function. - (mml-insert-mime): Ditto. - (mml-to-mime): New function. - (mime-to-mml): New name. - - * gnus-sum.el (gnus-summary-edit-article): Always select raw - article. - - * gnus-group.el (gnus-group-catchup-current): Unmark groups. - - * gnus-sum.el (gnus-summary-setup-default-charset): Don't - special-case nndraft groups. - -1999-02-03 16:44:19 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-get-newsgroup-headers): Bind charset. - (gnus-get-newsgroup-headers): Already bound. - - * message.el (message-encode-message-body): Use posting charset. - - * mm-bodies.el (mm-encode-body): Use MIME charsets. - (mm-body-encoding): Do CTE. - (mm-body-7-or-8): New function. - - * mm-util.el (mm-mime-charset): Always fall back on alist. - (mm-mime-mule-charset-alist): Include katakana-jisx0201. - (mm-mime-mule-charset-alist): Add arabic-*-column. - (mm-find-mime-charset-region): New function. - - * format-spec.el (format-spec-make): New function. - - * mail-source.el (format-spec): Required. - (mail-source-fetch-with-program): Removed. - (mail-source-fetch-with-program): New function. - - * format-spec.el: New file. - -1999-02-03 16:00:41 Tatsuya Ichikawa - - * mail-source.el (mail-source-fetch-with-program): Take optional - parameter. - -1999-02-03 00:31:21 Lars Magne Ingebrigtsen - - * gnus-start.el: Ignore some groups. - (gnus-setup-news): Bind nnmail-fetched-sources. - - * message.el (message-send-mail): Remove all tabs. - - * mm-util.el (mm-find-charset-region): Just check whether - find-charset-region is defined. - -1999-02-02 23:35:20 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-get-new-news): Use - nnmail-fetched-sources. - - * nnmail.el (nnmail-fetched-sources): New variable. - (nnmail-get-new-mail): Use it. - - * mail-source.el (mail-source-fetched-sources): New variable. - (mail-source-fetch): Use it. - -1999-02-02 23:20:20 Mark W. Eichin - - * gnus.el (gnus-getenv-nntpserver): if the file that - gnus-nntpserver-file names has a trailing newline, the - string-match will always match, and thus the file will never be - read. (^ matches start of "line", \\` matches start of "buffer", - which is what was intended...) - -1999-02-02 23:17:40 Kim-Minh Kaplan - - * gnus-picon.el (gnus-picons-parse-filenames): Quote group names. - -1999-01-28 04:15:46 Katsumi Yamaoka - - * gnus-start.el (gnus-read-active-file): Eliminate duplicated - select methods. - -1999-01-27 Simon Josefsson - - * gnus-range.el (gnus-remove-from-range): Sort second argument. - -1999-02-02 10:55:23 Scott Hofmann - - * nntp.el: Use mail-source-read-passwd instead of nnmail-read-passwd. - -Mon Feb 1 23:23:03 1999 Shenghuo ZHU - - * gnus-cus.el (gnus-group-parameters): Charset as symbol, and fix - a typo. - * gnus-sum.el (gnus-summary-setup-default-charset): Set nndraft's - charset to nil. - * gnus-agent.el (gnus-agent-queue-setup): Remove charset setting. - * gnus-start.el (gnus-start-draft-setup): Ditto. - -1999-02-02 22:13:14 Lars Magne Ingebrigtsen - - * mail-source.el (mail-source-fetch-directory): Use the predicate. - (mail-source-value): Don't do variables. - - * nnmail.el (nnmail-get-new-mail): Set the predicate. - - * gnus-sum.el (gnus-summary-toggle-header): Fix, and bound to t. - -1999-02-01 Michael Cook - - * Defenestrate spurious ?a. - -1999-02-02 21:59:51 Lars Magne Ingebrigtsen - - * mail-source.el (mail-source-fetch-pop): Instead use - :authentication. - -1999-02-01 Tatsuya Ichikawa - - * lisp/mail-source.el : Support APOP authentication scheme. - -1999-02-02 21:56:14 Tatsuya Ichikawa - - * pop3.el (pop3-movemail): Return t. - -1999-02-02 21:48:46 Lars Magne Ingebrigtsen - - * rfc2047.el (rfc2047-fold-region): New function. - (rfc2047-encode-message-header): Use it. - -1999-02-02 21:07:27 Hallvard B. Furuseth - - * gnus-sum.el (gnus-group-charset-alist): Add more. - -Mon Feb 1 21:18:00 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.75 is released. - -1999-02-01 21:54:26 Lars Magne Ingebrigtsen - - * gnus-art.el (article-display-x-face): Don't narrow to head. - -1999-02-01 21:48:39 Michael Cook - - * gnus-cite.el (gnus-cited-lines-visible): Accept a cons. - -1999-02-01 20:59:38 Lars Magne Ingebrigtsen - - * mail-source.el (mail-source-fetch-directory): Ignore - directories. - - * gnus-cus.el (gnus-group-parameters): Addition. - - * gnus-art.el (article-strip-banner): Do symbolic banners. - (article-strip-banner): New keystroke. - -1999-02-01 20:54:32 Michael Cook - - * gnus-art.el (article-strip-banner): New command. - -1999-02-01 20:53:45 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-treat-strip-banners): New variable. - -1999-01-28 05:34:56 Katsumi Yamaoka - - * mail-source.el (mail-source-read-passwd): Use `read-passwd' if it - has been exist. - -Thu Jan 28 01:38:34 1999 Shenghuo ZHU - - * message.el (message-draft-coding-system): Check coding-system. - * mm-util.el (mm-text-coding-system): Ditto. - -1999-01-28 12:11:31 Katsumi Yamaoka - - * mail-source.el (mail-source-fetch-pop): Save excursion. - -1999-01-28 08:14:21 Lars Magne Ingebrigtsen - - * mail-source.el (mail-source-movemail-args): Not constant. - (mail-source-movemail-args): Removed. - (mail-source-fetch-with-program): New function. - (mail-source-fetch-pop): Use program and function. - (mail-source-movemail-program): Removed. - - * gnus-art.el (gnus-treat-date-iso8601): New variable. - (gnus-treat-date-user-defined): New variable. - -1999-01-28 08:07:12 Per Abrahamsen - - * nnmail.el (nnmail-fix-eudora-headers): New function. - -1999-01-28 08:05:19 Lars Magne Ingebrigtsen - - * mm-bodies.el (mm-encode-body): Use mail-parse-charset. - -1999-01-27 08:06:38 Lars Magne Ingebrigtsen - - * smiley.el (smiley-deformed-regexp-alist): Removed =>. - (smiley-nosey-regexp-alist): Ditto. - - * gnus-art.el (gnus-treatment-function-alist): Do - gnus-article-add-buttons-to-head later. - (gnus-treat-capitalize-sentences): New variable. - (article-capitalize-sentences): New command and keystroke. - - * gnus-group.el (gnus-group-catchup-current): Do group. - - * message.el (message-default-charset): Add group. - -Wed Jan 27 05:24:53 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.74 is released. - -1999-01-27 05:56:29 Lars Magne Ingebrigtsen - - * gnus-art.el (article-fill-long-lines): Renamed. - (article-fill-long-lines): New keystroke. - -1999-01-26 06:35:07 Lars Magne Ingebrigtsen - - * gnus-msg.el (gnus-setup-posting-charset): Check for group. - - * gnus-group.el (gnus-group-catchup-current): Skip groups now - displayed. - (gnus-group-catchup-current): Be more robus. - - * gnus-sum.el (gnus-summary-select-article): Reselect for showing - headers. - -1999-01-25 Dave Love - - * message.el (message-mode-menu): Add message-mime-attach-file. - (message-mode): Doc fix. - -1999-01-26 05:24:19 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-check-duplication): Insert the mail source - string. - - * mail-source.el (mail-source-fetch-pop): Bind mail-source-string. - (mail-source-fetch-directory): Ditto. - (mail-source-fetch-file): Ditto. - (mail-source-string): New variable. - - * gnus-start.el (gnus-get-unread-articles): Nix out groups over - the level. - - * rfc2047.el (rfc2047-encodable-p): Convert to MIME charsets - before handling. - - * mm-util.el (mm-mime-charset): Use the parameters. - (mm-mime-charset): Removed region paremeters. - - * nnmail.el (nnmail-get-new-mail): Don't message the entire - source. - -1999-01-25 12:05:16 Lloyd Zusman - - * nnmail.el (nnmail-get-split-group): Quote right. - -1999-01-25 05:55:41 Lars Magne Ingebrigtsen - - * mail-source.el (mail-source-movemail): Would kill an arbitrary - buffer. - -1999-01-24 03:02:31 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-clear-inboxes-moved): Removed. - (gnus-group-mode): Don't hook. - - * mail-source.el (mail-source-bind): Doc fix. - (mail-source-bind): Take only one param. - - * gnus-art.el (gnus-treat-highlight-signature): typep. - - * mail-source.el (mail-source-movemail): Ignore empty file. - (mail-source-callback): Check before deleting. - - * message.el (message-mime-attach-file): Include name. - -1999-01-23 17:01:12 Lars Magne Ingebrigtsen - - * mm-util.el (mm-read-charset): Return a symbol. - - * mm-view.el (mm-inline-text): Insert signature separator. - - * gnus-art.el (gnus-treat-predicate): New function. - (gnus-treat-article): Allow all types to be checked. - - * gnus-util.el (gnus-or): New function. - (gnus-and): Ditto. - - * gnus-art.el (gnus-mime-display-single): Use override. - - * mm-decode.el (mm-attachment-override-types): New variable. - (mm-attachment-override-p): New function. - - * gnus-picon.el (gnus-group-display-picons): Don't go backward. - -1999-01-23 16:45:06 Andrew J. Cosgriff - - * mm-view.el (mm-inline-text): Do vcards. - -Sat Jan 23 14:23:27 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.73 is released. - -1999-01-23 11:38:36 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-spool-file): Changed to use mail-source. - (nnmail-crash-box, nnmail-use-procmail, nnmail-procmail-directory, - nnmail-procmail-suffix, nnmail-resplit-incoming): Removed. - (nnmail-movemail-program): Removed. - (nnmail-movemail-args): Removed. - (nnmail-pop-password-required): Ditto. - (nnmail-tmp-directory): Ditto. - (nnmail-delete-incoming): Removed. - (nnmail-pop-password, nnmail-moved-inboxes, - nnmail-internal-password, nnmail-move-inbox): Removed. - (nnmail-read-passwd): Ditto. - (nnmail-get-spool-files): Removed. - (nnmail-resplit-incoming): Reinstated. - - * mail-source.el: New file. - -1999-01-23 09:08:31 James H. Cloos, Jr. - - * gnus-art.el (gnus-article-mode-map): Bind backspace. - -1999-01-23 09:05:04 Lars Magne Ingebrigtsen - - * gnus-art.el (article-make-date-line): Fix iso8601 display. - -1999-01-20 02:53:52 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-treat-display-smileys): Check xpm. - - * gnus-picon.el (gnus-group-display-picons): Goto body. - - * gnus.el: Indented all functions; broke long lines; changed all - instances of illegal/legal to invalid/valid. Yes, I'm bored. - -Wed Jan 20 00:50:53 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.72 is released. - -1999-01-20 01:39:48 Lars Magne Ingebrigtsen - - * gnus.el: Cleaned up trailing whitespace. - - * mm-util.el (mm-read-charset): Work. - -1999-01-17 Matt Armstrong - - * gnus-score.el (gnus-score-find-bnews): Match regexp on the - nnheader-translate-file-chars'd group name. - -1999-01-20 01:30:30 Lars Magne Ingebrigtsen - - * message.el (message-encode-message-body): Fold case. - -1999-01-20 01:28:16 Alexei V. Barantsev - - * gnus-xmas.el (gnus-xmas-modeline-glyph): Backquote. - -1999-01-20 00:46:15 Lars Magne Ingebrigtsen - - * mailcap.el (mailcap-add): New function. - -1999-01-18 09:40:37 Lars Magne Ingebrigtsen - - * gnus-art.el (article-goto-body-goes-to-point-min-p): New variable. - (article-goto-body): Use it. - (gnus-treat-article): Ditto. - - * gnus-agent.el (gnus-agent-get-undownloaded-list): Remove the - downloaded articles from the downloadeble list. - -1999-01-16 17:31:08 Lars Magne Ingebrigtsen - - * message.el (message-encode-message-body): Bind - mail-parse-charset. - - * mm-util.el (mm-charset-synonym-alist): New variable. - (mm-charset-to-coding-system): Use it. - (mm-charset-coding-system-alist): Removed. - (mm-charset-to-coding-system): Don't use it. - (mm-find-charset-region): Use mail-parse-charset. - - * gnus-art.el (gnus-treatment-function-alist): Use - gnus-article-display-picons. - (gnus-treat-display-xface): Only do if we have xface feature. - (gnus-part-display-hook): New function. - (gnus-treat-article): Use it. - (gnus-treat-article): Use gnus-visual. - - * gnus-msg.el (gnus-setup-posting-charset): Check elem. - - * gnus-art.el (gnus-mm-display-part): Fix the MIME button after - displaying. - - * mm-decode.el (mm-insert-part): Use insert-buffer-substring. - - * gnus-score.el (gnus-score-find-bnews): Protect against invalid - regexp file names. - -Sat Jan 16 03:15:57 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.71 is released. - -1999-01-16 00:13:31 Lars Magne Ingebrigtsen - - * mm-view.el (mm-inline-image): Don't add a dot. - - * gnus-art.el (gnus-treat-article): New function. - - * gnus.el (gnus-article-display-hook): Removed. - - * gnus-art.el (gnus-article-treat-custom): New variable. - - * gnus-start.el (gnus-ignored-newsgroups-has-to-p): Removed. - - * gnus-msg.el (gnus-setup-posting-charset): Allow variables and - functions. - - * message.el (message-posting-charset): New variable. - (message-send-mail): Use it. - - * gnus-msg.el (gnus-group-posting-charset-alist): Moved here. - (gnus-setup-posting-charset): New function. - (gnus-setup-message): Use it. - - * message.el (message-encode-message-body): Just look for - Content-Type before inserting a new one. - -1999-01-15 23:08:47 Lars Magne Ingebrigtsen - - * rfc2047.el (rfc2047-default-charset): Removed. - - * mail-prsvr.el: New file. - (mail-parse-charset): New variable. - - * gnus-sum.el (gnus-newsgroup-charset): Changed name. - Changed name. - - * gnus.el (gnus-charset): New group. - - * nnmail.el (nnmail-pathname-coding-system): Default to binary. - - * gnus-sum.el (gnus-default-charset): Default to nil. - (gnus-newsgroup-iso-8859-1-forced-regexp): Removed. - (gnus-newsgroup-iso-8859-1-forced): Removed. - - * mm-util.el (mm-known-charsets): Removed. - (mm-default-coding-system): Removed. - (mm-default-charset): Removed. - (mm-read-charset): New function. - - * message.el (message-default-charset): Removed. - - * rfc2047.el (rfc2047-default-charset): Default to nil. - - * mm-util.el (mm-charset-iso-8859-1-forced): Removed. - -Fri Jan 15 20:50:38 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.70 is released. - -1999-01-15 00:06:04 Lars Magne Ingebrigtsen - - * mm-decode.el (mm-save-part): Use mm-get-part. - (mm-insert-part): New function. - (mm-get-part): Use it. - (mm-get-image): Ditto. - (mm-display-external): Ditto. - - * mm-view.el (mm-inline-text): Ditto. - - * gnus-move.el (gnus-move-group-to-server): Protect against nil - ranges. - - * mm-decode.el (mm-display-external): Save the buffer. - (mm-remove-part): Kill it. - - * qp.el (quoted-printable-decode-region): Do the right thing at eobp. - - * nnagent.el (nnagent-request-set-mark): Defined stub. - -1999-01-14 23:05:31 Lars Magne Ingebrigtsen - - * gnus-score.el (gnus-score-load-score-alist): Bind - coding-system-for-read. - - * gnus-sum.el (gnus-summary-exit): Do adaptive scoring before - prepare-exit-hook. - - * mm-view.el (mm-setup-w3): Require w3. - -1999-01-13 Kiyokazu SUTO - - * lisp/nnspool.el (nnspool-retrieve-headers): Protect against empty - body. - -1999-01-14 21:17:35 Lars Magne Ingebrigtsen - - * mm-encode.el: Ditto. - - * mm-bodies.el (mm-decode-content-transfer-encoding): Message the - error. - - * mailcap.el (mailcap-mime-data): SAFER ps. - - * message.el (message-encode-message-body): Always insert a - Content-Type header. - - * mm-decode.el (mm-inline-media-tests): Default all text/* to be - shown inline. - - * mm-view.el (mm-inline-text): Handle all sorts of text. - - * mailcap.el (mailcap-mime-data): non-viewer for viewers that - don't view. - - * mm-decode.el (mm-display-external): Use it. - - * gnus-art.el (gnus-visible-headers): Added bcc, gcc, fcc. - - * mm-decode.el (mm-save-part): Removed double code. - -1999-01-12 Dave Love - - * mm-decode.el (mm-save-part): Avoid doubly-compressed - application/octet-stream .gz & al files with jka-compr. - -1999-01-12 Dave Love - - * gnus-ems.el (gnus-down-mouse-3): New variable. - * gnus-art.el (gnus-mime-button-map): Use it. - (gnus-mime-button-menu): Set the clicked-on buffer initially. - -1999-01-13 19:41:57 Lars Magne Ingebrigtsen - - * mailcap.el (mailcap-mime-data): Added ImageMagic and ee. - -1999-01-12 17:34:43 Lars Magne Ingebrigtsen - - * gnus-picon.el (gnus-picons-kill-buffer): Don't kill article - buffers. - - * gnus-sum.el (gnus-summary-exit): Destroy all MIME. - - * gnus-cache.el (gnus-cache-read-active): Reversed check. - -1999-01-12 17:18:25 Matt Armstrong - - * mml.el (mml-parameter-string): Strip directory component. - -1999-01-12 17:02:58 Lars Magne Ingebrigtsen - - * gnus.el (gnus-use-demon): Removed. - -1999-01-12 05:53:23 Katsumi Yamaoka - - * nnmail.el (nnmail-article-group): Don't infloop. - -1999-01-11 Colin Rafferty - - * gnus-art.el (article-update-date-lapsed): Made it work with - picons, and make it update on all visible frames. - (article-date-ut): Get summary-buffer's current-headers. - -1999-01-12 07:20:31 Lars Magne Ingebrigtsen - - * gnus-picon.el (gnus-picons-setup-buffer): Don't set major mode. - (gnus-picons-setup-p): New variable. - -1999-01-11 02:13:12 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-split-header-length-limit): Lowered to 512. - -1999-01-04 12:58:13 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-exit-no-update): Don't use run-hooks. - (gnus-summary-exit-no-update): Use mapcar. - -1999-01-02 14:36:32 Simon Josefsson - - * gnus-agent.el (gnus-category-write): Make directory. - -1998-09-26 19:39:31 Simon Josefsson - - * gnus-sum.el (gnus-update-read-articles): - (gnus-update-marks): Request backend update of mark. - -1999-01-03 15:29:52 Lars Magne Ingebrigtsen - - * mm-bodies.el (mm-body-encoding): Use mm-find. - -1999-01-03 15:28:27 Kim-Minh Kaplan - - * gnus-picon.el (gnus-article-display-picons): Fix. - -Sun Jan 3 13:32:02 1999 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.69 is released. - -1999-01-03 06:45:10 Lars Magne Ingebrigtsen - - * gnus-picon.el (gnus-picons-setup-buffer): Run the hook. - - * gnus-agent.el (gnus-agent-remove-group): New command and - keystroke. - - * rfc2047.el (rfc2047-decode-region): Check for us-ascii. - -1999-01-02 14:12:41 Simon Josefsson - - * gnus-agent.el (gnus-agent-write-servers): Make directory. - -1998-12-26 02:38:01 Lars Magne Ingebrigtsen - - * mm-view.el (mm-inline-text): Bind current id. - - * mm-decode.el (mm-handle-id): New macro. - (mm-make-handle): Accept id. - (mm-dissect-singlepart): Use it. - -1998-12-23 Matt Pharr - - * message.el (message-cite-original-without-signature): Use - message-signature-separator when searching for signature in - message-cite-original-without-signature. - -1998-12-24 16:25:38 Simon Josefsson - - * gnus.el (gnus-server-to-method): Check named methods. - -1998-12-24 03:27:02 Lars Magne Ingebrigtsen - - * mm-view.el (mm-view-message): Goto point-min. - - * nnmail.el (nnmail-article-group): Don't delete lines, only - shorten them. - - * gnus-msg.el (gnus-configure-posting-styles): Also do nil - values. - - * nnheader.el (nnheader-temp-directory): New variable. - (nnheader-temp-directory): Removed. - -1998-12-22 Jack Vinson - - * mailcap.el (mailcap-parse-mailcaps): Add "~/.mailcaps" to the - list of files to check for mailcap entries under windows-nt. - -1998-12-24 03:02:15 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-maybe-hide-headers): Check whether the - summary buffer exists. - -1998-12-22 Aaron M. Ucko - - * nnsoup.el (nnsoup-store-reply): Remove code to deal with - irrelevant Sun sendmail bug. - (nnsoup-store-reply): Stop mucking with mail-header-separator. - - * message.el (message-send-news): Bind mail-header-separator to - "" when asking backend to post. - -1998-12-22 Karl Kleinpaste - - * mm-uu.el (mm-dissect-disposition): New variable. - (mm-uu-dissect): Use it. - -1998-12-21 21:34:22 Lars Magne Ingebrigtsen - - * mm-view.el (mm-inline-text): Bind url-current-object. - -1998-12-06 03:05:41 Simon Josefsson - - * gnus-range.el (gnus-remove-from-range): Rewrite. - -1998-12-09 SL Baur - - * gnus-picon.el (annotations): Remove bogus require 'xpm. - -1998-12-18 Hrvoje Niksic - - * message.el (message-encode-message-body): Insert `MIME-Version' - instead of `Mime-Version'. - -1998-12-04 Hrvoje Niksic - - * message.el (message-insert-mime-part): Add the attachment - disposition. - (message-insert-mime-part): Make TYPE and DESCRIPTION optional. - (message-mime-query-type): New function. - (message-mime-query-description): Ditto. - (message-mime-query-file): Ditto. - (message-insert-mime-part): Use them. - (message-mime-insert-external): Use the new stuff. - -1998-12-19 23:02:26 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-split-header-length-limit): New variable. - - * mm-decode.el (mm-dissect-buffer): Check syntax. - - * rfc2231.el (rfc2231-parse-string): Remove check for syntax. - - * rfc2047.el (rfc2047-encodable-p): Use mm-find-charset-region. - (rfc2047-dissect-region): Ditto. - -1998-12-17 18:36:43 Lars Magne Ingebrigtsen - - * mm-view.el (mm-view-message): Decode charset. - -1998-12-16 16:01:22 Lars Magne Ingebrigtsen - - * rfc2231.el (rfc2231-parse-string): Ignore syntactically invalid - CT headers. - -Wed Dec 16 01:44:40 1998 Shenghuo ZHU - - * mm-bodies.el (mm-decode-content-transfer-encoding): Use - mm-uu-*-function. - * mm-uu.el (mm-uu-dissect): Use x-uuencode. - -1998-12-16 10:20:52 Lars Magne Ingebrigtsen - - * message.el (message-send-mail): Do MML first. - (message-send-news): Ditto. - -1998-12-15 20:57:18 Lars Magne Ingebrigtsen - - * gnus-picon.el (gnus-picons-face): New face. - (gnus-picons-try-face): Use it. - -Tue Dec 15 19:17:43 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.68 is released. - -Tue Dec 15 18:28:24 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.67 is released. - -Tue Dec 15 17:31:44 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.66 is released. - -1998-12-13 11:00:43 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-insert-mime-button): Decode description. - -Sat Dec 5 16:50:49 1998 Shenghuo ZHU - - * gnus-art.el (article-decode-encoded-words): Rollback to 0.55. - (gnus-decode-header-methods): Ditto. - (gnus-decode-with-mail-decode-encoded-word-region): Ditto. - -1998-12-13 10:04:39 Lloyd Zusman - - * gnus-xmas.el (gnus-xmas-summary-recenter): Allow numbers. - -1998-12-13 09:32:38 Lars Magne Ingebrigtsen - - * mml.el (mml-insert-mime-headers): Encode description. - - * nnfolder.el (nnfolder-request-expire-articles): Go to the date - line. - - * gnus-sum.el (gnus-default-charset): Doc fix. - -Wed Dec 9 15:18:39 1998 Shenghuo ZHU - - * mm-decode.el (mm-display-part): Forward a line. - -Wed Dec 9 13:30:29 1998 Shenghuo ZHU - - * mm-util.el (mm-running-ntemacs): New variable. - (mm-text-coding-system): Ditto. - * nnmail.el (nnmail-incoming-coding-system): Ditto. - (nnmail-split-incoming): Use nnmail-incoming-coding-system. - -1998-12-13 08:52:45 Lars Magne Ingebrigtsen - - * gnus-picon.el (gnus-picons-network-display-internal): Don't set - buffer. - - * message.el (message-insert-headers): New command and keystroke. - -1998-12-07 23:42:14 Lars Magne Ingebrigtsen - - * mm-decode.el (mm-inline-media-tests): Recognize x-xbitmap. - (mm-get-image): Ditto. - - * mm-bodies.el (mm-decode-content-transfer-encoding): Only for - base64, uudecode and binhex. - -Sun Dec 6 21:58:31 1998 Shenghuo ZHU - - * mm-bodies.el (mm-decode-content-transfer-encoding): Replace CRLF - in text/plain. - * mm-uu.el (mm-uu-dissect): Use inline. - -1998-12-07 23:19:14 Lars Magne Ingebrigtsen - - * mm-view.el (mm-view-message): New function. - - * mm-encode.el (mm-content-transfer-encoding-defaults): Changed to - qp. - -1998-12-07 Karl Kleinpaste - - * mm-encode.el (mm-content-transfer-encoding-defaults): Add an - entry for message/rfc822 as 8bit. - -1998-12-07 23:16:54 Lars Magne Ingebrigtsen - - * mailcap.el (mailcap-mime-extensions): Add patch. - -1998-12-05 Dale Hagglund - - * gnus-sum.el (gnus-summary-display-buttonized): Use prefix - argument to force all multipart/* to look like multipart/mixed. - - * gnus-art.el (gnus-mime-display-multipart-as-mixed): New - variable. - (gnus-mime-display-part): Use it. - -1998-12-07 22:46:37 Lars Magne Ingebrigtsen - - * gnus-draft.el (gnus-draft-send): Only disable checks for - non-interactive use. - (gnus-draft-send-message): Use it. - -Sun Dec 6 19:36:53 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.65 is released. - -1998-12-06 20:11:02 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-prepare-display): Don't init w3. - - * mm-view.el (mm-inline-text): Bind url-standalone-mode here. - -Sat Dec 5 18:35:42 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.64 is released. - -1998-12-05 18:51:13 Lars Magne Ingebrigtsen - - * mm-view.el (mm-setup-w3): Don't load. - - * gnus-msg.el (gnus-setup-message): Set group name. - (gnus-group-mail): Avoid leaking local vars. - - * message.el (message-attach-file): Renamed. - (message-mime-attach-file): Renamed again. - -1998-12-05 Hrvoje Niksic - - * gnus-art.el (article-decode-encoded-words): Bind - rfc2047-default-charset here. - - * gnus-art.el (gnus-insert-mime-button): Nix slashes in file name. - -1998-12-05 18:33:27 Lars Magne Ingebrigtsen - - * gnus-picon.el (gnus-picons-setup-buffer): Run picons hook. - (gnus-picons-setup-hook): New hook. - -1998-12-05 Per Abrahamsen - - * mailcap.el (mailcap-mime-data): Remove "*" from documentation - string. - (mailcap-mime-extensions): Ditto. Made first sentense fit a - line. - -1998-12-05 17:11:04 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-prepare-display): Setup w3. - (gnus-mime-view-part): Ditto. - (gnus-mime-inline-part): Dotii. - (gnus-mime-externalize-part): Daddo. - (gnus-mime-internalize-part): Tutti frutti. - (gnus-widget-press-button): Da da do. - - * mm-view.el (mm-setup-w3): Require url-vars. - -Fri Dec 4 12:13:12 1998 Shenghuo ZHU - - * message.el (message-draft-coding-system): Fix for XEmacs-NT. - * mm-util.el (mm-find-charset-region): Ditto. - -1998-12-05 16:30:01 Lars Magne Ingebrigtsen - - * message.el (message-send): Don't encode here. - (message-send-mail): But here. - (message-send-news): And here. - -1998-12-04 15:29:02 Lars Magne Ingebrigtsen - - * gnus-msg.el (gnus-message-insert-stylings): Don't insert twice. - -Fri Dec 4 04:09:15 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.63 is released. - -1998-12-04 04:59:20 Lars Magne Ingebrigtsen - - * mml.el (mml-base-boundary): Shorten. - - * message.el (message-insert-mime-part): Use default. - - * gnus-art.el (gnus-insert-mime-button): Bind gnus-tmp-type-long. - -1998-12-03 Per Abrahamsen - - * gnus-art.el (gnus-mime-display-alternative): Use (*) for radio - buttons, not [*]. - -1998-12-04 Hrvoje Niksic - - * gnus-art.el (gnus-insert-mime-button): Do proper help-echo. - -1998-12-04 04:48:37 Hrvoje Niksic - - * gnus-art.el (gnus-insert-mime-button): Fix. - -1998-12-03 Hrvoje Niksic - - * message.el (message-insert-mime-part): Nicify prompts. - (message-insert-mime-part): Really delete duplicates. - (message-insert-mime-part): Check against common errors. - (message-insert-mime-part): Fix docstring. - -1998-12-04 04:41:58 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-mime-internalize-part): Bugged out. - -1998-12-03 Hrvoje Niksic - - * gnus-art.el (gnus-mime-button-line-format): Nicify. - (gnus-insert-mime-button): Modify accordingly. - -1998-12-04 01:50:53 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-display-mime): Set window point. - - * mm-decode.el (mm-display-external): Only decode when not - saving. - (mm-alternative-precedence): Prefer multiparts. - (mm-inline-media-tests): Inline multiparts. - - * gnus-picon.el (gnus-picons-next-job-internal): Do bar if asked. - Ignore errors when requiring url. - - * mml.el (mml-quote-region): New command. - - * message.el (message-cite-original): Use it. - (message-cite-original-without-signature): Ditto. - -Thu Dec 3 12:53:58 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.62 is released. - -1998-12-03 13:38:36 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-mime-view-all-parts): Work with multiparts. - -1998-12-03 Hrvoje Niksic - - * mm-view.el (mm-inline-text): Use `point-min-marker' and - `point-max-marker'. - -1998-12-03 13:22:57 Lars Magne Ingebrigtsen - - * mailcap.el (mailcap-mime-extensions): Use image/xpm for xpms. - - * gnus-art.el (gnus-mime-display-single): Check for attachment - before other tests. - -1998-12-03 Didier Verna - - * gnus-msg.el (gnus-configure-posting-styles): find a - posting-style entry in the group parameters, if any, and honor it - at the end. - -1998-12-03 13:03:37 Felix Lee - - * nntp.el (nntp-after-change-function): Fix. - -1998-12-03 12:44:30 Mike McEwan - - * mml.el (mml-generate-mime-1): Insert literally. - -1998-12-03 00:23:17 Lars Magne Ingebrigtsen - - * mml.el (mml-insert-mime-headers): Removed debug. - -1998-12-02 22:22:03 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-show-article): Destroy parts when - prefixed. - - * mm-encode.el (mm-content-transfer-encoding-defaults): Default - application/emacs-lisp to 8bit. - -1998-12-03 Dale Hagglund - - * mm-decode.el (mm-quote-arg): Add quoting of '()', '<>', and '|'. - -Wed Dec 2 20:24:27 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.61 is released. - -1998-12-02 21:12:56 Lars Magne Ingebrigtsen - - * mml.el (mml-parse-1): Skipped parts. - (mml-insert-mime-headers): Nil is a list. - (mml-generate-mime-1): Don't insert literally. - (mml-read-tag): Drop text props. - (mml-read-part): Ditto. - (mml-parse-singlepart-with-multiple-charsets): Ditto. - -Wed Dec 2 20:07:16 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.60 is released. - -1998-12-02 20:11:28 Lars Magne Ingebrigtsen - - * mml.el (mml-parse-1): Don't throw contents away. - -1998-12-02 Hrvoje Niksic - - * mml.el (mml-compute-boundary-1): Regexp-quote the boundary. - -1998-12-02 18:42:24 Lars Magne Ingebrigtsen - - * mml.el (mml-parse-singlepart-with-multiple-charsets): New - function. - (mml-parse-1): Use it. - -Tue Dec 1 23:04:25 1998 Shenghuo ZHU - - * gnus-art.el (gnus-decode-with-mail-decode-encoded-word-region): - Use gnus-newsgroup-default-charset. - (article-decode-encoded-words): Remove charset codes. - * gnus-sum.el (gnus-newsgroup-default-charset): Use - gnus-default-charset. - -1998-12-02 03:14:20 Lars Magne Ingebrigtsen - - * message.el (message-send-mail): Don't encode here. - (message-send-news): Nor here. - (message-send): ... but here instead. - - * gnus-picon.el (gnus-picons-display-article-move-p): Changed - default to nil. - (gnus-article-display-picons): Replace From line. - (gnus-group-display-picons): Replace Newsgroups line. - (gnus-picons-display-glyph): Set baseline. - (gnus-group-display-picons): Piconize the entire Newsgroups line. - (gnus-picons-xbm-face): Revert to old, standard colors. - - * message.el (message-fetch-field): Remove text props. - - * gnus-art.el (gnus-article-normalized-header-length): New - variable. - (article-normalize-headers): New command and keystroke. - - * gnus-picon.el (gnus-picons-xbm-face): Changed colors. - -Wed Dec 2 01:43:48 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.59 is released. - -1998-12-02 01:38:31 Lars Magne Ingebrigtsen - - * mml.el (mml-insert-mime-headers): Beep at multiple charsets. - - * gnus-art.el (gnus-mime-copy-part): Set buffer-file-name. - -1998-11-30 Hrvoje Niksic - - * mml.el (mml-generate-mime-1): Handle unquoting end-tags. - -1998-12-02 00:15:30 Lars Magne Ingebrigtsen - - * mm-decode.el (mm-all-images-fit): New variable. - (mm-image-fit-p): Use it. - - * gnus-art.el (gnus-mime-display-single): Use it. - (gnus-mime-internalize-part): New command and keystroke. - - * mm-decode.el (mm-user-automatic-external-display): New - variable. - (mm-automatic-external-display-p): New function. - - * gnus-picon.el (gnus-picons-xbm-face): Default to sensible - colors. - -1998-12-01 23:52:05 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-repair-multipart): Reselect article. - - * gnus-art.el (gnus-with-article): Work in the original article - buffer. - (gnus-with-article): Work in read-only groups. - -Tue Dec 1 00:15:36 1998 Shenghuo ZHU - - * mm-bodies.el (mm-decode-string): Return original string if not - decode. - -Mon Nov 30 23:38:02 1998 Shenghuo ZHU - - * mm-uu.el (mm-uu-dissect): Use mm-make-handle. - -1998-12-01 01:53:49 Francois Pinard - - * nndoc.el (nndoc-mime-parts-type-p): Do related. - -Tue Dec 1 00:46:20 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.58 is released. - -1998-11-30 Hrvoje Niksic - - * mm-decode.el (mm-get-image): Return a glyph, not an image - specifier. - -1998-11-29 Hrvoje Niksic - - * rfc2047.el (rfc2047-decode): Bind mm-default-charset. - -1998-12-01 01:23:35 Lars Magne Ingebrigtsen - - * mail-parse.el (rfc2045): Required. - -1998-12-01 00:59:53 William M. Perry - - * mm-view.el (mm-inline-text): Remove props. - -1998-12-01 00:18:47 Lars Magne Ingebrigtsen - - * mm-view.el (mm-setup-w3): Protect url-misc. - - * message.el (message-ignored-resent-headers): Remove - Gnus-Warning. - - * mml.el (mml-insert-mime-headers): Use encoding. - (mml-parameter-string): Ditto. - - * rfc2045.el: New file. - (rfc2045-encode-string): New function. - -1998-11-30 23:11:22 Lars Magne Ingebrigtsen - - * mail-parse.el (mail-header-encode-parameter): New function. - - * rfc2231.el (rfc2231-encode-string): New function. - -Mon Nov 30 13:52:50 1998 Shenghuo ZHU - - * mm-bodies.el (mm-decode-string): New function. - * mm-view.el (mm-inline-text): Use mm-decode-string. - -Mon Nov 30 21:57:00 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.57 is released. - -1998-11-23 Felix Lee - - * nntp.el (nntp-async-needs-kluge): new setting. - (nntp-async-timer): new var. - (nntp-async-process-list): new var. - (nntp-async-kluge): new function. - (nntp-async-timer-handler): new function. - (nntp-async-wait): new function. - (nntp-async-stop): new function. - (nntp-after-change-function): renamed, and split apart. - (nntp-async-trigger): new function. - (nntp-do-callback): new function. - (nntp-accept-process-output): add optional timeout arg. - - * gnus-async.el (gnus-async-request-fetched-article): fixed. - (gnus-async-wait-for-article): new function. - (gnus-async-with-semaphore): s/asynch/async/. - -1998-11-30 16:54:56 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-with-article): Don't encode. - (gnus-insert-mime-button): Fall back on filename from C-D. - (gnus-mime-display-single): Have dots right on text/plain - attachments. - - * mm-decode.el (mm-dissect-buffer): Respect Content-Disposition in - broken parts. - - * gnus-art.el (gnus-with-article): Flush cache and backlog. - - * mm-bodies.el (mm-decode-content-transfer-encoding): Also do - binhex. - - * gnus-sum.el (gnus-summary-reparent-thread): Use new macro. - (gnus-summary-repair-multipart): New command and keystroke. - - * gnus-art.el (gnus-with-article-buffer): New macro. - -Sun Nov 29 23:51:57 1998 Shenghuo ZHU - - * gnus-art.el (gnus-mime-inline-part): Do not get part when - undisplay the part. - -1998-11-30 03:38:35 Lars Magne Ingebrigtsen - - * gnus-util.el (gnus-make-sort-function-1): Allow lambdas. - - * mml.el (mml-read-part): Partition right. - - * mm-decode.el (mm-handle-set-cache): New macro. - (mm-handle-cache): Ditto. - (mm-make-handle): Ditto. - (mm-dissect-singlepart): Use it. - (mm-get-image): Use the cache. - -1998-11-29 23:44:44 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-mime-display-mixed): Rewrite. - (gnus-mime-display-single): Don't insert lines between parts. - -Sun Nov 29 04:55:40 1998 Shenghuo ZHU - - * nnmail.el (nnmail-file-coding-system-1): New variable. - * nnfolder.el (nnfolder-file-coding-system): Ditto. - (nnfolder-read-folder): Use nnfolder-file-coding-system. - * nnml.el (nnml-file-coding-system): New variable. - (nnml-request-article): Use nnml-file-coding-system. - -Sun Nov 29 15:12:52 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.56 is released. - -1998-11-29 00:52:53 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-mime-display-part): New function. - (gnus-mime-display-mixed): Use it. - - * mm-view.el (mm-setup-w3): Don't register. - - * message.el (message-cite-original): Cite parts. - -1998-11-28 23:51:25 Lars Magne Ingebrigtsen - - * mml.el (mml-parameter-string): New function. - (mml-insert-mime-headers): Separated into new function. - -1998-11-28 Hrvoje Niksic - - * mml.el (mml-make-boundary): Use `make-string'. - -1998-11-27 Hrvoje Niksic - - * binhex.el (binhex-insert-char): Ditto. - - * base64.el (base64-insert-char): Ditto. - - * uudecode.el (uudecode-insert-char): Code correctly. - -1998-11-28 01:08:19 Lars Magne Ingebrigtsen - - * mml.el (mml-generate-mime): Don't generate multiparts for - empties. - - * gnus-art.el (gnus-display-mime): Save excursion. - - * message.el (message-remove-first-header): New function. - (message-encode-message-body): Use it. - -Fri Nov 27 12:26:10 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.55 is released. - -1998-11-27 12:38:52 Lars Magne Ingebrigtsen - - * mm-view.el (mm-setup-w3): New function. - - * mm-decode.el (mm-content-id-get-contents): New function. - (mm-content-id-get-type): Ditto. - (mm-content-id-get-encoding): Ditto. - (mm-get-handle-by-content-id): Removed. - -1998-11-25 Colin Rafferty - - * message.el (message-generate-new-buffers): Fix tag. - -1998-11-25 10:43:28 Lars Magne Ingebrigtsen - - * message.el (message-buffer-name): Check for unique first. - - * gnus-art.el (gnus-unbuttonized-mime-type-p): use - gnus-inhibit-mime-unbuttonizing. - - * gnus-sum.el (t): Bind M-t. - (gnus-inhibit-unbuttonizing): New variable. - (gnus-summary-toggle-display-buttonized): New command. - - * gnus-art.el (gnus-display-mime): Select article window. - (article-strip-trailing-space): New command and keystroke. - - * nneething.el (nneething-include-files): New variable. - (nneething-create-mapping): Use it. - - * nntp.el (nntp-possibly-change-group): Use nntp-send-command. - - * nnvirtual.el (nnvirtual-request-update-mark): Only yodate - ayto-expirable marks. - -1998-11-24 21:00:02 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-mime-view-all-parts): Set buffer. - - * gnus-sum.el (gnus-summary-display-buttonized): Don't pass on - ARG. - - * gnus-art.el (gnus-article-mode-line-format): Doc fix. - -Tue Nov 24 14:57:41 1998 Shenghuo ZHU - - * mm-util.el (mm-binary-coding-system): New variable. - (mm-with-unibyte-buffer): Use mm-binary-coding-system. - * mm-decode.el (mm-display-external): Ditto. - -Tue Nov 24 10:43:06 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.54 is released. - -1998-11-24 11:21:32 Katsumi Yamaoka - - * gnus-sum.el (gnus-newsgroup-default-charset-alist): Note fj. - -1998-11-24 11:14:54 Lars Magne Ingebrigtsen - - * mm-decode.el (mm-save-part): Unquote. - -1998-11-24 11:14:39 Matt Armstrong - - * mm-decode.el (mm-save-part): Bind coding system for write. - -1998-11-24 10:42:30 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-mode-line-format): New default. - (gnus-article-mime-part-status): New function. - - * message.el (message-send-news): Check the body syntax before - encoding. - - * gnus-art.el (gnus-unbuttonized-mime-type): New function. - (gnus-mime-display-single): Use it. - (gnus-mime-display-alternative): Ditto. - - * mm-decode.el: Check for whether we are running under a term. - -1998-11-22 08:12:25 Lars Magne Ingebrigtsen - - * mm-decode.el (mm-preferred-alternative): Default to first - alternative. - (mm-preferred-alternative): No, we dont. - -Tue Nov 24 03:01:48 1998 Shenghuo ZHU - - * mm-decode.el (mm-display-external): Use binary instead of - no-conversion. - * gnus-agent.el (gnus-agent-file-coding-system): Ditto. - * nnheader.el (nnheader-file-coding-system): Ditto. - * mm-util.el (mm-with-unibyte-buffer): Use binary instead of nil. - -Mon Nov 23 01:51:57 1998 Shenghuo ZHU - - * gnus-sum.el (gnus-newsgroup-setup-default-charset): Use group - name without method. - -Mon Nov 23 01:26:40 1998 Shenghuo ZHU - - * gnus-sum.el (gnus-newsgroup-default-charset): Rename - coding-system -> default-charset. - (gnus-newsgroup-default-charset-alist): Ditto. - (gnus-summary-local-variables): Ditto. - (gnus-set-global-variables): Ditto. - (gnus-get-newsgroup-headers): Ditto. - (gnus-summary-from-or-to-or-newsgroups): Ditto. - (gnus-get-newsgroup-headers-xover): Ditto. - (gnus-newsgroup-setup-default-charset): Ditto. - (article-decode-mime-words): Ditto. - (article-decode-charset): Ditto. - (article-decode-encoded-words): Ditto. - (article-de-quoted-unreadable): Ditto. - (gnus-mime-view-all-parts): Ditto. - (gnus-mime-externalize-part): Ditto. - (gnus-mm-display-part): Ditto. - (gnus-mime-display-single): Ditto. - (gnus-mime-display-alternative): Ditto. - * lpath.el : Ditto. - -Mon Nov 23 00:54:33 1998 Shenghuo ZHU - - * rfc2047.el (rfc2047-decode-region): Do not decode nil charset. - * gnus-art.el (article-decode-charset): Overlay - rfc2047-default-charset. - * message.el (message-draft-coding-system): New variable. - (message-set-auto-save-file-name): Use message-draft-coding-system. - * nndraft.el (nndraft-request-article): Ditto. - * gnus-start.el (gnus-start-draft-setup): Set charset nil. - * gnus-agent.el (gnus-agent-queue-setup): Ditto. - -Sun Nov 22 04:42:22 1998 Shenghuo ZHU - - * mm-uu.el (mm-uu-test): New function. - (mm-uu-dissect): Inherit charset and cte from head. - * gnus-art.el (article-decode-charset): Use mm-uu-test. - -Sat Nov 21 09:57:01 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.53 is released. - -1998-11-21 05:54:19 Lars Magne Ingebrigtsen - - * mm-decode.el (mm-get-image): New function. - (mm-image-fit-p): New function. - - * gnus-xmas.el (gnus-xmas-annotation-in-region-p): Ditto. - - * gnus-util.el (gnus-annotation-in-region-p): New definition. - - * gnus-art.el (gnus-article-insert-newline): New function. - (article-goto-body): New function. - -1998-11-20 10:34:04 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-mime-display-single): Insert blank line before - buttons. - - * gnus-sum.el (gnus-summary-display-buttonized): New command and - keystroke. - - * gnus-art.el (gnus-mime-display-single): Don't insert a blank - line between parts. - - * message.el (message-remove-header): Go to end if wanted. - -1998-11-20 Karl Kleinpaste - - * gnus-art.el (gnus-mime-display-alternative): Avoid window - movement with save-window-excursion. - -Fri Nov 20 03:50:30 1998 Shenghuo ZHU - - * gnus-art.el (gnus-mime-inline-part): Use argument as charset. - -Fri Nov 20 03:37:53 1998 Shenghuo ZHU - - * mm-bodies.el (mm-decode-body): Remove buffer-file-coding-system. - -Fri Nov 20 01:20:38 1998 Shenghuo ZHU - - * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Use - gnus-newsgroup-coding-system. - (gnus-get-newsgroup-headers): Ditto. - (gnus-get-newsgroup-headers-xover): Ditto. - (gnus-set-global-variables): Ditto. - * gnus-art.el (article-decode-mime-words): Ditto. - (article-decode-charset): Ditto. - (article-decode-encoded-words): Ditto. - (article-de-quoted-unreadable): Ditto. - (gnus-mime-view-all-parts): Ditto. - (gnus-mime-externalize-part): Ditto. - (gnus-mm-display-part): Ditto. - (gnus-mime-display-alternative): Ditto. - (gnus-mime-display-single): Ditto. - * mm-view.el (mm-inline-text): Use default coding system. - -Fri Nov 20 00:54:37 1998 Shenghuo ZHU - - * gnus-sum.el (gnus-newsgroup-coding-system-alist): New variable. - (gnus-newsgroup-iso-8859-1-forced-regexp): New variable. - (gnus-newsgroup-coding-system): New local variable. - (gnus-newsgroup-iso-8859-1-forced): New local variable. - (gnus-summary-local-variables): Add two new local variables. - (gnus-newsgroup-setup-coding-system): New function. - (gnus-select-newsgroup): Setup coding system. - * lpath.el: Add two new variables. - * mm-util.el (mm-charset-iso-8859-1-forced): New variable. - (mm-charset-to-coding-system): Use mm-charset-iso-8859-1-forced. - * gnus-cus.el (gnus-group-parameters): Customizable - iso-8859-1-forced. - -Fri Nov 20 05:30:26 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.52 is released. - -1998-11-20 04:32:23 Lars Magne Ingebrigtsen - - * rfc2047.el (rfc2047-encode-message-header): Encode the default - encoding. - - * gnus-art.el (gnus-mime-display-single): Insert buttons for - undisplayed text types. - - * mm-decode.el (mm-automatic-display-p): Only prefer inlinable - types. - -1998-11-19 Felix Lee - - * nntp.el (nntp-after-change-function-callback): recover from C-g. - -1998-11-19 Felix Lee - - * gnus-async.el (gnus-asynch-obarray): rename to - gnus-async-hashtb, and don't buffer-local it. - - (gnus-async-article-callback): new function. - (gnus-make-async-article-function): use it. - - (gnus-async-current-prefetch-group): new var. - (gnus-async-current-prefetch-article): new var. - (gnus-async-request-fetched-article): are we fetching it already? - - (gnus-async-delete-prefected-entry): s/prefected/prefetched/ - -1998-11-20 02:49:21 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-show-article): Require. - - * message.el: Provide before hooks. - (message-send-news): Do MIME before headers. - - * gnus-art.el (gnus-article-check-buffer): New function. - (gnus-article-read-summary-keys): Use it. - - * mm-decode.el (mm-user-automatic-display): Display all inline - images. - - * gnus-art.el (gnus-mime-display-single): Don't buttonize so - much. - (gnus-unbuttonized-mime-types): New variable. - -1998-11-19 06:29:03 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-inhibit-user-auto-expire): Changed to t. - - * mm-decode.el (mm-quote-arg): Quote semicolons. - - * gnus-art.el (gnus-mime-display-single): Don't display - attachments. - (gnus-mime-externalize-part): New command and keystroke. - - * mm-decode.el (mm-dissect-buffer): Pass on the description info. - (mm-alternative-precedence): Changed order. - -1998-11-07 17:41:47 Simon Josefsson - - * gnus.el (gnus-method-simplify): New function. - (gnus-native-method-p): New function. - (gnus-secondary-method-p): Use gnus-method-equal. - - * gnus-start.el (gnus-group-change-level): Shorten select method. - -Thu Nov 19 04:48:42 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.51 is released. - -1998-11-19 04:02:34 Lars Magne Ingebrigtsen - - * gnus.el: Applied patches from 5.6.45. - - * gnus-score.el (gnus-score-find-trace): Print complete file - paths. - (gnus-score-find-trace): Truncate lines. - - * gnus.el (gnus-message-archive-group): Allow function. - - * message.el (message-encode-message-body): Remove Mime-Version - before inserting. - - * gnus-cus.el (gnus-group-customize): Optional topic. - - * gnus-sum.el (gnus-summary-customize-parameters): New command and - keystroke. - -Wed Nov 18 13:46:08 1998 Shenghuo ZHU - - * message.el (message-encode-message-body): Rewrite. - -1998-11-18 07:37:47 Lars Magne Ingebrigtsen - - * mml.el (mml-base-boundary): New variable. - (mml-make-boundary): New function. - - * gnus-cache.el (gnus-cache-coding-system): New variable. - (gnus-cache-request-article): Use it. - - * message.el (message-insert-mime-part): Delete duplicates. - -Wed Nov 18 11:52:19 1998 Shenghuo ZHU - - * gnus-art.el (gnus-mime-display-alternative): Set end of - multipart and display even when nothing is preferred. - -Wed Nov 18 05:06:44 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.50 is released. - -1998-11-18 04:42:01 Lars Magne Ingebrigtsen - - * mm-decode.el (mm-inline-media-tests): Check that device-type is - fbound. - - * gnus-sum.el (gnus-summary-sort): Didn't do reverse. - -1998-11-07 23:39:48 Simon Josefsson - - * gnus.el (gnus-similar-server-opened): Compare backend. - -1998-11-08 03:37:42 Simon Josefsson - - * gnus-topic.el (gnus-topic-expire-articles): New function. - (gnus-topic-mode-map): Bind it. - - * gnus.texi (Topic Commands): New expiry command. Reordered. - -1998-11-10 Miles Bader - - * gnus-sum.el - (gnus-auto-expirable-marks): New variable. - (gnus-inhibit-user-auto-expire): New variable. - (gnus-summary-mark-article-as-read, gnus-summary-mark-article): - When looking to see if we should expire instead, check - gnus-auto-expirable-marks instead of using a hard-wired list. - (gnus-summary-mark-as-read-forward, - gnus-summary-mark-as-read-backward): - Pass gnus-inhibit-user-auto-expire for the no-expire argument to - gnus-summary-mark-forward, instead of `t'. - -1998-11-18 03:30:26 Lars Magne Ingebrigtsen - - * mml.el (mml-compute-boundary): New function. - (mml-compute-boundary-1): New function. - (mml-generate-mime-1): Use it. - -1998-11-18 Hrvoje Niksic - - * mml.el (mml-generate-mime-1): Always precede closing boundary - with newline. - -1998-11-18 02:36:37 Lars Magne Ingebrigtsen - - * mml.el (mml-generate-mime-1): Do right boundaries when several - multiparts. - - * mm-decode.el (mm-user-automatic-display): Default to inline - jpeg. - - * mml.el (mml-generate-mime-1): Encode non-text parts. - -Wed Nov 18 02:22:23 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.49 is released. - -1998-11-18 00:37:43 Lars Magne Ingebrigtsen - - * mm-view.el (mm-inline-text): Require w3-vars. - - * gnus-setup.el (gnus-use-tm): Removed. - - * gnus-art.el (gnus-article-goto-part): Don't beep. - (gnus-article-view-part): Check return value. - (gnus-mime-display-alternative): Don't display when there is - nothing to display. - - * mml.el (mml-generate-mime-1): Don't use a unibyte buffer. - (mml-generate-mime-1): Use unibyte for binaries. - - * gnus-art.el (gnus-display-mime): Call - gnus-article-mime-part-function. - (gnus-mime-part-function): New function. - (gnus-article-mime-part-function): New function. - - * mml.el (mml-generate-mime-1): Don't insert so many newlines. - -1998-11-16 06:44:19 Lars Magne Ingebrigtsen - - * mml.el (mml-generate-mime-1): Do it in unibyte buffers. - - * message.el (message-font-lock-keywords): Highlight MML. - (message-mml-face): New font. - -Mon Nov 16 23:34:12 1998 Shenghuo ZHU - - * gnus-art.el (gnus-display-mime): Clean up even when no handles. - (gnus-mm-display-part): Do not select-window if the article window - is not found. - -Mon Nov 16 02:26:40 1998 Shenghuo ZHU - - * gnus-sum.el (gnus-summary-move-article): Use no-encode for B m. - -Mon Nov 16 02:00:05 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.48 is released. - -1998-11-15 23:18:56 Lars Magne Ingebrigtsen - - * mm-bodies.el (mm-encode-body): Disbabled for nonmule. - - * mm-util.el (mm-find-charset-region): Bogus change for non-Mule. - - * message.el (message-cite-original-without-signature): Ditto. - (message-cite-original): Quote parts. - -Sun Nov 15 22:01:55 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.47 is released. - -1998-11-15 20:11:33 Lars Magne Ingebrigtsen - - * message.el (message-encode-message-body): Insert MIME warning. - - * mml.el (mml-read-tag): Look for #tag. - - * mm-util.el (mm-find-charset-region): Check whether - enable-multibyte-characters is bound. - -Sun Nov 15 02:01:31 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.46 is released. - -1998-11-15 01:54:40 Lars Magne Ingebrigtsen - - * message.el (message-encode-message-body): Insert headers at the - right spot. - -Sun Nov 15 01:13:41 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.45 is released. - -1998-11-15 00:28:49 Lars Magne Ingebrigtsen - - * nndraft.el (nndraft-save-mime-part): Removed. - (nndraft-get-mime-part): Ditto. - - * message.el (message-format-mime-old): Removed. - (message-encode-message-body): Removed. - (message-encode-message-body): Renamed. - -1998-11-14 18:27:19 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-get-newsgroup-headers): Translate \r's. - - * message.el (message-format-mime): Check message-mime-part. - - * mm-encode.el (mm-mime-file-types): Removed. - (mm-default-file-encoding): New definition. - -Sat Nov 14 01:29:39 1998 Shenghuo ZHU - - * mm-view.el (mm-inline-image): Use mm-insert-inline. - * gnus-art.el (gnus-mm-display-part): Go to correct position. - -Sat Nov 14 05:47:57 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.44 is released. - -1998-11-14 03:59:14 Lars Magne Ingebrigtsen - - * message.el (message-format-mime): New function. - - * nndraft.el (nndraft-save-mime-part): New function. - (nndraft-get-mime-part): New function. - - * mm-encode.el (mm-default-file-encoding): New function. - (mm-content-transfer-encoding): New function. - (mm-encode-buffer): New function. - - * message.el: New command. - (message-mime-part): New variable. - (message-insert-mime-part): New command. - - * mm-encode.el (mm-encode-content-transfer-encoding): New - function. - - * mm-util.el (mm-content-transfer-encoding-defaults): New - variable. - (mm-mime-file-types): Taken from TM. - -Sat Nov 14 01:51:06 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.43 is released. - -1998-11-07 Karl Kleinpaste - - * gnus-cus.el (gnus-score-customize): Add "Extra" element. - * gnus-score.el (gnus-score-default-header): Ditto. - (gnus-header-index): Ditto. - (gnus-summary-increase-score): Ditto, & process "extra" requests. - (gnus-summary-header): Handle extra headers. - (gnus-summary-score-entry): Ditto, & provide new score element. - (gnus-summary-score-effect): Ditto. - (gnus-score-string): Avoid "extra" string sort, & modify match in - "extra" case. - * gnus-sum.el (gnus-make-score-map): Add "extra" element. - -1998-11-13 20:30:40 Lars Magne Ingebrigtsen - - * message.el (message-resend): Bind message-required-mail-headers - to nil. - - * mm-view.el (mm-inline-text): Bind w3-strict-width. - - * nngateway.el (require): Require cl. - - * gnus-art.el (gnus-button-alist): Exclude more chars from news: - things. - -Wed Nov 11 02:15:06 1998 Shenghuo ZHU - - * gnus-agent.el (gnus-agent-fetch-headers): Create directory even - when no articles. - -1998-11-13 19:25:10 Lars Magne Ingebrigtsen - - * message.el (message-ignored-resent-headers): Remove X-Gnus. - -1998-11-10 Colin Rafferty - - * gnus-sum.el (gnus-ignored-from-addresses): Only quote - user-mail-address if non-nil. - -1998-11-13 18:50:18 Lars Magne Ingebrigtsen - - * gnus-util.el (gnus-make-sort-function): Do `reverse'. - (gnus-make-sort-function-1): Ditto. - - * gnus-art.el (gnus-mm-display-part): Switch to mm in right - window. - -1998-11-12 22:31:58 Lars Magne Ingebrigtsen - - * mm-util.el (mm-with-unibyte-buffer): Ditto. - - * binhex.el (binhex-decode-region): Quote. - -1998-11-10 05:32:28 Lars Magne Ingebrigtsen - - * gnus-art.el (article-decode-charset): Don't downcase charset. - - * gnus-sum.el (gnus-get-newsgroup-headers-xover): Translate CR's. - -Sun Nov 8 23:17:24 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.42 is released. - -Sun Nov 8 02:36:33 1998 Shenghuo ZHU - - * gnus-art.el (gnus-display-mime): Add id for alternative part. - -1998-11-08 02:24:47 Simon Josefsson - - * nntp.el (nntp-send-mode-reader): Revert. - -Sun Nov 8 00:45:13 1998 Shenghuo ZHU - - * gnus-agent.el (gnus-agent-fetch-articles): Use with-temp-buffer. - -Sat Nov 7 23:07:24 1998 Shenghuo ZHU - - * message.el (message-make-date): Fix for negative time zones. - -Sun Nov 8 01:00:16 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.41 is released. - -1998-11-08 00:52:38 Hrvoje Niksic - - * mm-decode.el (mm-dissect-multipart): Quote regexp. - -1998-10-29 Sudish Joseph - - * gnus.el (gnus-short-group-name): When shortening foreign select - methods, do not scan for plusses beyond the first colon. - -1998-11-07 Mike McEwan - - * gnus-agent.el (gnus-agent-save-group-info): Cater for group info - lines where `group' is the last thing on the line. - -1998-11-08 00:35:09 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-view-part): Do alternative. - (gnus-mime-display-alternative): Insert marker. - -1998-11-07 14:33:46 Lars Magne Ingebrigtsen - - * mm-decode.el (mm-dissect-multipart): Quote regexp. - - * nnmail.el (nnmail-expired-article-p): Protect against bogus - dates. - - * gnus-cus.el (gnus-topic): Required. - - * nnheader.el (nnheader-parse-nov): Parse extra. - (nnheader-nov-parse-extra): New macro. - -1998-10-31 12:33:22 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-view-part): Internal move. - -1998-10-28 Per Abrahamsen - - * gnus-cus-new.el (gnus-custom-topic): New free variable. - (gnus-group-customize): Support editing topic parameters. - -1998-10-29 12:09:20 Karl Kleinpaste - - * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Add - indicators. - -1998-10-29 11:31:11 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-mm-display-part): Return. - (gnus-article-view-part): Only go if external. - (gnus-article-dumbquotes-map): Do 205. - - * mm-decode.el (mm-display-part): Return what was done. - - * message.el (message-buffer-naming-style): New variable. - (message-generate-new-buffers): Extended. - (message-buffer-naming-style): Removed. - (message-buffer-name): Use it. - (message-do-send-housekeeping): Rename new styling. - - * gnus-sum.el (gnus-summary-recenter): Allow - gnus-auto-center-summary to be a number. - -Wed Nov 4 02:24:39 1998 Shenghuo ZHU - - * pop3.el (pop3-open-server): Use "binary" instead of - "no-conversion". - -Sun Nov 1 01:26:42 1998 Shenghuo ZHU - - * gnus-srvr.el (gnus-browse-foreign-server): Set - gnus-browse-current-method to the result of gnus-server-to-method. - -Thu Oct 29 01:47:44 1998 Shenghuo ZHU - - * gnus-util.el (gnus-pull): Another optional argument. - * nnweb.el (nnweb-request-delete-group): Delete from - nnweb-group-alist and update active file. - -Thu Oct 29 01:05:08 1998 Shenghuo ZHU - - * gnus-group.el (gnus-group-make-group): Accept group of new - method. - -Wed Oct 28 02:19:16 1998 Shenghuo ZHU - - * gnus-agent.el (gnus-agent-fetch-group-1): Update dribble. - -Tue Oct 27 11:59:31 1998 Shenghuo ZHU - - * mm-view.el (mm-inline-text): Postion of html portion. - -1998-10-29 10:26:54 Lars Magne Ingebrigtsen - - * nntp.el (nntp-list-active-group): Waited for short strings. - (nntp-send-mode-reader): Ditto. - (nntp-open-connection): Ditto. - - * gnus-int.el (gnus-request-group-articles): New function. - - * nntp.el (nntp-request-listgroup): New function. - (nntp-request-group-articles): Renamed. - -1998-10-27 10:37:52 Karl Kleinpaste - - * nnheader.el (nnheader-parse-nov): Supply extra. - -1998-10-26 23:03:48 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-button-push): Don't go to - gnus-article-buffer. - - * mm-view.el (mm-inline-image): Add a newline. - - * gnus-start.el (gnus-check-first-time-used): Check more. - -1998-10-26 23:03:29 Francois Felix Ingrand - - * gnus-start.el (gnus-check-first-time-used): Check current. - -1998-10-26 22:07:52 Lars Magne Ingebrigtsen - - * mm-util.el (mm-find-charset-region): New function. - - * ietf-drums.el (ietf-drums-narrow-to-header): Work when no header. - - * gnus-art.el (gnus-mime-button-menu): Fix. - -1998-10-26 22:07:43 Michael Welsh Duggan - - * gnus-art.el (gnus-mime-button-menu): New definition. - -1998-10-26 01:46:11 Lars Magne Ingebrigtsen - - * gnus-art.el (article-decode-charset): Downcase charset. - (article-decode-charset): Pass on type. - (article-decode-charset): Check nil charsets. - (article-remove-cr): Translate CR to LF. - (gnus-ignored-mime-types): Default to nil. - - * nnheader.el (nnheader-insert-nov): Work when not Xref. - - * gnus-sum.el (gnus-ignored-from-addresses): Default to - user-mail-address. - (gnus-nov-parse-extra): Didn't return right thing. - -1998-10-25 23:25:27 Lars Magne Ingebrigtsen - - * gnus-xmas.el: Use compiled-function-p. - -Mon Oct 26 14:37:19 1998 Shenghuo ZHU - - * mm-decode.el (mm-copy-Yo-buffer): Make it works when no header. - -Sun Oct 25 23:11:44 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.40 is released. - -1998-10-25 21:41:05 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-mark-forward): Show thread. - - * gnus-start.el (gnus-check-first-time-used): Ignore dribble. - - * gnus-agent.el (gnus-agent-fetch-group-1): Bind name. - - * nnml.el (nnml-possibly-create-directory): Check before making. - -1998-10-25 19:43:08 Kai Grossjohann - - * nnheader.el (nnheader-insert-nov): Don't infloop. - -1998-10-25 19:26:11 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-set-mode-line): Check that the spec has been - set up. - -1998-10-25 19:22:03 Joerg Lenneis - - * nneething.el (nneething-file-name): New definition. - -1998-10-25 17:56:23 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-treatment-function-alist): Fix. - (gnus-summary-save-in-rmail): Use gnus-output-to-rmail. - - * nndoc.el (nndoc-dissect-mime-parts-sub): Recognize first part. - -Sun Oct 25 06:23:13 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.39 is released. - -1998-10-25 00:34:39 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-ignored-mime-types): New variable. - (gnus-mime-display-single): Use it. - (gnus-treatment-function-alist): New variable. - - * gnus.el (gnus-mime): New group. - - * gnus-art.el (gnus-mime-display-alternative): Don't destroy - things for other parts. - (gnus-mime-display-alternative): Place point. - - * gnus.el: autoload gnus-uu-post-news. - - * mailcap.el (mailcap-mailcap-entry-passes-test): Also check - needsterm/DISPLAY. - - * mm-decode.el (mm-display-part): Default to inline text/.* - parts. - - * mm-bodies.el (mm-decode-content-transfer-encoding): Default to - 8bit. - - * gnus-art.el (gnus-mime-copy-part): Use normal-mode. - (gnus-mime-display-single): Inline all text parts. - (gnus-article-narrow-to-signature): Removed mime:: stubs. - -1998-10-24 21:38:37 Lars Magne Ingebrigtsen - - * nnml.el (nnml-possibly-create-directory): Rewrite. - (nnml-request-create-group): Change to right server. - - * gnus-xmas.el (gnus-xmas-define): Use byte-code-function-p. - - * gnus-sum.el (gnus-set-mode-line): Use truncate-string-to-width. - - * gnus.el: rmail-output-to-rmail-file autoload. - - * gnus-util.el (gnus-output-to-rmail): Didn't work if not in - Gnus. - - * nnheader.el (nnheader-parse-head): Checked wrong variable. - - * gnus-sum.el (gnus-summary-update-mark): Ignore nil'd marks. - -Tue Oct 20 23:37:43 1998 Shenghuo ZHU - - * gnus-art.el (gnus-mime-display-mixed): Multipart in - mixed part. - -Tue Oct 20 23:36:43 1998 Shenghuo ZHU - - * gnus-sum.el (gnus-summary-exit): Use mm-destroy-parts. - - * gnus-sum.el (gnus-summary-exit-no-update): Ditto. - -Tue Oct 20 16:22:51 1998 Shenghuo ZHU - - * mm-uu.el (mm-uu-dissect): Create pseudo multipart head. - -1998-10-24 20:51:53 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-valid-move-group-p): Make sure group has a - value. - - * gnus-art.el (gnus-article-hidden-text-p): Return nil when not - hidden. - - * gnus-spec.el (gnus-update-format-specifications): Use the - article mode line spec. - - * gnus-art.el (gnus-insert-mime-button): Put right type. - (gnus-insert-prev-page-button): Ditto. - (gnus-insert-next-page-button): Dutti. - - * pop3.el: New version installed. - -Sat Oct 24 16:48:51 1998 Shenghuo ZHU - - * mm-uu.el (mm-uu-dissect): Delete the begining spurious newline - and display last part. - -Sat Oct 24 20:31:55 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.38 is released. - -1998-10-24 07:54:58 Lars Magne Ingebrigtsen - - * gnus-art.el (article-mime-decode-quoted-printable-buffer): - Removed. - (article-de-quoted-unreadable): Narrow to default. - - * qp.el (quoted-printable-encode-region): Encode before QP-ing. - - * gnus-art.el (article-decode-charset): Decode even when broken - MIME. - - * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Return - name. - - * gnus-msg.el (gnus-copy-article-buffer): Delete headers. - - * gnus-cache.el (gnus-cache-possibly-enter-article): Use - nnheader. - - * nnmail.el (nnmail-extra-headers): New variable. - - * nnheader.el (nnheader-insert-nov): Insert extra. - - * gnus.el (gnus-summary-line-format): Doc fix. - - * gnus-sum.el (gnus-get-newsgroup-headers): Parse extra. - (gnus-nov-parse-line): Ditto. - (gnus-nov-parse-extra): New macro. - (gnus-header): New function. - (gnus-update-summary-mark-positions): Change. - (gnus-ignored-from-addresses): New variable. - (gnus-summary-insert-from-or-to): New function. - - * gnus.el (gnus-extra-headers): New variable. - - * nnheader.el (make-mail-header): Expand. - (mail-header-extra): New macro. - (mail-header-set-extra): Ditto. - (make-full-mail-header): Expand. - -Sat Oct 24 07:41:42 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.37 is released. - -1998-10-24 07:29:11 Lars Magne Ingebrigtsen - - * mm-bodies.el (mm-decode-body): Check for multibyticity. - - * mm-util.el (mm-enable-multibyte): Don't always switch multibyte - on. - -1998-10-22 Didier Verna - - * gnus-spec.el (gnus-balloon-face-function): new function - (gnus-parse-format): understand the %< %> specifiers - (gnus-parse-complex-format): ditto. - -1998-10-24 06:31:33 Lars Magne Ingebrigtsen - - * gnus.el: Changed following-char to char-after throughout. - -1998-10-22 04:05:55 Lars Magne Ingebrigtsen - - * mm-decode.el (mm-display-external): Protect more and message. - -Wed Oct 21 03:26:30 1998 Shenghuo ZHU - - * gnus-xmas.el (gnus-xmas-article-push-button): Go to the - position. - -Tue Oct 20 23:37:43 1998 Shenghuo ZHU - - * gnus-art.el (gnus-mime-display-mixed): Multipart in - mixed part. - -Tue Oct 20 23:36:43 1998 Shenghuo ZHU - - * gnus-sum.el (gnus-summary-exit): Use mm-destroy-parts. - - * gnus-sum.el (gnus-summary-exit-no-update): Ditto. - -Tue Oct 20 16:22:51 1998 Shenghuo ZHU - - * mm-uu.el (mm-uu-dissect): Create pseudo multipart head. - -1998-10-21 Hrvoje Niksic - - * mailcap.el (mailcap-save-binary-file): Use unwind-protect. - - * mm-decode.el (mm-display-external): Set undisplayer to mm - buffer, not the current buffer; use unwind-protect. - -1998-10-21 00:07:59 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-exit): Destroy parts. - (gnus-summary-exit-no-update): Ditto. - -1998-10-20 22:02:05 Lars Magne Ingebrigtsen - - * mm-decode.el (mm-inline-media-tests): Look for w3. - - * mailcap.el (mailcap-mime-data): Inline html. - -Tue Oct 20 20:25:03 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.36 is released. - -1998-10-20 18:13:08 Lars Magne Ingebrigtsen - - * gnus-art.el (article-translate-strings): - (gnus-article-dumbquotes-map): Don't dot. - - * pop3.el (pop3-open-server): Set point right. - - * mm-decode.el (mm-dissect-multipart): Dissect hierarchically. - (mm-dissect-buffer): Ditto. - (mm-destroy-part): Ignore non-handles. - (mm-remove-part): Ditto. - (mm-destroy-parts): New function. - (mm-remove-parts): Ditto. - - * gnus-art.el (gnus-mm-display-part): Don't move point. - -Tue Oct 20 02:16:36 1998 Shenghuo ZHU - - * mm-uu.el : New file. - - * gnus-art.el (gnus-display-mime): Dissect uu stuffs. - - * mm-bodies.el (mm-decode-content-transfer-encoding): Encoding as - a function. - -1998-10-20 00:35:05 Lars Magne Ingebrigtsen - - * mm-decode.el (mm-display-external): Check before selecting. - -Sat Sep 26 02:03:00 1998 Shenghuo ZHU - - * gnus-sum.el (gnus-multi-decode-encoded-word-string): Rewrite. - - * gnus-sum.el (gnus-decode-encoded-word-methods): New variable. - - * gnus-sum.el (gnus-decode-encoded-word-methods-cache): New - variable. - - * gnus-sum.el (gnus-encoded-word-method-alist): Deleted. - - * gnus-art.el (gnus-decode-header-methods): New variable. - - * gnus-art.el (gnus-decode-header-methods-cache): New variable. - - * gnus-art.el (gnus-multi-decode-header): New function. - -Tue Oct 20 00:24:16 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.35 is released. - -1998-10-20 00:00:36 Lars Magne Ingebrigtsen - - * uudecode.el (uudecode-decode-region-external): Insert - literally. - - * gnus-xmas.el (gnus-xmas-mime-button-menu): Moved here. - - * mm-bodies.el (mm-decode-body): Optional encoding. - -1998-10-19 23:57:57 Lars Magne Ingebrigtsen - - * gnus-ems.el (gnus-mouse-3): New variable. - - * binhex.el (binhex-decode-region-external): Don't use -internally. - -1998-10-16 14:54:02 Simon Josefsson - - * mailcap.el (mailcap-parse-mailcaps): Only open regular - files. - -1998-09-26 22:28:01 Simon Josefsson - - * gnus-group.el (gnus-add-marked-articles): Request backend update - of flags. - -1998-09-26 19:39:31 Simon Josefsson - - * gnus-sum.el (gnus-update-read-articles): - (gnus-update-marks): Request backend update of mark. - -1998-09-26 19:33:58 Simon Josefsson - - * gnus.texi (Optional Backend Functions): New item, - nnchoke-request-set-mark. - -1998-09-26 16:27:27 Simon Josefsson - - * gnus-range.el (gnus-remove-from-range): Don't add stuff in - list to range. - -1998-10-19 23:45:13 Simon Josefsson - - * gnus-sum.el (gnus-summary-exit-no-update): Don't expire. - -1998-10-14 SL Baur - - * gnus-sum.el: Move gnus-save-hidden-threads above where it is - first used. - -1998-10-10 SL Baur - - * mm-view.el: Require mm-decode for macros. - - * mm-decode.el (mm-handle-type): Move macro declarations above the - place where they are used. - -Sun Oct 18 13:59:07 1998 Kurt Swanson - - * gnus-msg.el (gnus-summary-mail-forward): Erase old forward - buffer. - -1998-10-19 23:38:11 Katsumi Yamaoka - - * nnagent.el (nnagent-open-server): Error message. - -1998-10-19 23:35:08 Joerg Lenneis - - * nnheader.el (nnheader-article-p): Recognize lower-case headers. - -1998-10-19 Hrvoje Niksic - - * score-mode.el (gnus-score-mode-map): Ditto. - - * message.el (message-mode-map): Ditto. - - * gnus-uu.el (gnus-uu-post-news): Ditto. - - * gnus-kill.el (gnus-kill-file-mode-map): Ditto. - - * gnus-eform.el (gnus-edit-form-mode-map): Ditto. - - * gnus-art.el (gnus-article-edit-mode-map): Use - `set-keymap-parent' rather than `copy-keymap'. - -1998-10-18 Hrvoje Niksic - - * gnus-art.el (gnus-mime-button-commands): New variable. - (gnus-mime-button-map): Initialize it from - `gnus-mime-button-commands'. - (gnus-mime-button-menu): New function. - (gnus-insert-mime-button): Use `gnus-mime-button-map'. - -1998-10-11 Hrvoje Niksic - - * message.el (message-insert-to): Make `nobody' and `poster' - synonymous to `never' and `always' in Mail-Copies-To. - (message-reply): Ditto. - (message-followup): Ditto. - -1998-10-19 23:17:41 Lars Magne Ingebrigtsen - - * mailcap.el (mailcap-mime-data): Save sound. - -1998-09-24 Hrvoje Niksic - - * message.el (message-ignored-supersedes-headers): Include - `NNTP-Posting-Date'. - -1998-10-19 01:25:27 Jonas Steverud - - * gnus-art.el (gnus-article-dumbquotes-table): New variable. - -1998-10-19 00:50:22 Lars Magne Ingebrigtsen - - * mm-bodies.el (mm-decode-content-transfer-encoding): Use - uudecode. - -1998-10-18 18:20:34 Lars Magne Ingebrigtsen - - * mm-decode.el (mm-display-external): Don't switch on save. - -1998-10-18 18:14:06 Andy Piper - - * nnmail.el (nnmail-movemail-args): New variable. - -1998-10-18 00:17:02 Lars Magne Ingebrigtsen - - * gnus-art.el (article-translate-strings): - -1998-10-17 22:51:31 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-view-part): Use it. - (gnus-mm-display-part): New function. - (article-de-quoted-unreadable): Yse mm-default-coding-system. - - * mm-decode.el (mm-handle-displayed-p): New function. - - * gnus-art.el (gnus-mime-copy-part): Create better names. - (gnus-mime-button-line-format): Include dots spec. - -1998-10-15 Matt Pharr - - * gnus-msg.el (gnus-summary-mail-forward): Erase contents of old - forward buffer first. - -1998-10-17 21:16:46 Lars Magne Ingebrigtsen - - * gnus-util.el (gnus-set-window-start): New function. - - * message.el (message-send): Don't check changed. - -1998-10-12 15:26:41 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-setup-buffer): Set params. - - * mm-decode.el (mm-user-display-methods): Inline - "message/delivery-status". - -1998-10-11 07:06:38 Lars Magne Ingebrigtsen - - * message.el (message-auto-save-directory): Rename. - (message-mode): Dof fix. - - * gnus-art.el (gnus-summary-save-in-pipe): Default to "cat". - (gnus-summary-save-in-pipe): No, check gnus-last-shell-command. - - * nndoc.el (nndoc-mime-parts-type-p): Be a bit more forgiving. - - * message.el (message-make-date): Avoid locale. - - * gnus-art.el (gnus-article-edit-done): Allow update before doing - cache. - - * mm-decode.el (mm-display-inline): Goto point-min. - - * gnus-art.el (gnus-article-prepare-display): Not read-only. - - * mm-decode.el (mm-display-external): Reverse before sorting. - - * gnus-draft.el (gnus-draft-send): Allow mail. - -1998-10-10 SL Baur - - * message.el (message-check): Move message-check macro above where - it is first used. - - * gnus-art.el (article-hide-pgp): Hide the PGP 5/GNUPG Hash: line. - -1998-10-11 06:45:37 Lloyd Zusman - - * gnus-sum.el (gnus-summary-make-menu-bar): Fix. - -Sun Oct 11 02:28:40 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.34 is released. - -1998-10-11 02:15:41 Lars Magne Ingebrigtsen - - * mm-decode.el (mm-inline-media-tests): delivery-status. - - * mm-view.el (mm-inline-text): Provide default. - -1998-10-11 01:01:37 Lloyd Zusman - - * mailcap.el (mailcap-possible-viewers): Fix nils. - -1998-10-11 00:03:37 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-edit-exit): Don't do updates. - (article-update-date-lapsed): Record the buffer. - (article-update-date-lapsed): Do all windows that display article - buffers. - - * nnml.el (nnml-generate-nov-databases-1): Ditto. - - * gnus-score.el (gnus-score-score-files-1): Ignore dotted files. - - * gnus-art.el (gnus-insert-mime-button): Mark buttons as - annoations. - - * gnus-msg.el (gnus-summary-mail-forward): Decode properly. - -1998-10-10 22:07:03 Lars Magne Ingebrigtsen - - * gnus-agent.el (gnus-category-add): Change default category to - 'false. - - * nnvirtual.el (nnvirtual-update-read-and-marked): Don't nix out - scores. - - * gnus-draft.el (gnus-draft-send): Check server more. - - * gnus-art.el (gnus-article-view-part): New command and keystroke. - (gnus-article-goto-part): New function. - - * mm-view.el (mm-inline-text): Insert richtext properly. - - * gnus-art.el (gnus-insert-mime-button): Store handle in alist. - -1998-10-03 15:04:27 Lars Magne Ingebrigtsen - - * parse-time.el (parse-time-rules): Accept dates far into the past - and the future, and parse single-digit numbers as years. - -1998-10-02 04:46:46 Lars Magne Ingebrigtsen - - * mm-decode.el (mm-display-external): Chop off directories. - -1998-10-01 07:33:35 Lars Magne Ingebrigtsen - - * uudecode.el (uu-decode-region-external): Use - insert-file-contents-literally. - - * gnus-cache.el (gnus-cache-generate-active): Translate _ to :. - -1998-10-01 07:02:11 Shenghuo ZHU - - * uudecode.el: New file. - - * mm-bodies.el (mm-decode-content-transfer-encoding): Do - x-uuencode. - -1998-10-01 05:19:35 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-mime-display-alternative): Set faces. - - * message.el (message-fetch-field): Unfold properly. - - * mm-bodies.el (mm-decode-content-transfer-encoding): Replace CRLF - in text/plain. - -1998-09-30 05:47:49 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-first-unread-subject): New command. - (gnus-auto-select-first): Removed. - (gnus-auto-select-first): Extended. - (gnus-summary-read-group-1): Use new value. - -1998-09-29 13:21:06 Lars Magne Ingebrigtsen - - * message.el (message-fix-before-sending): Space. - - * nnmail.el (nnmail-find-file): Don't erase. - -Wed Sep 30 23:49:03 1998 Shenghuo ZHU - - * gnus-agent.el (gnus-agent-fetch-headers): Do not decode headers. - -Wed Sep 30 23:46:29 1998 Shenghuo ZHU - - * gnus-soup.el (gnus-soup-add-article): Do not decode headers. - -Wed Sep 30 23:44:08 1998 Shenghuo ZHU - - * gnus-soup.el (gnus-soup-pack-packet): Pack only if necesary. - -Sat Sep 26 03:04:18 1998 Shenghuo ZHU - - * mm-util.el (mm-with-unibyte-buffer): Make it work in XEmacs - 20.4. - -1998-09-29 11:35:09 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-mime-view-all-parts): New command and - keystroke. - - * mm-decode.el (mm-display-external): Translate slashes. - - * nnmail.el (nnmail-find-file): Restrict auto-mode-alist. - - * nndraft.el (nndraft-retrieve-headers): Don't copy so much. - - * mm-decode.el (mm-quote-arg): Quote spaces. - (mm-display-external): Quote args. - -1998-09-24 22:27:55 Lars Magne Ingebrigtsen - - * mm-decode.el (mm-inlinable-part-p): New function. - -1998-09-25 22:28:01 Simon Josefsson - - * mm-util.el (mm-disable-multibyte): New function. - -Thu Sep 24 20:28:31 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.33 is released. - -1998-09-24 18:47:31 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-insert-mime-button): Get buffer size. - - * mm-decode.el (mm-display-external): Don't switch for externals. - (mm-dissect-multipart): Don't include end-sep. - - * mm-util.el (mm-get-coding-system-list): New function. - (mm-coding-system-list): New variable. - -Thu Sep 24 02:08:10 1998 ZHU Shenghuo - - * gnus-cus.el (gnus-group-parameters): Add charset as a parameter - -Thu Sep 24 02:05:48 1998 ZHU Shenghuo - - * gnus-cus.el (gnus-group-customize): Use variable as cons not as - group - -Thu Sep 24 01:41:03 1998 ZHU Shenghuo - - * base64.el (base64-run-command-on-region): External base64 - decoder do not use coding system - -Thu Sep 24 01:39:44 1998 ZHU Shenghuo - - * mm-decode.el (mm-interactively-view-part): Typo. - -Thu Sep 24 01:37:30 1998 ZHU Shenghuo - - * mm-decode.el (mm-dissect-multipart): Display last part when the - article has no close-delimiter - -Thu Sep 24 01:28:54 1998 ZHU Shenghuo - - * mm-decode.el (mm-dissect-buffer): Display parts which have no - content-type. - -Thu Sep 24 01:23:57 1998 ZHU Shenghuo - - * gnus-art.el (gnus-display-mime): Typo. - -Thu Sep 24 02:29:57 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.32 is released. - -1998-09-24 00:27:11 Lars Magne Ingebrigtsen - - * gnus-kill.el (gnus-batch-score): Protect against errors. - - * gnus-art.el: Protect against broken headers. - - * mm-decode.el (mm-display-external): Respect needsterm. - (mm-display-external): Create buffer for external commands. - -1998-09-23 22:04:05 Lars Magne Ingebrigtsen - - * mailcap.el (mailcap-mime-info): Return the proper viewer. - - * mm-decode.el (mm-display-external): Use file name. - -1998-09-22 Markus Rost - - * gnus-util.el (gnus-output-to-rmail): adjust to - `rmail-output-to-rmail-file' - -1998-09-23 20:07:00 Lars Magne Ingebrigtsen - - * gnus-util.el (gnus-output-to-rmail): Reinstated function. - - * gnus-sum.el (gnus-select-newsgroup): Set global variables before - headers. - - * gnus-art.el (article-decode-charset): Fold case. - -1998-09-17 15:49:10 Simon Josefsson - - * mailcap.el (mailcap-save-binary-file): Goto point-min. - -1998-09-23 19:48:52 Aaron M. Ucko - - * nnmail.el (nnmail-check-duplication): Enter into duplicate list - after being stored. - -Tue Sep 15 16:15:16 1998 Kurt Swanson - - * gnus-salt.el (gnus-pick-setup-message): Return from whence ye - come. - -1998-09-23 19:42:03 Lars Magne Ingebrigtsen - - * gnus-xmas.el (wid-edit): Required. - - * gnus-ems.el (gnus-widget-button-keymap): New variable. - -Sun Sep 20 00:27:55 1998 ZHU Shenghuo - - * gnus-art.el (gnus-mime-inline-part): remove part if necessary - -1998-09-23 19:30:52 Matt Armstrong - - * gnus-art.el (article-decode-charset): Narrow to the correct - region. - - * mm-bodies.el: Fix autoload. - -1998-09-22 18:35:12 Lee Willis - - * gnus-art.el (gnus-mime-button-line-format): Doc fix. - -1998-09-22 14:53:35 Lars Magne Ingebrigtsen - - * rfc2047.el (rfc2047-decode): Use rfc2047-default-charset. - -1998-09-19 13:58:35 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-insert-mime-button): Specify keymap. - (gnus-article-add-button): Ditto. - - * gnus-sum.el (gnus-summary-insert-pseudos): Use mm. - - * gnus-art.el (gnus-article-prepare-display): Make article mode. - (gnus-article-prepare-display): Bind url-standalone-mode. - - * mm-decode.el (mm-remove-part): Also delete directory. - (mm-display-external): Create a private sub-dir. - - * mailcap.el (mailcap-binary-suffixes): New variable. - (mailcap-command-p): Use it. - -1998-09-16 10:38:21 Lars Magne Ingebrigtsen - - * nnmbox.el (nnmbox-request-group): Change server. - (nnmbox-possibly-change-newsgroup): Enable multibyte. - - * message.el (message-encode-message-body): Don't stomp MIME - headers. - - * gnus-sum.el (gnus-summary-edit-article-done): Don't encode - unless useful. - (gnus-summary-exit): Check for a live article buffer. - (gnus-summary-exit-no-update): Ditto. - - * gnus-int.el (gnus-request-replace-article): Accept no-encode - param. - - * gnus-sum.el (gnus-article-decoded-p): New variable. - - * mm-decode.el (mm-display-external): Use no-conv. - - * rfc2047.el (rfc2047-q-encode-region): Bound properly. - (rfc2047-charset-encoding-alist): Use B encoding for koi8-r. - - * gnus-art.el (gnus-article-mode-map): Bind button2 to - mouse-click. - -1998-09-15 14:38:02 Lars Magne Ingebrigtsen - - * gnus-agent.el (gnus-agent-expire): Protect against nil infos. - -Mon Sep 14 18:55:38 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.31 is released. - -1998-09-14 15:12:59 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-exit): Destroy MIME. - - * mm-decode.el (mm-display-part): Accept no-default. - - * gnus-art.el (gnus-insert-mime-button): buffer-size doesn't take - a parameter. - - * gnus-sum.el (gnus-summary-insert-line): Don't exclude faces. - (gnus-summary-prepare-threads): Ditto. - - * gnus.el (gnus-article-mode-map): Make sparse keymap. - - * gnus-art.el (gnus-mime-button-line-format-alist): Allow a %d spec. - (gnus-mime-button-line-format): Doc fix. - (gnus-insert-mime-button): Use it. - (gnus-article-add-button): Use widget-convert-button. - - * gnus.el ((featurep 'gnus-xmas)): Defalias gnus-decode-rfc1522 to - ignore. - - * mm-decode.el (mm-alternative-precedence): Ditto. - -1998-09-14 15:12:49 Conrad Sauerwald - - * mm-decode.el (mm-user-automatic-display): Use enriched. - -1998-09-14 15:09:12 Paul Fisher - - * mm-decode.el (mm-dissect-multipart): Have the part start on the - right place. - -1998-09-14 14:33:34 Lars Magne Ingebrigtsen - - * gnus-msg.el (gnus-inews-add-send-actions): Mark silently. - - * gnus-art.el (article-update-date-lapsed): Only update header if - buffer is dispalyed in frame. - (gnus-article-prepare-display): New function. - (gnus-article-prepare): Use it. - -1998-09-14 08:16:43 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-mime-inline-part): New command and keystroke. - - * mm-view.el (mm-insert-inline): New function. - - * mm-decode.el (mm-pipe-part): Bugged. - - * gnus-agent.el (gnus-agent-send-mail): Don't encode. - - * mm-bodies.el (mm-encode-body): Move over the body. - - * nnmbox.el (nnmbox-read-mbox): Enable multibyte. - - * rfc2047.el (rfc2047-q-encode-region): Would bug out. - -1998-09-13 Francois Pinard - - * nndoc.el: Make nndoc-dissection-alist simpler for MIME, adjust all - related functions. Handle message/rfc822 parts. Display subject on - multipart summary lines. Display name on sub-parts when available. - -1998-09-14 07:36:38 Hallvard B. Furuseth - - * mailcap.el (mailcap-command-p): New version. - -1998-09-13 Mike McEwan - - * gnus-agent.el (gnus-agent-expire): Stop expiry barfing on killed - groups. - -1998-09-13 18:34:06 Lars Magne Ingebrigtsen - - * message.el (message-make-date): Remove weekday name. - - * mm-decode.el (mm-dissect-buffer): Protect against broken - headers. - - * mailcap.el (mailcap-command-in-path-p): New function. - (mailcap-command-p): Renamed. - -1998-09-13 17:58:47 Hallvard B. Furuseth - - * rfc2047.el (eval): Autoload. - -1998-09-13 12:22:40 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-decode-encoded-word-functions): New variable. - (gnus-multi-decode-encoded-word-string): New function. - (gnus-encoded-word-method-alist): New variable. - (gnus-decode-encoded-word-functions): Removed. - -1998-09-13 Shenghuo ZHU - - * gnus-int.el (gnus-request-replace-article): Replace - message-narrow-to-headers with message-narrow-to-head - -1998-09-13 12:05:41 Lars Magne Ingebrigtsen - - * drums.el (drums-quote-string): Reversed match. - - * message.el (message-make-date): Use weekday name. - -Sun Sep 11 10:27:15 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.30 is released. - -1998-09-13 08:00:41 Lars Magne Ingebrigtsen - - * gnus-art.el (article-decode-encoded-words): Use it. - (gnus-decode-header-function): New variable. - - * gnus-sum.el (gnus-nov-parse-line): Use it. - (gnus-decode-encoded-word-function): New variable. - - * gnus-msg.el (gnus-copy-article-buffer): Decode the right - buffer. - - * gnus-art.el (gnus-insert-mime-button): Use widget. - (gnus-widget-press-button): New function. - (gnus-article-prev-button): Removed. - (gnus-article-next-button): Ditto. - (gnus-article-add-button): Ditto. - - * gnus.el (gnus-article-mode-map): Inherit from widget. - (gnus-article-mode-map): No, don't. - - * mm-decode.el (mm-dissect-buffer): Store Content-ID things. - (mm-content-id-alist): New variable. - (mm-get-content-id): New function. - - * gnus-art.el (gnus-request-article-this-buffer): Only decode - articles if we are fetching to the article buffer. - -1998-09-13 07:58:59 Shenghuo ZHU - - * gnus-sum.el (gnus-summary-move-article): Don't decode accepting - articles. - -1998-09-13 07:23:28 Lars Magne Ingebrigtsen - - * mm-util.el (mm-mime-charset): Try to use safe-charsets. - (mm-default-mime-charset): New variable. - - * rfc2047.el (rfc2047-dissect-region): Dissect using tspecials. - - * drums.el (drums-quote-string): Reversed test. - -1998-09-12 14:29:21 Lars Magne Ingebrigtsen - - * mm-util.el (mm-insert-rfc822-headers): Possibly not quote - string. - - * drums.el (drums-quote-string): New function. - - * rfc2047.el (rfc2047-encode-message-header): Goto point-min. - (rfc2047-b-encode-region): Chop lines. - (rfc2047-q-encode-region): Ditto. - -Sat Sep 12 13:27:15 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.29 is released. - -1998-09-12 12:46:30 Istvan Marko - - * mm-decode.el (mm-save-part): Message right. - -1998-09-12 11:30:01 Lars Magne Ingebrigtsen - - * drums.el (drums-parse-address): Returned a list instead of a - string. - (drums-remove-whitespace): Skip comments. - (drums-parse-addresses): Didn't work. - -Sat Sep 12 09:17:30 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.28 is released. - -1998-09-12 04:57:25 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-mime-button-map): Use the article keymap as a - starting point. - (article-decode-encoded-words): Rename. - - * message.el (message-narrow-to-headers-or-head): New function. - - * gnus-int.el (gnus-request-accept-article): Narrow to the right - region. - - * message.el (message-send-news): Encode body after checking - syntax. - - * gnus-art.el (gnus-mime-button-line-format): Allow descriptions. - - * mm-decode.el (mm-save-part): Use Content-Disposition filename. - - * gnus-art.el (gnus-display-mime): Respect disposition. - - * mm-decode.el (mm-preferred-alternative): Respect disposition. - - * gnus-art.el (article-strip-multiple-blank-lines): Don't delete - text with annotations. - - * message.el (message-make-date): Fix sign for negative time - zones. - - * mm-view.el (mm-inline-image): Insert a space at the end of the - image. - - * mail-parse.el: New file. - - * rfc2231.el: New file. - - * drums.el (drums-content-type-get): Removed. - (drums-parse-content-type): Ditto. - - * mailcap.el (mailcap-mime-data): Use symbols instead of strings. - -Fri Sep 11 18:23:34 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.27 is released. - -1998-09-11 12:42:07 Lars Magne Ingebrigtsen - - * mm-decode.el (mm-alternative-precedence): New variable. - (mm-preferred-alternative): New function. - - * gnus-art.el (gnus-mime-copy-part): New command. - - * mm-decode.el (mm-get-part): New function. - - * mm-view.el: New file. - - * mm-decode.el (mm-dissect-buffer): Downcase cte. - (mm-display-part): Default to mailcap-save-binary-file. - -Fri Sep 11 12:32:50 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.26 is released. - -1998-09-11 08:25:33 Lars Magne Ingebrigtsen - - * mm-decode.el (mm-interactively-view-part): New function. - - * gnus-art.el (gnus-mime-view-part): New command. - - * mm-decode.el (mm-last-shell-command): New variable. - - * mailcap.el (mailcap-mime-info): Allow returning all matches. - - * mm-decode.el (mm-save-part): New function. - - * gnus-art.el (article-decode-charset): Protect against buggy - content-types. - (gnus-mime-pipe-part): New command. - (gnus-mime-save-part): New command. - (gnus-mime-button-map): New keymap. - (gnus-mime-button-line-format): New variable. - (gnus-insert-mime-button): New function. - (gnus-display-mime): Use it. - - * gnus-util.el (gnus-dd-mmm): Removed length spec. - - * mm-decode.el (mm-inline-text): Decode charsets. - - * gnus-art.el (gnus-article-save): Comment fix. - - * gnus-int.el (gnus-start-news-server): When in batch, don't - prompt. - - * gnus-cache.el (gnus-cache-possibly-enter-article): Don't - decode. - - * mm-decode.el (mm-inline-media-tests): Add audio. - (mm-inline-audio): New function. - -1998-09-11 08:19:22 Katsumi Yamaoka - - * gnus-art.el (article-make-date-line): Didn't work. - - * parse-time.el (parse-time-string): One too many nils. - -Fri Sep 11 08:09:40 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.25 is released. - -1998-09-11 07:38:14 Lars Magne Ingebrigtsen - - * gnus-art.el (article-remove-trailing-blank-lines): Don't remove - annotations. - - * gnus.el ((featurep 'gnus-xmas)): New - 'gnus-annotation-in-region-p alias. - -1998-09-10 06:20:52 Lars Magne Ingebrigtsen - - * mm-util.el (mm-with-unibyte-buffer): New function. - - * gnus-uu.el (gnus-quote-arg-for-sh-or-csh): Renamed. - - * mm-decode.el (mm-inline-media-tests): New variable. - - * gnus-sum.el (gnus-summary-exit): Destroy handles. - - * gnus-art.el (gnus-article-mime-handles): New variable. - - * drums.el (drums-narrow-to-header): New function. - - * gnus-art.el (article-decode-charset): Use it. - - * drums.el (drums-content-type-get): New function. - - * mm-util.el (mm-content-type-charset): Removed. - - * drums.el (drums-syntax-table): @ is word. - (drums-parse-content-type): New function. - - * parse-time.el (parse-time-rules): Parse "Wed, 29 Apr 98 0:26:01 - EDT" times. - - * gnus-util.el (gnus-date-get-time): Use safe date. - - * gnus-sum.el (gnus-show-mime): Removed. - (gnus-summary-toggle-mime): Removed. - - * gnus-art.el (gnus-strict-mime): Removed. - (gnus-article-prepare): Don't do MIME. - (gnus-decode-encoded-word-method): Removed. - (gnus-show-mime-method): Removed. - -Thu Sep 10 04:03:29 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.24 is released. - -1998-09-10 01:58:24 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-show-article): Don't decode chars if - PREFIX. - - * parse-time.el (parse-time-rules): Accept times that look like - "h:mm". - - * message.el (message-make-date): Use zone properly. - - * gnus.el: Autoload gnus-batch. - - * gnus-art.el (article-de-quoted-unreadable): Do not do - gnus-article-decode-rfc1522. - - * gnus-msg.el (gnus-inews-do-gcc): Use it. - - * gnus-int.el (gnus-request-accept-article): Accept a no-encode - param. - - * message.el (message-encode-message-body): Check for us-ascii. - - * gnus-msg.el (gnus-extended-version): Move Gnus version comments - to the left. - -1998-09-09 13:18:13 Lars Magne Ingebrigtsen - - * gnus-art.el (article-decode-charset): Rename. - -Wed Sep 9 12:25:48 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.23 is released. - -1998-09-09 12:14:47 Lars Magne Ingebrigtsen - - * gnus-util.el (gnus-parent-id): Ditto. - (gnus-put-text-property-excluding-newlines): Ditto. - - * gnus-sum.el (gnus-dependencies-add-header): Make into subst. - -1998-09-08 Karl Kleinpaste - - * message.el (message-generate-headers): Generate User-Agent - instead of X-Mailer & X-Newsreader. - - * gnus-msg.el (gnus-extended-version): Reformat for USEFOR - User-Agent header format. - -Tue Sep 8 22:38:27 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.22 is released. - -1998-09-08 22:36:54 Lars Magne Ingebrigtsen - - * mm-util.el (mm-multibyte-p): Typo. - -Tue Sep 8 22:25:53 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.21 is released. - -1998-09-08 Hrvoje Niksic - - * gnus-art.el (article-treat-dumbquotes): Handle \224 correctly. - -1998-09-08 22:18:03 Lars Magne Ingebrigtsen - - * mm-util.el (mm-multibyte-p): New function. - -Tue Sep 8 21:43:03 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.20 is released. - -1998-09-08 11:40:45 Lars Magne Ingebrigtsen - - * rfc2047.el (rfc2047-decode-region): Only decode when in - multibyte. - - * nnheader.el (nnheader-pathname-coding-system): Changed to binary. - - * gnus-int.el (gnus-request-replace-article): Encode. - (gnus-request-accept-article): Encode. - - * gnus-art.el (gnus-request-article-this-buffer): Decode charsets - here. - - * gnus.el (gnus-article-display-hook): Take the charset functions - out. - - * time-date.el (safe-date-to-time): New function. - - * gnus-util.el (gnus-dd-mmm): Protect against bogus dates. - -Tue Sep 8 07:09:28 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.19 is released. - -1998-09-08 04:51:39 Lars Magne Ingebrigtsen - - * base64.el (base64-encode-region): Accept no-line-break. - - * mm-util.el (mm-mime-charset): New function. - - * gnus-draft.el (gnus-draft-edit-message): Delete article. - -Tue Sep 8 04:29:23 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.18 is released. - -1998-09-08 02:21:36 Lars Magne Ingebrigtsen - - * message.el (message-send-and-exit): Return t on success. - (message-make-date): Make a proper time zone. - - * gnus-draft.el (gnus-draft-send): Only remove article if the - sending is successful. - - * drums.el (drums-get-comment): Return the last comment. - (drums-parse-address): Parse old-style From headers. - -1998-09-07 SL Baur - - * gnus-sum.el (gnus-data-compute-positions): Move below - `gnus-save-hidden-threads' so the former is correctly detected as - a macro. - -1998-09-06 Dave Love - - * gnus/nnweb.el (require): Wrap requirement of w3 and url in - ignore-errors too, eval'd when compile. Require w3 stuff at load - time for nicer failure if it's not available. - -1998-09-08 00:38:39 Lars Magne Ingebrigtsen - - * time-date.el (time-to-seconds): Renamed. - - * parse-time.el (parse-time-string): Downcase before handling. - (parse-time-rules): Times without seconds have 0 seconds. - - * rfc2047.el (rfc2047-encode-region): New version. - (rfc2047-dissect-region): New function. - -1998-09-07 01:08:35 Lars Magne Ingebrigtsen - - * message.el (message-make-date): Use symbolic zone. - -1998-09-06 23:23:06 Lars Magne Ingebrigtsen - - * time-date.el (parse-time): Always use parse-time. - - * parse-time.el (parse-time-syntax): Use vectors. - -Sun Sep 6 21:19:26 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.17 is released. - -1998-09-06 05:45:17 Lars Magne Ingebrigtsen - - * time-date.el: Renamed from "date". - - * gnus.el: Removed all timezone dependencies. - - * score-mode.el: Removed. - (gnus-score-edit-insert-date): Use date. - - * date.el (float-to-time): New function. - - * nnspool.el (nnspool-seconds-since-epoch): Removed. - - * date.el (time-to-float): New function. - - * message.el (message-make-date): Use format-time-string. - (message-make-expires): Use make-date. - - * gnus-xmas.el (gnus-xmas-seconds-since-epoch): Removed. - - * gnus-util.el (gnus-dd-mmm): Use date. - (gnus-sortable-date): Ditto. - - * message.el (message-make-date): Take an optional time. - - * gnus: Applied patches from 5.6.43. - - * date.el (if): Use parse-time. - - * gnus-score.el (gnus-summary-score-entry): Make into a command - again. - - * gnus-group.el (gnus-group-get-new-news-this-group): Only call if - gnus-agent. - - * gnus.el (gnus-agent-meta-information-header): Moved here. - -1998-09-05 Mike McEwan - - * gnus-agent.el (gnus-agent-scoreable-headers): New variable. - (gnus-agent-fetch-group-1): Score article headers using normal - group score files if the download score rule of a category/group - is `file'. - (gnus-agent-fetch-group-1): Don't parse the entire .overview when - deciding what articles to download. - (gnus-agent-fetch-group-1): Don't push headers through scoring and - predicate processing if predicate is `true' or `false'. - -1998-09-06 01:56:02 Lars Magne Ingebrigtsen - - * gnus-score.el (gnus-score-load-score-alist): Bind coding system. - - * gnus-art.el (gnus-article-setup-buffer): Enable multibyte. - - * score-mode.el (score-mode-coding-system): New variable. - (gnus-score-edit-exit): Use it. - -1998-09-04 Jason R Mastaler - - * drums.el: Corrected typo. - -1998-09-05 23:24:43 Hallvard B. Furuseth - - * mm-bodies.el (mm-body-encoding): Faster version. - -1998-09-05 22:23:03 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-decode-charset): Only decode text - things. - - * message.el (message-output): Use rmail. - - * rfc2047.el (rfc2047-encoded-word-regexp): Allow spaces in the - word part. - - * mm-util.el (mm-charset-to-coding-system): Use - rfc2047-default-charset. - (mm-known-charsets): New variable. - - * message.el (message-caesar-region): Bugged out. - -1998-09-06 Mike McEwan - - * gnus-agent.el (gnus-agent-fetch-group-1): Allow lists when - specifying `agent-predicate' in a group's parameters. - -Sat Sep 5 21:55:01 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.16 is released. - -1998-09-05 17:30:11 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-expired-article-p): Use predicate. - - * date.el (time-less-p): Renamed. - - * gnus-art.el (gnus-article-decode-charset): Really fetch headers - from the headers. - - * rfc2047.el (rfc2047-decode-region): Use the mm decoding - functions. - - * gnus-group.el (gnus-group-sort-selected-flat): Didn't work at - all. - (gnus-group-sort-selected-groups-by-alphabet): Changed interface - to all functions. - -Sat Sep 5 01:45:52 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.15 is released. - -1998-09-05 00:21:22 Lars Magne Ingebrigtsen - - * date.el: New file. - - * gnus-util.el (gnus-encode-date): Removed. - (gnus-time-less): Ditto. - - * nnmail.el (nnmail-date-to-time): Removed. - (nnmail-time-less): Ditto. - (nnmail-days-to-time): Ditto. - (nnmail-time-since): Ditto. - - * drums.el: New file. - -1998-09-04 00:25:52 Lars Magne Ingebrigtsen - - * message.el (message-encode-message-body): Encode headers with - body encoding. - - * rfc2047.el (rfc2047-default-charset): Renamed. - (rfc2047-encodable-p): Use it. - - * base64.el (mm-util): Required. - -1998-09-03 16:28:30 Lars Magne Ingebrigtsen - - * gnus-msg.el (gnus-post-method): Peel off real info from opened - servers. - - * gnus-util.el (gnus-output-to-rmail): Removed. - - * gnus-art.el (gnus-summary-save-in-rmail): Use - gnus-output-to-rmailrmail-output-to-rmail-file. - - * rfc2047.el (rfc2047-decode-region): Fold case. - (rfc2047-decode): Use decode-string. - - * mm-util.el: Provide mm-char-int. - -Thu Sep 3 15:23:22 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.14 is released. - -1998-09-03 15:08:30 Lars Magne Ingebrigtsen - - * mm-bodies.el (mm-body-encoding): Go through the buffer to make - sure we have 7bit. - -1998-09-02 14:38:18 Lars Magne Ingebrigtsen - - * gnus-msg.el (gnus-post-method): Use opened servers, and remove - ducplicates. - (gnus-inews-insert-mime-headers): Removed. - - * message.el (message-caesar-region): Protect against MULE chars. - -1998-09-02 00:36:23 Hallvard B. Furuseth - - * mm-util.el (if): fset the right function. - -1998-09-02 00:31:53 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-decode-charset): Use real - read-coding-system. - -1998-09-01 17:58:40 Lars Magne Ingebrigtsen - - * mm-bodies.el (mm-decode-body): Protect against malformed - base64. - (mm-decode-body): Check that buffer-file-coding-system is - non-nil. - -Tue Sep 1 10:29:33 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.13 is released. - -1998-09-01 09:14:33 Lars Magne Ingebrigtsen - - * gnus-util.el (gnus-strip-whitespace): Already defined. - Removed. - - * gnus-art.el (gnus-article-decode-charset): Strip whitespace. - - * gnus-util.el (gnus-strip-whitespace): New function. - - * mm-util.el (mm-content-type-charset): Downcase. - -1998-08-31 23:04:29 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-decode-charset): Accept a prefix. - (gnus-article-decode-charset): Don't fetch all headers. - - * mm-util.el (mm-read-coding-system): New function. - - * mm-bodies.el (mm-decode-body): Check the right charset. - - * gnus-sum.el (gnus-summary-mode-line-format): Ditto. - - * gnus-art.el (gnus-article-mode-line-format): Use short group - format. - -Mon Aug 31 23:03:13 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.12 is released. - -1998-08-31 22:39:36 Lars Magne Ingebrigtsen - - * mm-bodies.el (mm-decode-body): Don't do charset unless MULE. - - * gnus-art.el (gnus-article-decode-charset): Supply cte. - (gnus-article-decode-charset): Always run. - - * mm-bodies.el (mm-decode-body): Decode cte. - -Mon Aug 31 22:14:50 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.11 is released. - -1998-08-31 14:27:25 Lars Magne Ingebrigtsen - - * message.el (message-encode-message-body): Ditto. - - * gnus-art.el (gnus-article-decode-mime-words): New command and - keystroke. - (gnus-article-decode-charset): Ditto. - (gnus-article-decode-charset): Only work under MULE. - - * mm-util.el (mm-content-type-charset): New function. - - * nnmail.el (nnmail-delete-incoming): Changed to nil. - - * message.el (message-send-mail): Insert MIME headers. - (message-check-news-body-syntax): Don't warn for escape sequences. - (message-check-news-body-syntax): Insert MIME headers. - - * mm-bodies.el (mm-body-encoding): New function. - - * message.el (message-encode-message-body): New function. - - * mm-bodies.el: New file. - - * mm-util.el (mm-narrow-to-head): New function. - - * rfc2047.el (rfc2047-encode): Use it. - - * mm-util.el: Provide mm-encode-coding-region. - - * gnus-sum.el (gnus-summary-mode): Enable multibyte. - - * gnus-util.el (gnus-set-work-buffer): Enable multibyte. - - * mm-util.el (mm-enable-multibyte): New function. - - * message.el (message-set-work-buffer): Set multibyte. - - * gnus.el (gnus-continuum-version): Be valid forever and ever. - - * gnus-util.el (gnus-point-at-eol): Removed. - (gnus-point-at-bol): Ditto. - - * base64.el (base64-decode-region): Commented out messaging. - -1998-08-31 Didier Verna - - * gnus-msg.el (gnus-group-mail): make it behave like - gnus-group-post-news with regards to the prefix (this enables the - use of posting styles). - -1998-08-31 12:53:32 Lars Magne Ingebrigtsen - - * gnus.el (gnus-article-display-hook): Added - gnus-article-decode-rfc1522 to hook. - -Mon Aug 31 12:43:46 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.10 is released. - -1998-08-31 11:45:13 Lars Magne Ingebrigtsen - - * nnfolder.el (nnfolder-delete-mail): Narrow to mail and allow - hook to be run. - -1998-08-30 17:59:07 Lars Magne Ingebrigtsen - - * rfc2047.el (rfc2047-encodable-p): Use find-charset-region. - - * mm-util.el (mm-charsets-in-region): Removed. - - * rfc2047.el: Renamed file. - - * gnus-msg.el (gnus-copy-article-buffer): Multibyte. - - * message.el (message-mode): Set multibyte. - - * mm-util.el (mm-charsets-in-region): Copied here. - - * gnus-util.el: Removed gnus-truncate-string. - - * gnus-art.el (gnus-article-decode-mime-words): Use 1522. - - * rfc1522.el (rfc1522-unencoded-charsets): New variable. - (rfc1522-encodable-p): New function. - (rfc1522-encode-message-header): Use it. - -Sun Aug 30 17:46:01 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.9 is released. - -1998-08-30 16:13:08 Lars Magne Ingebrigtsen - - * mm-util.el: Shadow encode-coding-string. - - * base64.el (base64-encode-region): Don't add newline. - - * rfc1522.el (rfc1522-narrow-to-field): Copied here. - - * mm-util.el: New file. - - * mm-decode.el: Somewhat depleted. - * mm-encode.el: Ditto. - - * rfc1522.el: New file. - - * mm-util.el (mm-replace-chars-in-string): Copied here. - - * mm-encode.el (mm-q-encode-region): New function. - - * qp.el (quoted-printable-encode-region): Take an optional CLASS - param. - - * mm-encode.el (mm-encode-word-region): Downcase. - -Sun Aug 30 15:28:01 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.8 is released. - -1998-08-30 12:23:03 Lars Magne Ingebrigtsen - - * message.el (message-send-mail): Encode headers. - - * qp.el (quoted-printable-encode-region): Encode 8-bit words. - (quoted-printable-encode-region): Upcase. - - * message.el (message-default-charset): New variable. - - * qp.el (quoted-printable-encode-region): Optional param FOLD. - - * message.el (message-narrow-to-field): Changed name. - - * mm-encode.el: New file. - - * message.el (message-narrow-to-header): New function. - - * gnus-art.el (gnus-article-decode-mime-words): Place point in the - right buffer. - -Sun Aug 30 12:15:54 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.7 is released. - -1998-08-30 01:26:12 Lars Magne Ingebrigtsen - - * gnus.el: Remove autoload for - gnus-article-mime-decode-quoted-printable. - - * mm-decode.el (mm-charset-to-coding-system): Allow iso-8859-1 to - be decoded in non-MULE Emacsen. - - * gnus-xmas.el (gnus-xmas-logo-color-alist): More brown. - -1998-08-29 SL Baur - - * gnus-xmas.el (gnus-xmas-logo-color-alist): Try shades of brown. - -1998-08-30 01:04:57 Lars Magne Ingebrigtsen - - * mm-decode.el: Check for coding-system-list. - -Sun Aug 30 00:59:15 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.6 is released. - -1998-08-30 00:36:28 Lars Magne Ingebrigtsen - - * nnheader.el (fboundp): Protect code-coding-string. - - * gnus-art.el (gnus-article-mode): Check that set-buffer-multibyte - is available. - -Sat Aug 29 23:24:31 1998 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v0.5 is released. - -1998-08-29 22:38:35 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-mode): Make article buffer multibyte. - (gnus-hack-decode-rfc1522): Removed. - - * mm-decode.el (mm-charset-coding-system-alist): Check better. - -Sat Aug 29 22:20:39 1998 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v0.4 is released. - -1998-08-29 20:53:29 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-decode-mime-words): New command and - keystroke. - - * qp.el (quoted-printable-decode-region): Don't use hexl. - - * gnus-xmas.el (gnus-xmas-logo-color-style): Changed to dino. - - * gnus-sum.el (gnus-parse-headers-hook): Default to nil. - (gnus-structured-field-decoder): Removed. - (gnus-unstructured-field-decoder): Ditto. - - * mm-decode.el: New file. - - * qp.el: New file. - - * gnus-art.el (article-mime-decode-quoted-printable): Removed. - - * gnus-ems.el (fboundp): Removed gnus-split-string. - - * gnus.el (gnus-splash-face): Doc fix. - - * gnus-ems.el (fboundp): Don't bind mail-file-babyl-p. - - * gnus-art.el (article-mime-decode-quoted-printable): Don't use - hexl. - - * nnheader.el (nnheader-temp-write): Removed. - -Sat Aug 29 20:34:17 1998 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v0.3 is released. - -Sat Aug 29 19:32:06 1998 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v0.2 is released. - - Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. - Copying and distribution of this file, with or without modification, - are permitted provided the copyright notice and this notice are preserved. - -;; Local Variables: -;; coding: iso-2022-7bit -;; End: - -;;; arch-tag: bc9bf70e-b352-4a38-9dec-edce4b023b22 diff --git a/xemacs-packages/gnus/lisp/ChangeLog.2.upstream b/xemacs-packages/gnus/lisp/ChangeLog.2.upstream deleted file mode 100644 index 36f92c64..00000000 --- a/xemacs-packages/gnus/lisp/ChangeLog.2.upstream +++ /dev/null @@ -1,18884 +0,0 @@ -2004-01-04 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.10.6 is released. - -2004-01-04 Kai Grossjohann - - * gnus-sum.el (gnus-summary-print-article): Doc fix. - -2004-01-04 Lars Magne Ingebrigtsen - - * gnus.el (gnus-version-number): Bump. - -2004-01-04 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.10.5 is released. - -2004-01-03 Lars Magne Ingebrigtsen - - * gnus-fun.el (gnus-face-from-file): Message 9. - -2004-01-03 Romain FRANCOISE - - * gnus-fun.el (gnus-face-from-file): Use gnus-message. - -2004-01-03 Reiner Steib - - * gnus-art.el (gnus-button-mid-or-mail-heuristic): Treat Gmane - addresses specially. Fix returned value and messages. - - * mm-decode.el (mm-enable-external): New variable. - (mm-display-part): Use it. - (mm-display-external): Fix message in case of nil handle. - - * Update copyright for several files. - - * spam-report.el (spam-report-gmane): Adjust verbosity. - Delete trailing whitespace. Update copyright. - - * spam.el: Fix many (but not all) checkdoc complaints. - Delete trailing whitespace. - - * message.el (message-header-synonyms): Defcustom. - (message-get-reply-headers): Catch `Original-To'. - (message-carefully-insert-headers): Added comment. - - * gnus-sum.el (gnus-summary-make-menu-bar): Improved "Washing" menu. - -2004-01-03 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-select-newsgroup): Use cat. - - * gnus-agent.el (gnus-agent-cat-enable-undownloaded-faces): New - cat. - - * gnus.el (gnus-user-agent): Moved here. - - * gnus-msg.el (gnus-user-agent): Moved from here. - - * gnus.el (gnus-version-number): Bump. - -2004-01-03 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.10.4 is released. - -2004-01-02 Reiner Steib - - * gnus.el (gnus-mode-line-buffer-identification): Show version in - help-echo. - (gnus-read-group): Allow most group names. Changed warning. - -2004-01-02 Lars Magne Ingebrigtsen - - * gnus-dired.el (gnus-dired-mode-map): Change keymaps. - -2004-01-02 Arne J,Ax(Brgensen - - * smime.el (smime-crl-check): Doc fix. - -2004-01-02 Edwin Steiner (tiny change) - - * gnus-nocem.el (gnus-nocem-enter-article): Use the real group - hashtb. - -2004-01-02 Michael Albinus - - * nnml.el (nnml-save-mail): Grok compressed articles. - -2004-01-02 Teodor Zlatanov - - * spam.el (spam-ham-copy-or-move-routine): use spam-list-articles - (spam-list-articles): rewritten to only check a mark once per - invocation - -2004-01-01 Simon Josefsson - - * mml-sec.el (mml-default-encrypt-method) - (mml-default-sign-method): Defcustom. - -2003-12-31 Lars Magne Ingebrigtsen - - * mml.el (mml-generate-mime-1): Remove extra ). - - * gnus-group.el (gnus-group-set-current-level): Signal errors on - topic lines. - (gnus-group-set-current-level): Fix fix. - -2003-12-31 Jeremy Maitin-Shepard - - * mml.el (mml-generate-mime-1): Use mml-compute-boundary (tiny - change). - -2003-12-30 Reiner Steib - - * gnus-group.el: Removed `(when t ...)' around `gnus-define-keys'. - (gnus-group-group-map): Added `gnus-group-read-ephemeral-group' - (already in previous commit inadvertently). - (gnus-group-make-menu-bar): Added `gnus-group-read-ephemeral-group'. - (gnus-group-read-ephemeral-group): Made interactive. - - * gnus-score.el (gnus-score-find-trace): Added comment on sync - with `gnus-score-edit-file-at-point'. - - * gnus-logic.el (gnus-score-advanced): Ditto. - - * gnus-score.el (gnus-score-edit-file-at-point): Fix for - advanced scoring. - -2003-12-30 Simon Josefsson - - * gnus-score.el (gnus-score-edit-file-at-point): Use - gnus-point-at-*, for portability. - -2003-12-30 Reiner Steib - - * gnus-art.el (gnus-treat-body-boundary): Fix doc-string and - custom type. - (gnus-button-mid-or-mail-regexp): Don't be too restrictive. - Suggested by Felix Wiemann . - (gnus-button-alist): Added "M-x ... RET" and "mid:" buttons. - Added comments about relevant RFCs. - - * gnus-sum.el (gnus-summary-mode): Untabify doc-string. - (gnus-summary-goto-article): Allow `%40'. - (gnus-summary-refer-article): Convert `%40' to `@'. - -2003-12-30 Arne J,Ax(Brgensen - - * smime.el (smime-crl-check): New. - (smime-verify-region): Use it. - -2003-12-30 Reiner Steib - - (gnus-score-find-trace): Use gnus-score-edit-file-at-point. Added - `f' and `t' commands, added quick help. With some suggestions - from Karl Pfl,Ad(Bsterer . - - * gnus-util.el (gnus-emacs-version): Added doc-string. - - * mml.el (mml-minibuffer-read-disposition): New function. - (mml-attach-file): Use it. - (mml-preview): Added MIME preview to gnus-buffers. - -2003-12-30 Karl Pfl,Ad(Bsterer - - * gnus-score.el (gnus-score-edit-file-at-point): Consider the - whole match element. - -2003-12-30 Jesper Harder - - * gnus-sum.el (gnus-summary-make-menu-bar): Add ellipses. - -2003-12-30 Lars Magne Ingebrigtsen - - * gnus-start.el (gnus-get-unread-articles): Inline gnus-server-get-method. - (gnus-get-unread-articles): Cache methods. - (gnus-get-unread-articles-in-group): Indent. - - * gnus.el (gnus-version-number): Bump. - (gnus-secondary-method-p): Extend servers to methods before comparing. - (gnus-secondary-method-p): Revert. - -2003-12-30 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.10.3 is released. - -2003-12-29 Simon Josefsson - - * gnus-agent.el (gnus-agentize): Improve auto-agentizing logic. - Suggested by Steinar Bang . - (gnus-agent-auto-agentize-methods): Customize. - -2003-12-29 Kevin Greiner - * gnus.el (gnus-server-to-method): Fixed bug in 2003-12-22 - check-in. - -2003-12-28 Adrian Lanz - - * mail-source.el (mail-source-fetch-imap): Prevent storing of - identical entries for imap mail sources, when retrieving mail - messages from an imap server within the same Gnus session several - times (tiny change). - -2003-12-28 Jesper Harder - - * mm-view.el (mm-text-html-washer-alist): Use - mm-inline-wash-with-stdin for w3m-standalone. - - * mm-decode.el (mm-text-html-renderer): Add w3m-standalone. - - * mml1991.el (mml1991-pgg-encrypt): Decode according to CTE before - encrypting. - -2003-12-28 Ivan Boldyrev (tiny change). - - * mml1991.el (mml1991-pgg-sign): Use unibyte when re-encoding. - -2003-12-26 Katsumi Yamaoka - - * dgnushack.el: Add an advice to byte-optimize-form-code-walker to - avoid the warning ``...called for effect'' for the pop form when - running Emacs 21.3. - -2003-12-26 Jesper Harder - - * mm-bodies.el (mm-body-encoding): Don't use 7bit if the body - contains "^From " and mm-use-ultra-safe-encoding is true. - -2003-12-25 Jesper Harder - - * mml1991.el (mml1991-pgg-sign): Encode and decode according to - CTE header. Don't insert gpg output as unibyte. - -2003-12-25 Katsumi Yamaoka - - * lpath.el: Remove display-time-event-handler and open-ssl-stream; - add delete-extent for Emacs; rearrange bindings assuming w3 may - not be available and XEmacs without the file-coding feature may be - used. - -2003-12-24 Katsumi Yamaoka - - * dgnushack.el (dgnushack-compile): Increase the value for - max-specpdl-size when compiling Gnus with Emacs 20. - -2003-12-22 Kevin Greiner - * gnus-int.el (gnus-open-server): Fixed the server status such - that an agentized server, when opened offline, has a status of - offline. Also fixes bug whereby the agent's backend was called - twice to open each server. - - * gnus-start.el (gnus-get-unread-articles-in-group): Autoload - gnus-agent-possibly-alter-active rather than inline to resolve - compiler warnings. - - * gnus.el (gnus-server-to-method): Added fallback of iterating - over gnus-newsrc-alist to resolve names of foreign servers. - Should fix recent agent bug. - -2003-12-22 Reiner Steib - - * gnus-score.el (gnus-summary-lower-score) - (gnus-summary-increase-score): Mention symbolic prefix in the - doc-string. Suggested by Karl Pfl,Ad(Bsterer . - -2003-12-21 Jesper Harder - - * gnus-agent.el (gnus-agent-read-agentview): Use - car-less-than-car. - -2003-12-20 Artem Chuprina (tiny change) - - * message.el (message-yank-buffer): Bind message-reply-buffer to - a buffer rather than a string. - -2003-12-19 Jesper Harder - - * gnus-msg.el (gnus-summary-followup): Correct documentation. - -2003-12-18 Jesper Harder - - * gnus-msg.el (gnus-inews-add-send-actions): `yanked' can be a - list of lists. Reported by Dmitri Paduchikh . - -2003-12-18 Reiner Steib - - * mm-url.el (mm-url-insert-file-contents-external) - (mm-url-insert-file-contents): Added doc-strings. Autoload. - -2003-12-18 Jesper Harder - - * gnus-cus.el (defvar): defvar - gnus-agent-cat-disable-undownloaded-faces. - -2003-12-17 Katsumi Yamaoka - - * message.el (message-forward-subject-name-subject): Use - gnus-extract-address-components instead of - mail-header-parse-address because it may be called with non-ascii - text. - -2003-12-16 Per Abrahamsen - - * nnmail.el (nnmail-split-fancy): The widget now supports - restrictions. - -2003-12-16 Katsumi Yamaoka - - * nnheader.el (nnheader-find-etc-directory): Find the newest one. - -2003-12-16 Simon Josefsson - - * sha1-el.el (autoload): Don't use ignore-errors. - (sha1-use-external): Use condition-case. Suggested by Katsumi - Yamaoka . - -2003-12-15 Katsumi Yamaoka - - * nnmail.el (nnmail-split-fancy): Make it customizable with Emacs - 20 as well. - -2003-12-15 Simon Josefsson - - * sha1-el.el (autoload): Ignore errors for - executable-find. (XEmacs ecrypto does not require sh-script where - executable.el is located.) - (sha1-use-external): Likewise. - - * sha1-el.el (sha1): Add defgroup. - (sha1-maximum-internal-length, sha1-program, sha1-use-external) - (sha1-program): Use 'sha1sum' from GNU CoreUtils instead of OpenSSL. - (sha1): Autoload. - - * nndraft.el (nndraft-request-move-article): Copy definition of - nnmh-request-move-article instead of calling it, because the nnmh - version uses nnmh-request-article which isn't the same as the - nndraft version. - -2003-12-13 Teodor Zlatanov - - * spam.el: added some gnus-registry autoloads - (spam-split-symbolic-return): makes spam-split return 'spam - instead of the value of spam-split-group when spam is detected - (spam-split-symbolic-return-positive): makes spam-split return - 'ham instead of nil when ham is detected - (spam-autodetect-recheck-messages): tells spam.el whether it - should recheck all messages in a group, or only the unseen ones - (spam-split-last-successful-check): spam-split will set this to - the last successful check; this was seen as a cleaner approach - than returning a cell like '(spam spam-use-bogofilter) - (spam-list-of-checks): documentation appended - (spam-split): accomodate the spam-split-symbolic-return and - spam-split-symbolic-return-positive variables - (spam-find-spam): new function called when the summary is built - (spam-log-registered-p): checks if a ham or spam registration has - already been done for an article - (spam-check-regex-headers, spam-check-blackholes, spam-check-BBDB) - (spam-check-ifile, spam-check-stat, spam-check-whitelist) - (spam-check-blacklist, spam-check-bogofilter-headers) - (spam-check-spamoracle): respect the spam-split-symbolic-return - and spam-split-symbolic-return-positive variables - (spam-initialize): add spam-find-spam to gnus-summary-prepare-hook - (spam-unload-hook): remove spam-find-spam from - gnus-summary-prepare-hook - - * gnus.el (spam-autodetect, spam-autodetect-methods): new - configuration items for spam autodetection - -2003-12-12 Reiner Steib - - * gnus-draft.el (gnus-draft-mode-map): Bind `e' to - `gnus-draft-edit-message'. We still have `B w' for - `gnus-summary-edit-article'. - -2003-12-12 Katsumi Yamaoka - - * nnheaderxm.el (nnheader-xmas-run-at-time): Use a simple function - definition if there is not a bug in start-itimer. - - * pgg.el (pgg-run-at-time): Ditto. - -2003-12-11 Kevin Greiner - - * gnus-agent.el (gnus-agent-possibly-alter-active): New Function. - (gnus-agent-regenerate-group): When necessary, alter the group's - active range to include articles newly recognized as being - downloaded. - (gnus-agent-regenerate): Removed code that updated the agent's - active file as the new gnus-agent-possibly-alter-active function - obsolesced it. - - * gnus-cus.el (gnus-agent-customize-category): Added missing - agent-disable-undownloaded-faces parameter. - - * gnus-start.el (gnus-activate-group): Backed out my 2003-11-29 - patch as it was too late at adjusting the active range. - (gnus-get-unread-articles-in-group): Added call to new - gnus-agent-possibly-alter-active to adjust the active range. - -2003-12-10 Jesper Harder - - * message.el (message-get-reply-headers): Narrow to headers. - -2003-12-10 L,Bu(Brentey K,Ba(Broly - - * spam.el (spam-disable-spam-split-during-ham-respool): New - variable. - (spam-ham-copy-or-move-routine): Respect - spam-disable-spam-split-during-ham-respool. - (spam-split-disabled): New variable. - (spam-split): Respect spam-split-disabled. - -2003-12-10 Katsumi Yamaoka - - * nnheaderxm.el (nnheader-xmas-run-at-time): Make it work - correctly for the first argument. - - * pgg.el (pgg-run-at-time): New function. - (pgg-add-passphrase-cache): Use it. - -2003-12-10 Simon Josefsson - - * pgg-parse.el (pgg-decode-packets): Rewrite to handle corrupt - input. - (pgg-decode-armor-region): Don't parse packet if decoding fail. - -2003-12-09 L,Bu(Brentey K,Ba(Broly - - * spam.el (spam-check-bogofilter): run in the correct buffer. - -2003-12-09 Xavier Maillard - - * spam.el (spam-bogofilter-database-directory): correct - customization group. - -2003-12-09 Per Abrahamsen - - * nnmail.el (nnmail-lazy, nnmail-split-fancy): New widgets. - (nnmail-split-fancy): Use it. - -2003-12-08 Joel Ray Holveck (tiny change) - - * gnus-sum.el (gnus-summary-save-parts-1): Consider the "name" - parameter of Content-Type. - -2003-12-08 Katsumi Yamaoka - - * gnus-util.el: Revert 2003-12-03 change, instead, provide the - compiler macro for rmail-select-summary if rmail is not available, - and bind rmail-summary-displayed and rmail-maybe-display-summary - in order to silence the compiler even if tm is not available. - -2003-12-08 Simon Josefsson - - * flow-fill.el (fill-flowed-encode-tests, fill-flowed-test): Add. - -2003-12-08 Jesper Harder - - * gnus-msg.el (gnus-extended-version): Bind float-output-format to - nil. - -2003-12-08 Simon Josefsson - - * mml-smime.el (mml-smime-sign): Replace CRLF with LF in OpenSSL - output. Reported by Arne J,Ax(Brgensen . - -2003-12-07 Lloyd Zusman (tiny change) - - * pgg-gpg.el (pgg-gpg-recipient-arg): Add. - (pgg-gpg-encrypt-region): Use it. - -2003-12-07 Simon Josefsson - - * pgg-gpg.el (pgg-gpg-recipient-argument): Doc fix. - Renamed from p-g-r-a. - (pgg-gpg-encrypt-region): Update. - -2003-12-07 Jesper Harder - - * spam.el (spam-check-spamoracle, spam-spamoracle-learn): Don't - use = or zerop to test the return value of call-process, because - it can be a string. - - * mail-source.el (mail-source-fetch-with-program): do. - - * mailcap.el (mailcap-viewer-passes-test): do. - - * gnus-uu.el (gnus-uu-treat-archive, gnus-uu-post-encode-mime) - (gnus-uu-post-encode-file): do. - - * gnus-soup.el (gnus-soup-pack, gnus-soup-unpack-packet): do. - - * message.el (message-fix-before-sending): Fix detection of - non-printables. Don't replace unencodable utf-8. - -2003-12-05 Jesper Harder - - * mm-url.el (mm-url-predefined-programs): Add user-agent for wget. - (mm-url-insert-file-contents-external): Signal an error if program - fails. - -2003-12-04 Teodor Zlatanov - - * spam-report.el (spam-report-gmane): iterate over articles - instead of a single one; remove interactive usage - -2003-12-03 Katsumi Yamaoka - - * dns.el: Fix misplaced eval-when-compile. - - * gnus-util.el: Require alist and provide tm-view when compiling - with XEmacs. - -2003-12-03 Jerry James (tiny change) - - * gnus-xmas.el: Add autoloads for macros defined in gnus.el. - - * gnus-util.el: Get rmail definitions when compiling. - - * dns.el: Require gnus-xmas at compile time instead of trying to - autoload `gnus-xmas-open-network-stream' because it wasn't picking - up the macro. - -2003-12-01 Kevin Greiner - - * gnus-agent.el (gnus-agent-consider-all-articles): Updated - docstring. - (gnus-predicate-implies-unread, gnus-predicate-implies-unread-1): - Fixed implementation such that the predicate `true' no longer - evaluates to t. - -2003-12-01 Adrian Lanz (tiny change) - - * spam.el (spam-check-bogofilter): check the bogofilter headers - AFTER the save-excursion scope is over. - -2003-12-01 Teodor Zlatanov - - * spam.el (spam-fetch-field-message-id-fast): Doc fix - -2003-12-01 Simon Josefsson - - * gnus-agent.el (gnus-agent-expire-days): Doc fix. - -2003-11-30 Simon Josefsson - - * gnus-agent.el (gnus-agent-expire-group-1): Bind message-log-max - when messaging "X % completed" to inhibit logging them to the - message buffer. - (gnus-agent-expire-group-1): Mention group name in messages. - (gnus-agent-expire-group-1): Only print a message for an article - when there actually was something done to it. - - * gnus-agent.el (gnus-agent-expire-unagentized-dirs): Custom fix. - -2003-11-30 Kenichi Handa - - * mm-util.el (mm-enable-multibyte): Call set-buffer-multibyte with - 'to argument. Fixes something or other in Emacs 22, and is - backwards compatible. - -2003-11-30 Lars Magne Ingebrigtsen - - * gnus-agent.el (gnus-agent-covered-methods): Remove nil methods. - -2003-11-29 Kevin Greiner - * gnus-start.el (gnus-activate-group): The active range of the - group must include the articles known to the agent. - - * gnus.el (gnus-agent-method-p): Accept a server name as the - method being tested. - -2003-11-29 Alexander Kreuzer (tiny change) - - * nnrss.el (nnrss-check-group): Set xml when nnrss-use-local is t. - -2003-11-29 Jesper Harder - - * gnus-group.el (gnus-group-make-menu-bar): Add - gnus-group-make-rss-group. - -2003-11-28 Reiner Steib - - * message.el: Added custom-manual links to all variables that have - an index entry in the message manual. - (message-generate-headers-first): Fixed doc-string. - -2003-11-27 Katsumi Yamaoka - - * gnus-msg.el (gnus-summary-yank-message): Don't bind - gnus-display-mime-function to nil so that non-ascii text is - decoded and attachments are not shown. - - * message.el (message-cite-original-without-signature): Replace - the value of message-reply-headers with the yanked article since - it may be a different article from the original. - (message-cite-original): Ditto. - -2003-11-25 Teodor Zlatanov - - * spam.el (spam-blacklist-ignored-regexes): new variable, so - blacklisting can ignore certain regular expressions (e.g. the - user's e-mail address) - (spam-bogofilter-spam-strong-switch, - spam-bogofilter-ham-strong-switch): options used when articles are - already registered as the opposite classification - (spam-old-ham-articles, spam-old-spam-articles): lists of ham and - spam articles, generated when a summary buffer is entered, and - consulted when it's exited so we know what articles are changing - state from spam to ham or vice-versa - (spam-xor): everyone needs a little convenience - (spam-list-of-processors): lookup table for old-style spam/ham - exits processors - (spam-group-processor-p): support old-style and new-style spam/ham - exit processors - (spam-group-processor-multiple-p): handle new-style spam/ham exit - processors - (spam-summary-prepare): use spam-old-{ham,spam}-articles; change - logic to iterate over list of processors instead of manual - individual lookup, unregister any articles that change from ham to - spam or vice-versa in the course of the summary buffer usage; use - the new spam-register-routine - (spam-ham-copy-routine, spam-ham-move-routine, - spam-mark-spam-as-expired-and-move-routine): check that the list - of groups is not nil, because apply doesn't like to apply a - function across nil - (spam-registration-functions): variable for looking up spam/ham - registration/unregistration functions based on a spam-use-* symbol - (spam-classification-valid-p, spam-process-type-valid-p) - (spam-registration-check-valid-p) - (spam-unregistration-check-valid-p): convenience functions - (spam-registration-function, spam-unregistration-function): look - up the registration/unregistration function based on a - classification and the check (spam-use-* symbol) - (spam-list-articles): generate list of spam/ham articles from a - given list of articles - (spam-register-routine): do the heavy work of registering and - unregistering articles, using all the articles in the group or - specific ones as needed - (spam-generic-register-routine): removed, no longer used - (spam-log-unregistration-needed-p, spam-log-undo-registration): - handle article registration/unregistration with a given spam/ham - processor and group - (BBDB, ifile, spam-stat, blacklists, whitelists, spam-report, - bogofilter, spamoracle): rewrite registration/unregistration - functions to take a list of articles and the unregister option. - Much hilarity ensues. - (spam-initialize): spam-stat-maybe-{save,load} already respect spam-use-stat - (spam-stat-register-ham-routine, spam-stat-register-spam-routine): - don't load and save unnecessarily - - * spam-stat.el (spam-stat-dirty): new variable, set when the stats - database is modified - (spam-stat-buffer-is-spam, spam-stat-buffer-is-non-spam) - (spam-stat-buffer-change-to-spam, spam-stat-to-hash-table) - (spam-stat-buffer-change-to-non-spam): set spam-stat-dirty when - needed - (spam-stat-save): respect spam-stat-dirty, unless the force - parameter is specified - (spam-stat-load): clear spam-stat-dirty - - * gnus.el (gnus-install-group-spam-parameters): marked the - old-style exit processors as obsolete in the docs, added the - new-style exit processors while the old ones are still allowed - - -2003-11-25 Jesper Harder - - * gnus-art.el (article-hide-boring-headers): Don't hide Reply-To - unless its list of addresses is identical to From. - -2003-11-25 Katsumi Yamaoka - - * dgnushack.el (mapc): Add the compiler macro for Emacs 20. - -2003-11-24 Kevin Greiner - * gnus-srvr.el (gnus-server-insert-server-line): The server names - used in gnus-agent are different (for example, the native server - uses the alias "native") from the names in gnus-srvr. - Compensating by adding a second text property storing the name - expected by gnus-agent. - (gnus-server-named-server): New function. - * gnus-agent.el (gnus-agent-remove-server, gnus-agent-add-server): - No longer expect an argument as it was ignored anyway. Uses the - new gnus-server-named-server function to get gnus-agent compatible - names from the server buffer. - -2003-11-20 Kevin Greiner - - * gnus.el (gnus-agent-covered-methods): Documented use of - named servers, not methods, to identity agentized groups. - Users may now change their server configurations without having - the server become "unagentized". - (gnus-agent-covered-methods): Removed from gnus-variable-list to - avoid storing two copies of gnus-agent-covered-methods, one in - .newsrc.eld and the other in agent/lib/servers. - (gnus-server-to-method): Do not cache server for the nil method. - (gnus-method-to-server): New function. Associate named server - with all, even foreign, methods. - (gnus-agent-method-p, gnus-agent-method-p-cache): Incorporated - simple last-response cache to offset performance lose of having to - always convert methods to named servers. - * gnus-agent.el (gnus-agent-expire-days): Removed obsolete - documentation. - (gnus-agentize, gnus-agent-add-server, gnus-agent-remove-server): - Modified to support new definition of gnus-agent-covered-method. - (gnus-agent-read-servers): Rewritten to convert old method data - into server names. - (gnus-agent-read-servers-validate) - (gnus-agent-read-servers-validate-native): New functions. - (gnus-agent-write-servers): No longer use gnus-method-simplify as - it failed to simplify foreign methods. - (gnus-agent-close-connections, gnus-agent-synchronize-flags) - (gnus-agent-possibly-synchronize-flags, gnus-agent-fetch-session) - (gnus-agent-regenerate): Uses new gnus-agent-covered-methods - function as gnus-agent-covered-methods variable no longer provides - methods. - (gnus-agent-covered-methods): New function - (gnus-agent-expire-group, gnus-agent-expire): Final message will, - if gnus-verbose is greater than 4, report statistics of NOV - entries and files deleted as well as total bytes recovered. - (gnus-agent-expire-done-message): New function - (gnus-agent-unread-articles): Bug fix. No longer drops last - unread article onto read list. - (gnus-agent-regenerate-group): Changed prompt to use typical - style. - (gnus-agent-group-covered-p): Rewrote to internally use - gnus-agent-method-p. - * gnus-int.el (gnus-start-news-server): Partially convert old - gnus-agent-covered-methods to new format so that gnus-open-server - functions correctly. - * gnus-srvr.el (gnus-server-insert-server-line): Replaced - gnus-agent-covered-methods with gnus-agent-method-p. - * gnus-start.el (gnus-clear-system): Added - gnus-agent-covered-methods to compensate for removing it from - gnus-variable-list. - (gnus-setup-news): Complete conversion of old - gnus-agent-covered-methods to new format so that secondary and - foreign servers can be correctly opened. - -2003-11-20 Teodor Zlatanov - - * spam.el (spam-ham-copy-or-move-routine): add respooling - support, not working well yet - - * gnus.el (ham-process-destination): make 'respool option the - only one, so it can't be chosen together with other groups - -2003-11-19 Teodor Zlatanov - - * gnus-registry.el (gnus-registry-track-extra): make it a set of - choices instead of a boolean - (gnus-registry-track-subject-p, gnus-registry-track-sender-p): - new convenience functions - (gnus-registry-split-fancy-with-parent): use convenience - functions, also don't return extra tracking info if sender or - subject is found in more than one groups - (gnus-registry-add-group): use new convenience functions to - decide if sender and subject should be tracked - - * gnus.el (ham-process-destination): add 'respool option, - unused by spam.el yet - -2003-11-19 Katsumi Yamaoka - - * gnus-score.el (gnus-decay-score): Return a surely smaller value - than the argument in XEmacs. - -2003-11-18 Sam Steingold - - * message.el (message-insert-to): Don't use `gnus-message'. - (message-header-synonyms): New variable. - (message-carefully-insert-headers): Use it (check for synonyms). - Added doc-string. - -2003-11-17 Lars Magne Ingebrigtsen - - * html2text.el (html2text-remove-tags): Remove the tag in a - simpler way to avoid inflooping. - -2003-11-17 Simon Josefsson - - * imap.el (imap-gssapi-auth-p): Don't check capability (some - servers remove AUTH=GSSAPI from capability response returned after - successful authentication). - -2003-11-16 Jesper Harder - - * gnus.el (gnus-getenv-nntpserver): Fix regexp and simplify. - Reported by Artem Chuprina . - -2003-11-14 Simon Josefsson - - * mm-util.el (mm-charset-synonym-alist): Map BIG5-HKSCS to BIG5 - when it isn't available. - -2003-11-13 Alex Schroeder - - * nnrss.el (nnrss-check-group): Use dc:contributor if neither - rss:author nor dc:creator is provided. - -2003-11-13 Katsumi Yamaoka - - * mm-decode.el (mm-dissect-buffer): Save start="" value - contained in Content-Type header of multipart/related messages. - - * mm-view.el (mm-w3m-cid-retrieve-1): New function. - (mm-w3m-cid-retrieve): Use it. - - * mml.el (mml-generate-mime-1): Add start="" to Content-Type. - (mml-insert-mime-headers): Insert Content-ID header. - (mml-insert-mml-markup): Insert start="" value. - -2003-11-12 Teodor Zlatanov - - * nnml.el (nnml-request-accept-article): pass sender to - nnmail-cache-insert - - * nnmh.el (nnmh-request-accept-article): pass sender to - nnmail-cache-insert - - * nnmbox.el (nnmbox-request-accept-article): pass sender to - nnmail-cache-insert - - * nnfolder.el (nnfolder-request-accept-article): pass sender to - nnmail-cache-insert - - * nnbabyl.el (nnbabyl-request-accept-article): pass sender to - nnmail-cache-insert - - * nnmail.el (nnmail-cache-insert): accept sender parameter and - pass it to the nnmail-spool-hook - - * gnus-registry.el (gnus-registry-track-extra): clarify doc - (gnus-registry-action): add sender lexical var and pass it to - gnus-registry-add-group - (gnus-registry-spool-action): take a sender parameter, pass to - gnus-registry-add-group - (gnus-registry-split-fancy-with-parent): trace by sender in - addition to subject - (gnus-registry-fetch-sender-fast): new function - (gnus-registry-add-group): accept sender parameter - -2003-11-11 Teodor Zlatanov - - * spam.el (spam-ham-copy-routine, spam-ham-move-routine) - (spam-mark-spam-as-expired-and-move-routine): allow for the - groups to be a list of a single item - - * gnus.el (gnus-install-group-spam-parameters): - ham-process-destination and spam-process-destination allow lists now - -2003-11-10 Reiner Steib - - * message.el (message-mode-field-menu): Moved some entries, added - `message-insert-wide-reply'. - (message-change-subject): Fixed comment. - -2003-11-10 Sam Steingold - - * message.el (message-insert-to): Do error out when the user - requested no Cc. Don't insert empty To. Can be added to - `message-setup-hook' now. - -2003-11-10 Simon Josefsson - - * pgg-def.el (pgg-encrypt-for-me): Change default from nil to t. - -2003-11-09 Simon Josefsson - - * pgg-gpg.el (pgg-gpg-encrypt-region): Cache passphrase under hex - key id too (for decryption). - (pgg-gpg-sign-region): Likewise. - -2003-11-09 Satyaki Das - - * pgg-gpg.el (pgg-gpg-all-secret-keys): New variable. - (pgg-gpg-lookup-all-secret-keys): New function. - (pgg-gpg-select-matching-key): Likewise. - (pgg-gpg-decrypt-region): Use new functions. - -2003-11-07 Teodor Zlatanov - - * nnmail.el (nnmail-cache-insert): make sure that the - nnmail-spool-hook is called with a valid newsgroup name (though - it may be wrong) - - * gnus.el (gnus-group-real-prefix): return nil if group is not a - string, instead of triggering an error - -2003-11-06 Teodor Zlatanov - - * gnus.el (gnus-group-guess-full-name-from-command-method): new function - - * gnus-registry.el (gnus-registry-fetch-group): use long names if - requested - (gnus-registry-split-fancy-with-parent): when long names are in - use, strip the name if we're in the native server, or else return nothing - (gnus-registry-spool-action, gnus-registry-action): use - gnus-group-guess-full-name-from-command-method instead of - gnus-group-guess-full-name - - * spam.el (spam-mark-spam-as-expired-and-move-routine) - (spam-ham-copy-or-move-routine): prevent article deletions or - moves unless the backend allows it - - * gnus.el (gnus-install-group-spam-parameters): fixed parameters - to list spamoracle as well, suggested by Jean-Marc Lasgouttes - - - * spam.el (spam-spamoracle): doc change, suggested by Jean-Marc - Lasgouttes - -2003-11-04 Norbert Koch (tiny change) - - * gnus-score.el (gnus-decay-score): Protect against arithmetic - errors. - -2003-10-31 Teodor Zlatanov - - * spam.el - (spam-log-processing-to-registry): improved message and comments - (spam-log-unregistration-needed-p): new function - (spam-ifile-register-spam-routine) - (spam-ifile-register-ham-routine, spam-stat-register-spam-routine) - (spam-stat-register-ham-routine) - (spam-blacklist-register-routine) - (spam-whitelist-register-routine) - (spam-bogofilter-register-spam-routine) - (spam-bogofilter-register-ham-routine) - (spam-spamoracle-learn-ham, spam-spamoracle-learn-spam): change - spam-log-processing-to-registry invocations appropriately - -2003-10-31 Derek Atkins (tiny change) - - * imap.el (imap-kerberos4-open): Ignore output from ATHENA imtest. - -2003-10-31 Simon Josefsson - - * imap.el (imap-process-connection-type): Improve docstring. - Suggested by Derek Atkins . - -2003-10-31 Teodor Zlatanov - - * spam.el (autoload): autoload the gnus-registry functions we'll - need - (spam-log-to-registry): new variable for interfacing with the - gnus-registry - (spam-install-hooks): variable had the wrong customization group - (spam-fetch-field-message-id-fast): convenience function for fetch - a message ID quickly - (spam-log-processing-to-registry): new function - (spam-ifile-register-spam-routine) - (spam-ifile-register-ham-routine, spam-stat-register-spam-routine) - (spam-stat-register-ham-routine) - (spam-blacklist-register-routine) - (spam-whitelist-register-routine) - (spam-bogofilter-register-spam-routine) - (spam-bogofilter-register-ham-routine) - (spam-spamoracle-learn-ham, spam-spamoracle-learn-spam): add - spam-log-processing-to-registry invocations - - * gnus-registry.el: fixed docs in the preface to mention - gnus-registry-initialize - (gnus-registry-store-extra): remove cached extra entry - information when new extra entry is stored - -2003-10-29 Simon Josefsson - - * message.el (message-forward-make-body-plain): Fix ARG=1 mode - after separating m-f-m-b. - -2003-10-29 Andre Srinivasan (tiny change) - - * message.el (message-forward-make-body-plain): Remove ignored - headers. - -2003-10-29 Simon Josefsson - - * message.el (message-forward-make-body-plain): Fix ARG=1. - -2003-10-28 Jesper Harder - - * message.el (message-forward-subject-name-subject) - (message-forward-subject-author-subject): Decode non-ASCII - newsgroup names. - (autoload): Autoload gnus-group-decoded-name. - -2003-10-27 Simon Josefsson - - * pgg-gpg.el (pgg-gpg-possibly-cache-passphrase): New optional - parameter key, overrides the key id used to store passphrase - under (uses true key id from gpg output if nil). - (pgg-gpg-encrypt-region): Search for passphrase using user suplied - string STR, instead of (pgg-lookup-key STR t). - (pgg-gpg-encrypt-region): Store passphrase under user suplied - string, instead of real key id taken from gpg output. - (pgg-gpg-decrypt-region): Likewise. - (pgg-gpg-sign-region): Likewise. - * pgg.el (pgg-decrypt-region): Don't set pgg-default-user-id. - -2003-10-27 Romain FRANCOISE - - * gnus-art.el (gnus-article-goto-prev-page): Doc fix. - -2003-10-27 Simon Josefsson - - * mm-bodies.el (mm-body-encoding): Don't use QP when message body - only consists of short lines and ASCII, when - mm-use-ultra-safe-encoding. Refer to 'About foo' thread in - gnus-bug, e.g. , for more discussion. - This make it possible to pipe the raw RFC 822 message into 'gpg' - and have the signature work. Potential problem: what if message - contain data that would be dash-escaped by OpenPGP - implementations? Then PGP 2.x might not be able to parse the raw - RFC 822 message correctly. If that problem is worth fixing, it - should be fixed by detecting the situation, instead of applying QP - to everything. Based on discussion with "John A. Martin" - . - -2003-10-27 Teodor Zlatanov - - * spam.el (spam-mark-spam-as-expired-and-move-routine) - (spam-ham-copy-or-move-routine): don't ask when deleting copied - articles, and use move instead of copy when possible - (spam-split): added the option of specifying a string as a - spam-split parameter; such a string will override - spam-split-group temporarily. - - * nnmail.el (nnmail-cache-insert): protect from nil message IDs, - but should we do something else? - - * gnus-registry.el (gnus-registry-spool-action): protect from nil - message IDs - -2003-10-26 Simon Josefsson - - * gnus-art.el (gnus-button-alist): Allow & in mailto URLs. - (gnus-header-button-alist): Likewise. - (gnus-url-mailto): Handle ?to parameters. Replace \r\n with \n. - Reverse parameter list to use same order as in the URL. Reported - by f95-msv@f.kth.se (M,Ae(Brten Svantesson). - -2003-10-25 Teodor Zlatanov - - * spam.el (spam-move-spam-nonspam-groups-only): documentation fix - for the variable - -2003-10-25 Steve Youngs - - * Makefile.in (clean-some): Remove auto-autoloads.* and - custom-load.* as well. - (distclean): Ditto. - - * dgnushack.el (dgnushack-make-load): Add a local vars section to - the dummy gnus-load.el. - -2003-10-24 Teodor Zlatanov - - * spam.el (spam-ham-copy-or-move-routine): do not delete if copy - is t, also don't intepret the list of groups as a list of lists - (spam-mark-spam-as-expired-and-move-routine) - (spam-ham-copy-or-move-routine): delete articles only if 1 or - more groups were specified (and "copy" was not specified for - spam-ham-copy-or-move-routine) (fixed twice) - -2003-10-24 Katsumi Yamaoka - - * nndoc.el (nndoc-guess-type): Reverse the sort order. Suggested - by ARISAWA Akihiro . - (nndoc-dissect-buffer): Don't miss even-numbered articles. - -2003-10-24 Steve Youngs - - * dgnushack.el (dgnushack-gnus-load-file): Set to - "auto-autoloads.el" if building with XEmacs. - (dgnushack-cus-load-file): Set to "custom-load.el" if building - with XEmacs. - (dgnushack-make-cus-load): We don't delete the resulting file if - building with XEmacs so byte-compile it. - (dgnushack-make-load): When building with XEmacs do nothing except - byte-compile the autoload file and create a dummy gnus-load.el - file. - -2003-10-23 Katsumi Yamaoka - - * message.el (message-make-fqdn): Bind case-fold-search. - Suggested by Christopher Richards . - -2003-10-23 Teodor Zlatanov - - * gnus.el (spam-process-destination, ham-process-destination): - allow multiple groups as a choice - - * spam.el (spam-check-blackholes): remove "[IP address]" - requirement, now just "IP address" is enough for detection for - blackhole checking - (spam-check-blackholes): oops, the dots were not escaped - (spam-mark-spam-as-expired-and-move-routine): added multiple group - support (multiple copies, then delete) - (spam-ham-copy-routine): new function - (spam-ham-move-routine): new function - (spam-ham-copy-or-move-routine): new function (used to be - spam-ham-move-routine), handle multiple groups - (spam-summary-prepare-exit): call the new functions - -2003-10-23 Simon Josefsson - - * flow-fill.el (fill-flowed-encode, fill-flowed): Autoload. - -2003-10-22 Katsumi Yamaoka - - * gnus-art.el (gnus-emphasis-strikethru): Use the :strike-through - attribute in Emacs. - -2003-10-21 Katsumi Yamaoka - - * message.el (message-bounce): Don't erase except bounced header. - -2003-10-21 Teodor Zlatanov - - * spam.el (spam-reverse-ip-string): new function to reverse an IP - address in a string - (spam-check-blackholes): use spam-reverse-ip-string - -2003-10-21 Katsumi Yamaoka - - * gnus-art.el (gnus-narrow-to-page): Clear as well as set the - value for gnus-page-broken. - - * gnus-sum.el (gnus-summary-beginning-of-article): Use - gnus-break-pages instead of gnus-page-broken. - (gnus-summary-end-of-article): Use gnus-break-pages instead of - gnus-page-broken; narrow to the end of a page beforehand. - (gnus-summary-toggle-header): Use gnus-break-pages instead of - gnus-page-broken; remove delimiter buttons unless gnus-break-pages - is non-nil. - -2003-10-21 Lars Magne Ingebrigtsen - - * gnus-picon.el (gnus-picon-transform-address): Protect against - errors. - -2003-10-20 Katsumi Yamaoka - - * gnus-msg.el (nnspool-rejected-article-hook): Remove defvar. - (xemacs-codename): Move defvar to gnus-util.el. - - * gnus-util.el (xemacs-codename): Defvar when compiling. - -2003-10-20 Lars Magne Ingebrigtsen - - * spam-report.el (spam-report-url-ping-plain): Include a - User-Agent. - - * gnus-msg.el (gnus-extended-version): Use it. - - * gnus-util.el (gnus-emacs-version): Separated out into own - function. - -2003-10-19 Reiner Steib - - * message.el (message-mode-field-menu): Added - message-generate-unsubscribed-mail-followup-to. - (message-forward-subject-fwd): Avoid double "Fwd: " - (message-change-subject): Added comment. - -2003-10-19 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-nov-parse-line): Remove condition-cases. - - * mml.el (mml-insert-mime): Quote mml. - -2003-10-19 Katsumi Yamaoka - - * gnus-sum.el (gnus-remove-odd-characters): Use - mm-subst-char-in-string instead of subst-char-in-string. - (gnus-summary-refer-article): Use gnus-replace-in-string instead - of replace-regexp-in-string. - -2003-10-19 Jesper Harder - - * gnus-uu.el (gnus-uu-uustrip-article): Really strip directory - from file name. - -2003-10-18 Jesper Harder - - * gnus-sum.el (gnus-summary-save-parts-last-directory): Default - to mm-default-directory. - (gnus-summary-save-parts-1): Use mm-file-name-rewrite-functions. - -2003-10-18 Lars Magne Ingebrigtsen - - * pop3.el (pop3-read-response): Check whether the process is - alive. - - * gnus-sum.el (gnus-summary-refer-article): Strip spaces. - - * rfc2047.el (rfc2047-encode-region): Do error out on invalid - strings. - - * nntp.el (nntp-retrieve-headers-with-xover): Get error messages - right. - - * gnus-agent.el (gnus-agent-read-servers): Remove sit-for. - - * gnus-art.el (article-treat-dumbquotes): Doc fix. - - * message.el (message-field-value): New function. - (message-insert-disposition-notification-to): Use Reply-To, too. - - * imap.el (imap-mailbox-status): Upcase STATUS commands. - - * gnus-sum.el (gnus-remove-odd-characters): New function. - (gnus-nov-parse-line): Use it. - -2003-10-18 Matt Swift - - * mm-decode.el (mm-inline-media-tests): Recognize pjpeg as jpeg. - -2003-10-18 Romain FRANCOISE - - * message.el (message-forward-make-body): does both - m-f-make-body-mml and m-f-make-body-plain, resulting in a strange - message buffer. - -2003-10-18 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-narrow-to-page): Only break page if it's - broken. - - * nnrss.el (nnrss-find-rss-via-syndic8): Return nil if xml-rpc - isn't available. - - * message.el (message-hidden-headers): Doc fix. - -2003-10-18 Jesper Harder - - * gnus-msg.el (gnus-summary-resend-message-edit): Avoid error when - fields aren't found. - -2003-10-18 Simon Josefsson - - * message.el (message-forward-make-body-plain) - (message-forward-make-body-mime, message-forward-make-body-mml) - (message-forward-make-body-digest-plain) - (message-forward-make-body-digest-mime) - (message-forward-make-body-digest): New, derived from - message-forward-make-body. - (message-forward-make-body): Use them. - (message-forward-show-mml): New default 'best. - (message-forward-make-body): Support it. - -2003-10-18 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-mode): Set gnus-page-broken to nil. - (gnus-article-prepare): Don't set to t. - (gnus-narrow-to-page): Set to t if we break. - -2003-06-11 Daniel N,Ai(Bri - - * message.el (message-resend): Generate Resent-Message-ID header. - -2003-10-18 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-next-page): Don't go to the next line - before checking end-of-buffer. - (gnus-mime-delete-part): Don't insert parts twice. - -2003-10-17 Lars Magne Ingebrigtsen - - * gnus-art.el (article-update-date-lapsed): Make sure point - doesn't move around (much). - -2003-07-28 Vasily Korytov - - * mail-source.el (mail-source-keyword-map): List "cur" before - "new" for maildirs. - -2003-10-17 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-enter-digest-group): ogroup, nor - group. - - * gnus-msg.el (gnus-inews-insert-archive-gcc): Use the parent - name for gcc-self. - (gnus-inews-insert-archive-gcc): Paren mistake. - - * gnus-sum.el (gnus-summary-enter-digest-group): Add - parent-group. - - * gnus-art.el (gnus-ignored-headers): Add more headers. - - * rfc2047.el (rfc2047-encode): See which encoding is shorter -- - base64 or QP. - - * nnmail.el (nnmail-article-group): Default to "bogus". - - * mail-source.el (mail-source-delete-incoming): Change to nil. - -2003-10-16 Katsumi Yamaoka - - * mail-source.el (mail-source-fetch-imap): Fix mismatched parens. - -2003-10-16 Lars Magne Ingebrigtsen - - * mail-source.el (defvar): Add post/pre/scripts. - (mail-source-fetch-imap): Use them. - - * nndraft.el (nndraft-request-move-article): Fix infinite - recursion. - - * gnus-group.el (gnus-group-mark-regexp): Jump to groups. - -2003-10-16 Ed L. Cashin - - * imap.el (imap-interactive-login): Set imap-password to nil if - login fails. - -2003-10-16 Lars Magne Ingebrigtsen - - * message.el (message-inserted-headers): New variable. - (message-mode): Make local. - (message-mode): Set all the local action variables to nil. - -2003-10-16 Katsumi Yamaoka - - * mm-decode.el (mm-inline-text-html-with-images): Doc fix. - (mm-w3m-safe-url-regexp): Doc fix. - -2003-10-12 Jesper Harder - - * gnus-sum.el (gnus-summary-respool-query): Don't narrow to head, - it's done by nnmail-article-group. - -2003-10-12 Mark Hood (tiny change) - - * gnus-uu.el (gnus-uu-grab-articles): Fix misplaced parens. - -2003-10-10 Jesper Harder - - * mm-decode.el (mm-file-name-delete-gotchas): Avoid infloop in - XEmacs. - -2003-10-10 Teodor Zlatanov - - * spam.el (spam-initialize): new function, does the spam-face - update and all the hooks, replaces spam-install-hooks-function - - * gnus-registry.el (gnus-registry-initialize): new autoloaded - function to explicitly initialize the registry - -2003-10-10 Katsumi Yamaoka - - * mm-decode.el (mm-w3m-safe-url-regexp): Doc fix. - - * mm-view.el (mm-w3m-mode-map): Doc fix. - (mm-inline-text-html-render-with-w3m): Add a comment. - -2003-10-10 Lars Magne Ingebrigtsen - - * gnus-group.el: Remove superfluous eval-when-compiles. - -2003-10-10 Jesper Harder - - * gnus-group.el (gnus-group-suspend): Reset gnus-backlog-articles. - -2003-10-08 Lars Magne Ingebrigtsen - - * dns.el (query-dns): Don't error out on malformed resolv files. - -2003-10-06 Jesper Harder - - * gnus.el (gnus-group-faq-directory): Update .tw entry. From - Albert Chun-Chieh Huang - -2003-10-03 Teodor Zlatanov - - * spam.el (spam-check-blackholes): exit the loop if matches are - found (idea from Adrian Lanz ) - (spam-check-bogofilter-headers, spam-check-blackholes, spam-check-BBDB) - (spam-from-listed-p): use nnmail-fetch-field instead of message-fetch-field - - -2003-10-03 Katsumi Yamaoka - - * mm-decode.el (mm-attachment-file-modes): Change the default - value into 384 from ?\600 which doesn't mean an integer in XEmacs. - -2003-10-03 Jesper Harder - - * mm-decode.el (mm-file-name-delete-control) - (mm-file-name-delete-gotchas): New functions. - (mm-file-name-rewrite-functions): Use them. - (mm-attachment-file-modes): New option. - (mm-save-part-to-file): Use it. - -2003-10-02 Reiner Steib - - * spam.el (spam-install-hooks-function): Added Autoload cookie. - -2003-10-02 Michael Shields - - * pgg-def.el (pgg-default-keyserver-address): Change to - subkeys.pgp.net. - -2003-10-01 Simon Josefsson - - * message.el (message-idna-to-ascii-rhs-1): RHS can be terminated - by ',', as in 'foo@example.org, bar@example.org'. - -2003-10-01 Jesper Harder - - * message.el (message-send): Fix reversed logic of supersedes - check. - -2003-09-30 Reiner Steib - - * gnus-art.el (gnus-article-view-part-as-charset): Doc fix, - suggested by Norbert Koch . - -2003-09-29 Katsumi Yamaoka - - * gnus-topic.el (gnus-topic-goto-missing-topic): Revert 2003-02-09 - change in order to correct the position where an invisible topic - (because gnus-topic-display-empty-topics is nil) may be inserted. - -2003-09-22 Katsumi Yamaoka - - * message.el (message-ignored-supersedes-headers): Add X-Payment. - -2003-09-20 Jesper Harder - - * rfc2047.el (rfc2047-encode): Limit line length to 76 characters. - -2003-09-20 Simon Josefsson - - * tls.el (tls-process-connection-type): Doc fix. - - * imap.el (imap-starttls-open): Rewrite, should support both old - starttls.el and new starttls.el that uses GNUTLS. - -2003-09-18 Katsumi Yamaoka - - * gnus-art.el (gnus-treat-display-x-face): Use set-default instead - of custom-set-default which isn't available in old XEmacsen. - -2003-09-17 Jesper Harder - - * gnus-msg.el (gnus-summary-resend-message-edit): Don't convert - to MML. MIME -> MML -> MIME does not work for PGP/MIME. - - * message.el (message-bounce, message-forward-show-mml): do. - -2003-09-13 Jesper Harder - - * rfc2047.el (rfc2047-charset-encoding-alist): Add viscii. - (rfc2047-encode): Add factors for big5, gb2312 and euc-kr. - - * nnweb.el (nnweb-google-parse-1): Fix parsing. - -2003-09-12 Jesper Harder - - * gnus-group.el (gnus-group-fetch-control): ISC changed - compression from .Z to .gz. - - * rfc2047.el (rfc2047-header-encoding-alist): Add "Approved" to - address-mime. - -2003-09-11 Jesper Harder - - * rfc2047.el (rfc2047-encode): Restrict encoded-words to 75 - characters. - -2003-09-10 Jesper Harder - - * gnus.el (gnus-group-charter-alist): Update. - -2003-09-10 Eric Knauel - - * spam-report.el: Use mm-url.el functions for external URL loading - when the built-in HTTP GET is insufficient (e.g. proxies are in - the way). - -2003-09-10 Teodor Zlatanov - - * spam-report.el (spam-report-url-ping-function): New option, - defaults to the built-in HTTP GET (spam-report-url-ping-plain). - (spam-report-url-ping): Call spam-report-url-ping-function. - (spam-report-url-ping-plain): New function, does what - spam-report-url-ping used to do. - (spam-report-url-ping-mm-url): Function that delegates to - mm-url.el (autoloaded). - -2003-09-08 Teodor Zlatanov - - * gnus-registry.el (gnus-registry-delete-id): function to - completely delete an ID, including all the cache hashtables - (gnus-registry-delete-group): use gnus-registry-delete-id - (gnus-registry-simplify-subject): only run if the argument is a - string, return nil otherwise - -2003-09-07 Jesper Harder - - * gnus-msg.el (gnus-summary-resend-bounced-mail): Docstring fix. - -2003-09-05 Teodor Zlatanov - - * gnus-registry.el (gnus-registry-split-fancy-with-parent): yet - another error *sigh* - - * gnus-registry.el (gnus-registry-fetch-extra-entry): don't use - puthash unless gnus-registry-entry-caching is on - (gnus-registry-split-fancy-with-parent): misplaced parenthesis - made everything a part of the 'else' - (gnus-registry-save): used 'entry-caching' instead of 'caching' - -2003-09-05 Jesper Harder - - * gnus-art.el (gnus-button-alist): Improve Info regexp. - -2003-09-04 Teodor Zlatanov - - * gnus-registry.el: added brief explanation of basics - (gnus-registry-track-extra): new variable for tracking of message - subjects - (gnus-registry-entry-caching): caching parameter, used for extra - data - (gnus-registry-minimum-subject-length): minimum subject length - before it's considered when tracing subjects - (gnus-registry-save): accomodate extra data entry caching - (gnus-registry-action): change function name, add the subject and - pass it to gnus-registry-add-group - (gnus-registry-spool-action): change function name, add the - subject and pass it to gnus-registry-add-group - (gnus-registry-split-fancy-with-parent): add subject tracking - (gnus-registry-register-message-ids): pass subject to - gnus-registry-add-group - (gnus-registry-simplify-subject) - (gnus-registry-fetch-simplified-message-subject-fast): new - functions - (gnus-registry-fetch-extra, gnus-registry-fetch-extra-entry): add - extra data entry caching - (gnus-registry-add-group): handle the extra subject parameter - (gnus-registry-install-hooks, gnus-registry-unload-hook): fix the - gnus-register-* function names - - * nnmail.el (nnmail-cache-insert): add subject parameter, pass it - on to the nnmail-spool-hook - - * nnbabyl.el (nnbabyl-request-accept-article): added subject to - nnmail-cache-insert call - - * nndiary.el (nndiary-request-accept-article): added subject to - nnmail-cache-insert call - - * nnfolder.el (nnfolder-request-accept-article): added subject to - nnmail-cache-insert call - - * nnimap.el (nnimap-split-articles): added subject to - nnmail-cache-insert call - (nnimap-request-accept-article): added subject to - nnmail-cache-insert call - - * nnmbox.el (nnmbox-request-accept-article): added subject to - nnmail-cache-insert call - - * nnmh.el (nnmh-request-accept-article): added subject to - nnmail-cache-insert call - - * nnml.el (nnml-request-accept-article): added subject to - nnmail-cache-insert call - -2003-09-04 Jesper Harder - - * gnus-art.el (gnus-button-handle-info-url) - (gnus-button-handle-info-url-gnome) - (gnus-button-handle-info-url-kde, gnus-button-alist): Handle GNOME - and KDE style Info URLs. - - * gnus-util.el (gnus-url-unhex-string): Don't replace "+" with " ". - -2003-09-02 Jesper Harder - - * rfc2047.el (rfc2047-fold-region): Don't fold at the beginning - of the field. - -2003-09-01 Simon Josefsson - - * mml.el (mml-insert-mime-headers-always): New variable. - (mml-insert-mime-headers): Use it. Based on (tiny) patch from - Lars Balker Rasmussen . - -2003-08-30 Gaute B Strokkenes (tiny change) - - * mail-source.el (mail-source-fetch-imap): Pass correct buffer to - imap-open, reverts 2003-03-17 change. Reverse remove before - calling gnus-compress-sequence. - -2003-08-29 Simon Josefsson - - * gnus-group.el (gnus-group-delete-group): Doc fix. Suggested by - Jochen K,A|(Bpper . - -2003-08-29 Katsumi Yamaoka - - * gnus-art.el (article-display-x-face): Make it possible to set - the gnus-article-x-face-command variable to the lambda form. - -2003-08-27 Simon Josefsson - - * mm-decode.el (mm-remove-part): Try to kill external displayers - cleanly first (if it refuses, C-g aborts loop and kill process - unconditionally). Also make sure process is dead before we remove - the files it may be using. Reported by David Coe - . - -2003-08-27 Vagn Johansen (tiny change) - - * gnus-cache.el (gnus-cache-generate-active): Fix bug in - replacement. - -2003-08-25 Katsumi Yamaoka - - * gnus-art.el: Don't use defvaralias. - (gnus-treat-display-x-face): Warn if the obsolete variable - `gnus-treat-display-xface' exists. - -2003-08-25 Jesper Harder - - * gnus-art.el (gnus-treat-display-face): Fix typo. - (gnus-treat-display-xface): Rename to gnus-treat-display-x-face - (reported by Jochen K,A|(Bpper ) - -2003-08-24 Jesper Harder - - * gnus-art.el (gnus-header-button-alist, gnus-button-alist): Fix - type. - -2003-08-22 Jesper Harder - - * message.el (message-make-forward-subject-function): Fix - customize mismatch. - - * gnus.el (gnus-message-archive-method): do. - -2003-08-20 Reiner Steib - - * gnus.el (gnus-read-group): Offer to continue only if the invalid - char is `/' and add more information for the user. - - * gnus-art.el (gnus-button-alist): Add `+' (gnus-button-handle-man). - (gnus-header-button-alist): Added `In-Reply-To'. - - * nnimap.el (nnimap-open-connection): Allow different user names - on the same server (and in the same authinfo file). - -2003-08-20 Jesper Harder - - * gnus-sieve.el (gnus-sieve-crosspost): Fix type. - - * message.el (message-make-forward-subject-function): Add - message-forward-subject-name-subject to choices. - - * gnus-art.el (gnus-article-edit-done, gnus-article-edit-exit): - Redisplay article after editing. - -2003-08-20 Jari Aalto - - * gnus.el (gnus-read-group): Added check to ask confirmation if - Group name contains invalid character. You can use '/' in IMAP, - but not in filenames. G m cannot know what the user is creating, - so let user decide. See thread m2oeysiev3.fsf@naima.lensflare.org. - -2003-08-13 Reiner Steib - - * gnus-score.el (gnus-summary-score-effect): Fix interactive use. - -2003-08-10 Teodor Zlatanov - - * gnus-draft.el (gnus-draft-send-all-messages): ask if all drafts - should be sent unless gnus-expert-user is on - -2003-08-09 Jesper Harder - - * pgg-gpg.el (pgg-gpg-extra-args): Fix customization type. - -2003-08-07 Jesper Harder - - * pgg-gpg.el (pgg-gpg-process-region): Bind - default-enable-multibyte-characters to nil. - -2003-08-07 Katsumi Yamaoka - - * canlock.el (canlock-password): Fix customization type. - (canlock-password-for-verify): Ditto. - * deuglify.el (gnus-outlook-deuglify-unwrap-min): Ditto. - (gnus-outlook-deuglify-unwrap-max): Ditto. - (gnus-outlook-deuglify-unwrap-stop-chars): Ditto. - * gnus-sum.el (gnus-sum-thread-tree-root): Ditto. - (gnus-sum-thread-tree-false-root): Ditto. - (gnus-sum-thread-tree-single-indent): Ditto. - * message.el (message-archive-note): Ditto. - (message-subscribed-address-file): Ditto. - (message-user-fqdn): Ditto. - * spam-report.el (spam-report-gmane-regex): Ditto. - * spam.el (spam-blackhole-good-server-regex): Ditto. - - * gnus-start.el (gnus-save-killed-list): Fix last change. - * message.el (message-courtesy-message): Ditto. - -2003-08-07 Jesper Harder - - * gnus-art.el (gnus-header-face-alist): Revert previous change. - (gnus-header-newsgroups-face): Explain that it's only used for - crossposts. - -2003-08-07 Katsumi Yamaoka - - * gnus-registry.el (gnus-registry-max-entries): Fix customization - type. - * gnus-score.el (gnus-adaptive-word-length-limit): Ditto. - * gnus.el (gnus-refer-article-method): Ditto. - * message.el (message-courtesy-message): Ditto. - -2003-08-06 Chunyu Wang (tiny change) - - * gnus-art.el (gnus-header-face-alist): Fix "Newsgroups" entry. - -2003-08-05 Katsumi Yamaoka - - * gnus-start.el (gnus-save-killed-list): Fix customization type. - * gnus-sum.el (gnus-thread-hide-subtree): Ditto. - * gnus.el (gnus-use-long-file-name): Ditto. - -2003-08-04 Jesper Harder - - * gnus-group.el (gnus-group-rename-group): Don't allow renaming to - an existing name. - - * gnus-sum.el (gnus-summary-highlight): Add uncached to docstring. - - * nnmail.el (nnmail-large-newsgroup): Docstring fix. - - * nntp.el (nntp-large-newsgroup): do. - - * nnspool.el (nnspool-large-newsgroup): do. - - * gnus-cus.el (gnus-group-parameters): Typo. - -2003-07-31 Simon Josefsson - - * mml-sec.el (mml-signencrypt-style-alist): Use separate S/MIME - method by default (revert partial 2003-07-10 patch). - -2003-07-28 Dave Love - - * pgg-gpg.el, pgg-pgp.el, pgg-pgp5.el: Require cl when compiling. - -2003-07-26 Teodor Zlatanov - - * gnus-registry.el (gnus-registry-install): add an initial - registry read to the loading when gnus-registry-install is set - -2003-07-26 Mark Thomas (tiny change) - - * flow-fill.el (fill-flowed): Empty lines separate paragraphs - even if the preceding line ends with a soft break. - -2003-07-25 Teodor Zlatanov - - * spam.el (spam-use-regex-body, spam-regex-body-spam) - (spam-regex-body-ham): new variables, default to nil/empty/empty - (spam-install-hooks): added spam-use-regex-body to list or - pre-install conditions - (spam-list-of-checks): added spam-use-regex-body and - spam-check-regex-body to list of checks - (spam-list-of-statistical-checks): added spam-use-regex-body to - list of statistical checks - (spam-check-regex-body): invokes spam-check-regex-headers with - appropriate variable masking - (spam-check-regex-headers): changes to print "body" or "header" - where appropriate - -2003-07-25 Jesper Harder - - * smime.el (smime-ask-passphrase): Use read-passwd rather than - comint-read-noecho. The former is more secure. - -2003-07-24 Teodor Zlatanov - - * gnus-registry.el (gnus-registry-cache-whitespace): make "adding - whitespace" message level 5 instead of 4 - (gnus-registry-clean-empty-function): new function to remove empty - registry entries - (gnus-registry-clean-empty): new variable to enable cleaning the - registry when saving it by calling gnus-registry-clean-empty-function - - * spam.el (spam-summary-prepare-exit): use spam-process-ham-in-spam-groups - (spam-process-ham-in-spam-groups): new variable - -2003-07-24 Jesper Harder - - * pgg-gpg.el (pgg-gpg-process-region): Add "--yes" to options. - - * pgg-gpg.el, pgg-pgp.el, pgg-pgp5.el, pgg.el: Reapply changes - from 2003-04-03 to fix security problem. See - http://www.debian.org/security/2003/dsa-339 - -2003-07-23 Teodor Zlatanov - - * gnus.el (gnus-install-group-spam-parameters): add the - gnus-ticked-mark to the possible choices of ham marks - - * spam.el (spam-process-ham-in-nonham-groups): new variable - (spam-summary-prepare-exit): use spam-process-ham-in-nonham-groups - -2003-07-23 Jesper Harder - - * rfc2047.el (rfc2047-header-encoding-alist): Add Mail-Followup-To - and Mail-Copies-To to address-mime. - (rfc2047-narrow-to-field): Use rfc2047-point-at-bol. - -2003-07-19 Jesper Harder - - * mm-util.el (mm-coding-system-priorities): Docstring improvement. - -2003-07-17 Jesper Harder - - * gnus-sum.el (gnus-thread-latest-date): Move condition-case to - the right place. - -2003-07-14 Simon Josefsson - - * mail-source.el (mail-source-fetch-imap): Don't assume - imap-error-text returns something. - -2003-07-12 Nevin Kapur - - * nnimap.el (nnimap-request-newgroups): Use the pattern in - nnimap-list-pattern instead of "*". - -2003-07-10 Simon Josefsson - - * mml-sec.el (mml-signencrypt-style-alist): Use "combined" by - default. Improve docstring. - -2003-07-10 Kai Gro,A_(Bjohann - - * imap.el (imap-arrival-filter): Fix test for missing process - buffer. - -2003-07-09 Gaute B Strokkenes (tiny change) - - * imap.el (imap-wait-for-tag): Clarify comment. Use timeout zero - for second, after-process-has-died, accept-process-output. - (imap-arrival-filter): If PROC has no buffer, do nothing. - -2003-07-09 Jesper Harder - - * flow-fill.el: Docstring and message fixes. - - * deuglify.el: do. - - * gnus-int.el: do. - - * gnus-msg.el: do. - - * gnus-util.el: do. - - * gnus-draft.el: do. - - * gnus-start.el: do. - - * gnus.el: do. - - * gnus-group.el: do. - - * gnus-art.el: do. - - * gnus-sum.el: do. - - * mail-source.el (mail-source-movemail): Handle non-numerical - return values. - -2003-07-08 Jesper Harder - - * mailcap.el (mailcap-parse-args-syntax-table) - (mailcap-viewer-passes-test): Docstring fix. - - * mm-bodies.el (mm-long-lines-p): Docstring fix. - - * mm-decode.el (mm-w3m-safe-url-regexp, mm-verify-option) - (mm-decrypt-option, mm-handle-set-external-undisplayer) - (mm-file-name-replace-whitespace): Docstring fix. - - * mm-uu.el (mm-uu-emacs-sources-regexp): Docstring fix. - (mm-uu-pgp-signed-test): Fix message. - - * mml.el (mml-tweak-sexp-alist): Docstring fix. - (mml-parse-1, mml-insert-mime-headers): Fix message. - - * message.el (message-archive-header) - (message-subscribed-address-functions) - (message-subscribed-addresses, message-subscribed-regexps) - (message-canlock-generate) - (message-generate-new-buffer-clone-locals): Docstring fixes. - -2003-07-07 Gaute B Strokkenes (tiny change) - - * imap.el (imap-wait-for-tag): After the process has died, look - for more output still pending. - -2003-07-07 Teodor Zlatanov - - * spam.el (spam-bogofilter-score): redisplay article normally - after spam-bogofilter-score is called - -2003-07-06 Michael Piotrowski (tiny change) - - * gnus-sum.el (gnus-print-buffer): Apply emphasis. - -2003-07-06 Jesper Harder - - * message.el (message-send-mail-with-sendmail): Handle - non-numeric return values. - - * gnus-start.el (gnus-clear-system): Revert change from - 2003-06-19. - -2003-07-04 Dave Love - - * rfc2047.el (rfc2047-q-encode-region): Exclude especials from - characters not encoded, and make the list more legible. - -2003-07-04 Jesper Harder - - * message.el (message-make-from): Revert change from 2002-01-08. - -2003-06-29 Lars Magne Ingebrigtsen - - * nnheader.el (nnheader-init-server-buffer): Don't add - nntp-server-buffer to list of Gnus buffers. - -2003-06-25 Teodor Zlatanov - - * spam.el (spam-parse-list): prevent empty ("") strings - -2003-06-24 Teodor Zlatanov - - * spam.el (spam-parse-list): use gnus-extract-address-components - instead of ietf-drums-parse-addresses - (spam-from-listed-p): let* was unnecessary - -2003-06-24 Lars Magne Ingebrigtsen - - * gnus-ems.el (gnus-put-image): Mark the right text segment with - gnus-image-category. - - * gnus-srvr.el (gnus-browse-unsubscribe-group): Strip prefix from - native groups. - - * gnus-topic.el (gnus-group-prepare-topics): Update topic line - format specs. - - * gnus-picon.el: Written by moi, moi, moi. - - * gnus-group.el (gnus-group-kill-group): Clean up. - -2003-06-23 Teodor Zlatanov - - * spam.el (spam-from-listed-p, spam-parse-list): use - ietf-drums-parse-addresses to extract the address portion of the - whitelist/blacklist file if it looks like an address can be found - -2003-06-23 Didier Verna - - * gnus-ems.el (gnus-put-image): New argument CATEGORY. Add it as a - text property. - (gnus-remove-image): New argument CATEGORY. Only remove if - category matches. - * gnus-xmas.el (gnus-xmas-put-image): - (gnus-xmas-remove-image): Ditto, with extents. - * gnus-art.el (gnus-delete-images): Pass CATEGORY argument to - gnus-[xmas-]remove-image. - (article-display-face): Don't always act as a toggle. Call - `gnus-put-image' with CATEGORY argument. - (article-display-x-face): Call `gnus-put-image' with CATEGORY - argument. - * smiley.el (smiley-region): Ditto. - * gnus-fun.el (gnus-display-x-face-in-from): Ditto. - * gnus-picon.el (gnus-picon-insert-glyph): Ditto. - (gnus-treat-mail-picon): Don't always act as a toggle. - * gnus-picon.el (gnus-treat-newsgroups-picon): Ditto. - -2003-06-23 Didier Verna - - * gnus-art.el (article-display-face): Check for existence of the - original article buffer before switching to it. - -2003-06-20 Jesper Harder - - * mm-util.el (mm-append-to-file): Say "Appended to". Suggested by - Dan Jacobson . - - * mm-view.el (mm-inline-message): Bind - gnus-original-article-buffer to the buffer in the mml handle - holding the message. - -2003-06-20 Katsumi Yamaoka - - * message.el (sender, from): No need to bind them. - -2003-06-19 Teodor Zlatanov - - * spam.el (spam-enter-list): search-forward specified wrong - -2003-06-19 Lars Magne Ingebrigtsen - - * gnus-art.el: Comment fix. - -2003-06-20 Jesper Harder - - * spam.el (spam-spamoracle-learn): insert-string is obsolete. - -2003-06-20 Jan Rychter - - * gnus-msg.el (gnus-configure-posting-styles): Remove unused - variable. - -2003-06-19 Teodor Zlatanov - - * spam.el (spam-enter-list): do not enter duplicate addresses into - the whitelist/blacklist - -2003-06-19 Jesper Harder - - * nnheader.el (nnheader-init-server-buffer): Add - nntp-server-buffer to gnus-buffers. - - * gnus-start.el (gnus-clear-system): Now we don't need to kill - nntp-server-buffer separately. - -2003-06-18 Didier Verna - - * gnus-art.el (article-display-face): Correctly toggle between - display and hiding. Handle multiple Face headers. - -2003-06-17 Dave Love - - * nnimap.el: Require cl when compiling. - - * message.el (message-fix-before-sending): Reinstate nullifying - the invisible text property. - (sender, from): Defvar when compiling. - (message-is-yours-p): Remove autoload cookie. - -2003-06-17 Reiner Steib - - * gnus-util.el (gnus-extract-address-components): Added - doc-string. - -2003-06-16 Michael Albinus - - * nnml.el (nnml-current-group-article-to-file-alist): Don't read - overview when using compressed files. - -2003-06-16 Katsumi Yamaoka - - * gnus-sum.el (gnus-summary-refer-parent-article): Extract - Message-ID from In-Reply-To header. - -2003-06-16 Katsumi Yamaoka - - * message.el (message-is-yours-p): Narrow to head; extract from - and sender by itself. - (message-cancel-news, message-supersede): Remove useless things. - -2003-06-15 Reiner Steib - - * gnus-sum.el (gnus-summary-force-verify-and-decrypt): Bind - `gnus-article-emulate-mime'. - -2003-06-15 Tommi Vainikainen - - * message.el (message-is-yours-p): New function. Separated common - code from message-cancel-news and message-supersede. Added - matching code which uses message-alternative-emails regexp as last - resort. - (message-cancel-news, message-supersede): Use message-is-yours-p. - -2003-06-13 Niklas Morberg - - * nnimap.el (nnimap-split-articles): Narrow the right buffer to - the headers. - -2003-06-12 Dave Love - - * nnheader.el (nnheader-functionp): Deleted. - - * nnmail.el (nnmail-split-fancy-syntax-table): Define all in - defvar. - (nnmail-version): Deleted. - (nnmail-check-duplication, nnmail-expiry-target-group): Don't use - nnheader-functionp. - -2003-06-10 Teodor Zlatanov - - * spam.el (spam-check-bogofilter-headers): fix for when the score - is requested but the message is not spam - -2003-06-09 Eric Knauel - - * spam.el (spam-use-spamoracle): new variable - (spam-install-hooks): add spamoracle to the list of conditions - for activation of spam-install-hooks - (spam-spamoracle): new variable customization group - (spam-spamoracle, spam-spamoracle): new variables - (spam-group-spam-processor-spamoracle-p) - (spam-group-ham-processor-spamoracle-p): new functions - (spam-summary-prepare-exit): added spamoracle ham/spam exit processing - (spam-list-of-checks, spam-list-of-statistical-checks): add - spam-use-spamoracle - (spam-check-spamoracle, spam-spamoracle-learn) - (spam-spamoracle-learn-ham, spam-spamoracle-learn-spam): new functions - - * gnus.el (gnus-group-spam-exit-processor-spamoracle) - (gnus-group-ham-exit-processor-spamoracle): new variables for SpamOracle - (spam-process, ham-process): added spamoracle spam/ham processors - -2003-06-08 Jesper Harder - - * message.el (message-beginning-of-line): Docstring improvement. - Suggested by Michael R. Wolf - -2003-06-07 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-make-menu-bar): Removed ["Add buttons" - gnus-summary-display-buttonized t] - -2003-06-07 Kai Gro,A_(Bjohann - - * nnmail.el (nnmail-split-fancy-match-partial-words): Doc string - fix. Reported by Johan Bockg,Ae(Brd . - -2003-06-07 Jesper Harder - - * message.el (message-beginning-of-line): Docstring improvement. - -2003-06-06 Jesper Harder - - * gnus-srvr.el (gnus-browse-foreign-server): Parse garbage NNTP - groups correctly. - -2003-06-06 Benjamin Rutt . - - * message.el (message-fetch-field): Augment documentation to state - the narrowed-to-headers restriction. - (message-change-subject, message-reduce-to-to-cc) - (message-generate-unsubscribed-mail-followup-to) - (message-insert-importance-high, message-insert-importance-low) - (message-insert-or-toggle-importance) - (message-insert-disposition-notification-to): Narrow to headers - before calling message-fetch-field or message-remove-header. - -2003-06-06 Teodor Zlatanov - - * gnus-registry.el (gnus-registry-trim): fix for when - gnus-registry-max-entries is nil - -2003-06-05 Lars Magne Ingebrigtsen - - * qp.el (quoted-printable-decode-region): Don't error out on - malformed text. - -2003-06-04 Lars Magne Ingebrigtsen - - * rfc2047.el (rfc2047-encode-region): Don't error out on invalid - strings. - -2003-06-04 Ivan Boldyrev (tiny change) - - * mml1991.el (mml1991-pgg-sign): Insert pgg output as unibyte. - -2003-06-03 Dave Love - - * gnus-soup.el (gnus-soup-send-packet): Don't use - message-functionp. - - * gnus.el (gnus-agent-cache): Doc fix. - (gnus-other-frame): Quote lambda used as hook. - - * message.el: Doc fixes. - (message-functionp): Deleted. Callers changed. - (message-fix-before-sending): Highlight with overlays. Clarify - `illegible text' messages. - (rmail-enable-mime-composing, gnus-message-group-art): Defvar when - compiling. - (gnus-find-method-for-group, nnvirtual-find-group-art): Autoload. - -2003-06-03 Kai Gro,A_(Bjohann - - * nnmail.el (nnmail-split-fancy-match-partial-words): New user - option. - (nnmail-split-it): Obey it. Don't let-bind regexp twice. - - * message.el (message-fetch-field): Mention narrow-to-headers - requirement. - -2003-06-03 Eric Eide - - * gnus-xmas.el (gnus-xmas-create-image): Use - insert-file-contents-literally. - -2003-06-02 Teodor Zlatanov - - * gnus-registry.el (gnus-registry-fetch-group): always return the - short name of the group - -2003-06-02 Jesper Harder - - * gnus-cus.el (defvar): Silence byte-compiler warnings. - - * gnus-sum.el (gnus-get-newsgroup-headers): Unfold headers. - -2003-05-31 Jesper Harder - - * gnus-art.el (article-unsplit-urls): Use gnus-treat-article - rather than gnus-display-mime-function. - -2003-05-30 Teodor Zlatanov - - * gnus-registry.el (gnus-registry-use-long-group-names): new variable - (gnus-registry-add-group): use it - (gnus-registry-trim-articles-without-groups): new variable - (gnus-registry-delete-group): use it - (gnus-registry-unload-hook): uninstall all the hooks - - * spam.el (spam-install-hooks-function, spam-unload-hook): new - functions so users that load spam.el for customization don't get - all the hooks installed - (spam-install-hooks): new variable, set to t by default if user - has one of the spam-use-* variables set - - * spam-stat.el (spam-stat-install-hooks, spam-stat-unload-hook): new - functions so users that load spam-stat.el for customization don't get - all the hooks installed - -2003-05-30 Dave Love - - * rfc2047.el (rfc2047-decode): Don't use - mm-with-unibyte-current-buffer. - - * qp.el (quoted-printable-decode-string): Use - mm-with-unibyte-buffer. - -2003-05-29 Teodor Zlatanov - - * gnus-registry.el (gnus-registry-save): allow forced saving even - when registry is not dirty. Use gnus-registry-trim to shorten the - gnus-registry-alist. - (gnus-registry-max-entries): new variable - (gnus-registry-trim): new function, trim gnus-registry-alist to - size gnus-registry-max-entries, sorting by entry mtime so the - newest entries stick around - - * gnus-start.el (gnus-gnus-to-quick-newsrc-format): instead of - just one specific variable, allow a list of specific variables - -2003-05-28 Dave Love - - * rfc2047.el (rfc2047-encode-region): Skip ASCII at beginning and - end of region. - -2003-05-28 Jesper Harder - - * lpath.el: Add put-char-table and get-char-table. - -2003-05-28 Teodor Zlatanov - - * gnus-registry.el (gnus-registry-dirty): flag for modified registry - (gnus-registry-save, gnus-registry-read) - (gnus-registry-store-extra, gnus-registry-clear): use it (note - that gnus-registry-store-extra is invoked for all modifications to - set the mtime, so gnus-registry-dirty only needs to be set there) - -2003-05-23 Simon Josefsson - - * mml1991.el (mml1991-pgg-sign): Use mml-sender instead of - message-sender. - - * gnus-art.el (gnus-use-idna): Check if idna-program is installed. - - * message.el (message-use-idna): Ditto. - -2003-05-20 Dave Love - - * rfc2047.el (rfc2047-q-encoding-alist): Deleted. - (rfc2047-q-encode-region): Don't use it. - (rfc2047-encode-message-header) <(eq method 'mime)>: Bind - rfc2047-encoding-type to `mime'. - (rfc2047-encode-string, rfc2047-encode): Doc fix. - -2003-05-20 Jesper Harder - - * message.el (message-send-mail): Don't insert a courtesy copy - notice in base64 encoded messages. - -2003-05-16 Katsumi Yamaoka - - * gnus-sum.el (gnus-summary-move-article): Don't copy expirable - marks if the destination group is not auto-expirable. - -2003-05-14 Katsumi Yamaoka - - * dgnushack.el (assq-delete-all): Removed the compiler macro. - -2003-05-14 Kevin Greiner - - * gnus-agent.el (gnus-agentize): Updated documentation to match - usage. - (gnus-agent-expire-group-1): Do not skip over a group when the - force argument is set. - * gnus.el (gnus-agent): Updated documentation to reflect that - gnus-agent now defaults to t. - -2003-05-14 Lars Magne Ingebrigtsen - - * gnus.el (gnus-version-number): Bump. - -2003-05-14 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.10.2 is released. - -2003-05-14 Lars Magne Ingebrigtsen - - * mail-source.el (mail-source-delete-incoming): Changed to t. - - * rfc2047.el (rfc2047-syntax-table): Funcall. - - * lpath.el ((featurep 'xemacs)): Added set-char-table-range. - ((featurep 'xemacs)): No, don't. - - * rfc2047.el (rfc2047-encodable-p): Use the header charset. - - * gnus-sum.el (gnus-summary-reselect-current-group): Supply - leave-hidden. - -2003-05-14 Jonathan Kamens - - * gnus-sum.el (gnus-summary-exit): Added `leave-hidden'. (Tiny - patch.) - -2003-05-13 Lars Magne Ingebrigtsen - - * gnus-registry.el (gnus-registry-store-extra-entry): Use - gnus-assq-delete-all. - - * gnus-xmas.el (gnus-xmas-assq-delete-all): New function. - - * message.el (message-ignored-bounced-headers): Add Delivered-To. - - * gnus-sum.el (gnus-summary-find-next): Indent. - (gnus-summary-find-prev): Ditto. - (gnus-summary-catchup): Doc fix. - (gnus-summary-mark-current-read-and-unread-as-read): New function. - (gnus-summary-catchup): Really mark after point. - - * gnus-util.el (gnus-user-date): Use %d instead of %m. - (gnus-user-date): Use floating point time so that we don't get - overflows. - - * gnus-sum.el (gnus-summary-local-variables): Clean up. - - * gnus-fun.el (gnus-display-x-face-in-from): Don't use centering - since none of the other image things do. - -2003-05-13 Katsumi Yamaoka - - * dgnushack.el (assq-delete-all): New compiler macro for Emacs 20. - -2003-05-12 Katsumi Yamaoka - - * lpath.el: Fbind find-coding-system. - - * dgnushack.el (dgnushack-make-load): Remove redundant format call - in message. Suggested by Yoichi NAKAYAMA . - * pop3.el (pop3-movemail): Ditto. - -2003-05-12 Colin Marquardt (tiny change) - - * gnus.el (gnus-agent): Docstring fix. - -2003-05-12 Teodor Zlatanov - - * gnus-registry.el (gnus-registry-install): new variable - (gnus-registry-fetch-extra, gnus-registry-fetch-extra-entry) - (gnus-registry-store-extra-entry, gnus-registry-delete-group) - (gnus-registry-add-group): add a modification timestamp to each entry - (gnus-registry-install-hooks): new function - -2003-05-12 Kevin Greiner - - * gnus-agent.el (gnus-agent-cat-name): Eval macro while compiling. - (gnus-agent-cat-disable-undownloaded-faces): New function. - Accessor for new agent property - 'agent-disable-undownloaded-faces'. - gnus-cus.el (gnus-agent-parameters): Added - agent-disable-undownloaded-faces and corrected documentation. - (gnus-agent-cat-prepare-category-field, - gnus-agent-customize-category): Changed to avoid creating free - references to each field's symbol. - gnus-sum.el (gnus-summary-use-undownloaded-faces): New local variable. - (gnus-select-newgroup): Initialize it. - (gnus-summary-highlight-line): Use it. - -2003-05-12 Dave Love - - * mm-util.el (mm-read-charset): Deleted. - (mm-coding-system-mime-charset): New. - (mm-read-coding-system, mm-mule-charset-to-mime-charset) - (mm-charset-to-coding-system, mm-mime-charset) - (mm-find-mime-charset-region): Use it. - (mm-default-multibyte-p): Fix non-mule case. - - * rfc2047.el (rfc2047-point-at-bol, rfc2047-point-at-bol): Eval - and compile. - (rfc2047-syntax-table): Fix building table to work in Emacs 22. - (rfc2047-unfold-region): Delete unused var `leading'. - -2003-05-12 Ville Skytt,Ad(B (tiny change) - - * pgg.el (pgg-temp-buffer-show-function): Reuse existing visible - output window if one is available. - -2003-05-11 Lars Magne Ingebrigtsen - - * gnus-agent.el (gnus-agent-expire-unagentized-dirs): Added - space. - -2003-05-11 Jesper Harder - - * gnus-sum.el (gnus-summary-enter-digest-group): Don't do article - washing etc. - (gnus-handle-ephemeral-exit): Don't reload article after exiting. - - * nndoc.el (nndoc-type-alist): `mime-digest' should be before - `mime-parts'. - -2003-05-10 Jesper Harder - - * gnus-cite.el (gnus-article-hide-citation-maybe): Make toggling - work. Update mode-line. - -2003-05-10 Lars Magne Ingebrigtsen - - * gnus.el (gnus-logo-color-alist): Added no colours. - -2003-05-09 Dave Love - - * utf7.el (mm-util): Require. - (utf7-direct-encoding-chars, utf7-imap-direct-encoding-chars): - Defconst, not defvar. - (utf7-utf-16-coding-system): New. - (utf7-encode-internal): Hoist concat out of loop. - (utf7-fragment-encode): Use mm-with-unibyte-current-buffer. - (utf7-get-u16char-converter) [utf7-utf-16-coding-system]: New - case. - (utf7-latin1-u16-char-converter): Encode the region. - (utf7-u16-latin1-char-converter): Decode the region. - (utf7-encode, utf7-decode): Fix multibyteness. - - * mm-bodies.el (mm-body-7-or-8): Don't special-case mule. - (mm-encode-body): Use mm-read-coding-system, not mm-read-charset. - (mm-uu-yenc-decode-function): Defvar when compiling. - (mm-encode-body, mm-decode-body): Doc fix. - -2003-05-09 Teodor Zlatanov - - * gnus-registry.el (gnus-registry-unregistered-group-regex): - removed in favor of the group/topic/global variables - (gnus-registry-register-message-ids): fixed test to omit - gnus-registry-unregistered-group-regex - - * gnus.el (gnus-variable-list): removed gnus-registry-alist and - gnus-registry-headers-alist from the list - (gnus-registry-headers-alist): removed - (registry-ignore): new parameter, with accompanying - gnus-registry-ignored-groups global variable - - * gnus-start.el (gnus-clear-system): no need to clear the - registry, we can do it ourselves - (gnus-gnus-to-quick-newsrc-format): extra parameters so it can be - used by gnus-registry.el - - * gnus-registry.el (gnus-registry-cache-file): new file variable - (gnus-registry-cache-read, gnus-registry-cache-save): new - functions - (gnus-registry-save, gnus-registry-read): use the new - gnus-registry-cache-{read|save} functions, and change the name - from gnus-registry-translate-{from|to}-alist - (gnus-registry-clear): fixed so it doesn't refer to old function name - -2003-05-09 Dan Christensen - - * gnus-registry.el (gnus-registry-cache-whitespace): new function. - -2003-05-09 Jesper Harder - - * gnus-picon.el (gnus-picon-transform-address): Parse the encoded - address. - -2003-05-08 Teodor Zlatanov - - * gnus-start.el (gnus-clear-system): added gnus-registry-alist to - the list of cleared variables - - * gnus-registry.el (gnus-registry-split-fancy-with-parent): - nnmail-split-fancy-with-parent-ignore-groups can be a single regex - in addition to a list of regexes. - -2003-05-08 Niklas Morberg - - * spam.el (spam-use-regex-headers): docstring fix. - -2003-05-08 Kai Gro,A_(Bjohann - - * gnus-sum.el (gnus-summary-next-page): Mention - `gnus-article-skip-boring' in docstring. - -2003-05-08 Jesper Harder - - * rfc2231.el (rfc2231-parse-string): "=" should have whitespace - syntax here. - - * ietf-drums.el (ietf-drums-syntax-table): "=" should not have - whitespace syntax class when parsing email addresses. - - * message.el (message-forward-subject-name-subject): Don't use - mail-decode-encoded-word-string before parsing from. - -2003-05-07 ShengHuo ZHU - - * message.el (message-setup-1): Setup alternative email before - generate-headers. - - (message-forward-subject-name-subject): Fix the case when the - field "from" doesn't exist. - -2003-05-07 Dave Love - - * rfc2047.el (rfc2047-encode-region): Skip \n as whitespace. - - * mm-util.el (mm-find-mime-charset-region): Expurgate utf-16 from - possible values. - -2003-05-07 Jesper Harder - - * message.el (message-kill-to-signature): Fix. - -2003-05-06 Jesper Harder - - * gnus-sum.el (gnus-auto-goto-ignores): Docstring fix. - - * gnus-art.el (gnus-mime-display-multipart-as-mixed) - (gnus-mime-display-multipart-related-as-mixed) - (gnus-button-mid-or-mail-heuristic-alist): do. - -2003-05-05 Dave Love - - * mm-util.el (mm-default-multibyte-p): New. - (mm-coding-system-p): Maybe use find-coding-systems. - -2003-05-04 Dave Love - - * rfc2047.el (with-syntax-table): Define if necessary. - (rfc2047-syntax-table): Fix last change for XEmacs. - (rfc2047-parse-and-decode): Revert last change. - -2003-05-03 Jesper Harder - - * gnus.el: Don't test for `mm-guess-mime-charset'. - - * mm-util.el (mm-guess-mime-charset): Remove. Not used any more. - - * gnus.el (gnus-default-charset): Set default value to - `undecided'. - - * gnus-art.el (article-decode-charset): Don't supply 4th arg to - mm-decode-body. - - * mm-bodies.el (mm-decode-coding-region-safely): Remove. - (mm-decode-body): Don't use mm-decode-coding-region-safely. - -2003-05-03 Vasily Korytov (tiny change) - - * gnus-util.el (gnus-multiple-choice): Add ", ?". - -2003-05-03 Dave Love - - * rfc2047.el (rfc2047-syntax-table): Don't call make-char-table - with 2 args. - (rfc2047-decode-string): Don't set the buffer multibyte before - calling buffer-string. - - * mm-encode.el (mm-long-lines-p): Autoload. - (mm-encode-content-transfer-encoding): Doc fix. Don't make buffer - unibyte. Signal error on unknown encoding. - (mm-encode-buffer, mm-qp-or-base64): Doc fix. - - * rfc2047.el (rfc2047-point-at-bol, rfc2047-point-at-eol): New. - Callers of gnus- versions changed to use them. - (rfc2047-header-encoding-alist): Add `address-mime' part. Doc - fixes. - (rfc2047-encoding-type): New. - (rfc2047-encode-message-header): Use mm-charset-to-coding-system. - Don't include header name field in encoding. Add `address-mime' - case and bind rfc2047-encoding-type for `mime' case. - (rfc2047-encodable-p): Deleted. - (rfc2047-syntax-table): New. - (rfc2047-encode-region, rfc2047-encode): Rewritten to take account - of rfc2047 rules with respect to rfc2822 tokens and to do encoding - in place rather than by passing strings. - (rfc2047-encode-string): Doc fix. - (rfc2047-q-encode-region): Don't use - mm-with-unibyte-current-buffer. - (rfc2047-encoded-word-regexp): eval-and-compile. - (rfc2047-decode-region): Avoid concatenation in loop. - (rfc2047-parse-and-decode): Remove useless disjunction. - -2003-05-02 Dave Love - - * rfc2047.el (rfc2047-q-encode-region, rfc2047-decode): Use - mm-with-unibyte-current-buffer. - (ietf-drums, gnus-util): don't require. - - * sieve.el (sieve-manage-mode-menu): Define before use. - - * mml-smime.el (message-narrow-to-headers): Autoload. - - * mm-util.el (mm-coding-system-p): Don't override nil from - coding-system-p. - (mm-mule4-p, mm-disable-multibyte-mule4) - (mm-with-unibyte-current-buffer-mule4): Deleted. - (mm-multibyte-p): Use defun, not defalias. - (mm-make-temp-file): Moved to group at top of file. - (mm-point-at-eol, mm-point-at-bol): New. - - * gnus-cite.el (gnus-art): Require. - - * gnus-ems.el (gnus-get-buffer-create) - (nnheader-find-etc-directory, message-text-with-property): - Autoload. - (gnus-tmp-unread, gnus-tmp-replied, gnus-tmp-score-char) - (gnus-tmp-indentation, gnus-tmp-opening-bracket, gnus-tmp-lines) - (gnus-tmp-name, gnus-tmp-closing-bracket, gnus-tmp-subject-or-nil) - (gnus-check-before-posting): Only defvar when compiling. - - * gnus-int.el (gnus-agent-expire): Autoload, don't defun. - - * gnus-util.el (rmail-default-rmail-file, mm-text-coding-system): - Defvar when compiling. - (gnus-output-to-rmail): Require mm-util. - - * mail-source.el (mail-source-callback): Use mm-make-temp-file. - (mail-source-make-complex-temp-name): Deleted. - - * message.el (message-use-idna): Use mm-coding-system-p. - (message-tokenize-header, message-make-organization) - (message-make-from): Use with-temp-buffer. - (message-set-work-buffer): Deleted. - (message-fill-paragraph): Use `if' not `and' for compiler warning. - (message-check-news-header-syntax): Remove useless lambda. - (message-forward-make-body): Use mm-disable-multibyte, - mm-with-unibyte-current-buffer, mm-enable-multibyte. - (message-replace-chars-in-string): Deleted. - - * mm-extern.el (mm-extern-local-file): Use mm-disable-multibyte. - (mm-extern-url): Use mm-with-unibyte-current-buffer, - mm-disable-multibyte. - (mm-extern-anon-ftp): Use mm-disable-multibyte. - - * mml1991.el (mml1991-mailcrypt-encrypt, mml1991-gpg-encrypt): Use - mm-with-unibyte-current-buffer. - - * mml2015.el (mml): Require. - (mml2015-mailcrypt-encrypt, mml2015-gpg-encrypt): Use - mm-with-unibyte-current-buffer. - - * nnheader.el (gnus-util): Require. - - * nntp.el (format-spec, format-spec-make, open-tls-stream): - Autoload. - - * rfc2231.el (mail-header-remove-comments, mm-encode-body) - (mail-header-remove-whitespace): Autoload. - - * sieve-manage.el (starttls-negotiate): Autoload. - -2003-05-01 Lars Magne Ingebrigtsen - - * nnrss.el (nnrss-find-rss-via-syndic8): Indent. - -2003-05-01 Mark A. Hershberger - - * nnrss.el (nnrss-find-rss-via-syndic8): Don't error out. - -2003-05-01 Lars Magne Ingebrigtsen - - * gnus.el (gnus-version-number): Bump. - -2003-05-01 Jon Ericson (tiny change) - - * spam-report.el (spam-report-gmane-regex): docstring fix. - - * gnus.el (gnus-install-group-spam-parameters): docstring fix. - -2003-05-01 Teodor Zlatanov - - * gnus-registry.el (gnus-registry-fetch-extra) - (gnus-registry-store-extra, gnus-registry-group-count): new functions - (gnus-registry-fetch-group, gnus-registry-delete-group) - (gnus-registry-add-group): changed to work with extra data element - if present - -2003-05-01 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.10.1 is released. - -2003-05-01 Lars Magne Ingebrigtsen - - * gnus.el: Oort Gnus v0.24 is released. - -2003-05-01 Lars Magne Ingebrigtsen - - * dgnushack.el (when): Check whether defadvice is fbound. - -2003-05-01 Teodor Zlatanov - - * gnus-registry.el (gnus-registry-unregistered-group-regex): new variable - (gnus-registry-register-message-ids): use it - -2003-05-01 Lars Magne Ingebrigtsen - - * gnus.el (gnus-version-number): Bump. - - * gnus.el: Update copyright for several files. - -2003-05-01 Lars Magne Ingebrigtsen - - * gnus.el: Oort Gnus v0.23 is released. - -2003-05-01 Lars Magne Ingebrigtsen - - * spam-stat.el (spam-stat-test-directory): Compare against zero. - -2003-05-01 Trey Jackson (tiny change) - - * spam-stat.el (spam-stat-test-directory): Skip 0 length files. - -2003-05-01 Lars Magne Ingebrigtsen - - * message.el (message-forward-subject-name-subject): Decode - string when forwarding. - -2003-05-01 Oystein Viggen - - * dgnushack.el (when): Add defadvice. - -2003-05-01 Lars Magne Ingebrigtsen - - * gnus.el (gnus-version-number): Bump. - -2003-05-01 Lars Magne Ingebrigtsen - - * gnus.el: Oort Gnus v0.22 is released. - -2003-05-01 Lars Magne Ingebrigtsen - - * gnus.el: Oort Gnus v0.21 is released. - -2003-05-01 Lars Magne Ingebrigtsen - - * gnus.el (gnus-version-number): Bump. - -2003-05-01 Lars Magne Ingebrigtsen - - * gnus.el: Oort Gnus v0.20 is released. - -2003-05-01 Vasily Korytov - - * gnus-dired.el (gnus-dired-mode-map): Move to C-c C-l. - -2003-04-30 Mark A. Hershberger - - * mm-url.el (mm-url-insert-file-contents): set url-current-object - in the case where mm-url-use-external is set. - - * nnrss.el (nnrss-request-article): Change the messages created to - multipart/alternative. Hopefully fixes a problem interaction with - w3m. - (nnrss-find-rss-via-syndic8): Better handling if xml-rpc.el isn't - around. - -2003-05-01 Lars Magne Ingebrigtsen - - * message.el (message-check-news-header-syntax): Alter "posting" - message. - - * nnrss.el (nnrss-node-text): Don't use char classes. - -2003-05-01 David Z. Maze - - * nnrss.el (nnrss-find-rss-via-syndic8): Have an `error' branch - in condition-case. - -2003-05-01 Lars Magne Ingebrigtsen - - * message.el (message-required-headers): Remove In-Reply-To. - - * gnus-int.el (gnus-open-server): Revert changes. - -2003-04-30 Kai Gro,A_(Bjohann - - * gnus-int.el (gnus-open-server): Try to open unagentized servers - even when unplugged. - -2003-04-30 Reiner Steib - - * gnus-art.el (gnus-button-prefer-mid-or-mail): Fixed typo in - doc-string. - -2003-05-01 Steve Youngs - - * lpath.el: Add a section for non-Mule XEmacsen. - fbind `find-charset-string' and `coding-system-base' in that - section. - - * gnus-util.el (gnus-completing-read-maybe-default): New. - (gnus-completing-read): Use it. - - * mm-view.el (mm-view-pkcs7-decrypt): Ditto. - - * gnus-art.el (gnus-read-string): New. - (gnus-summary-pipe-to-muttprint): Use it. - - * gnus-xmas.el (gnus-xmas-open-network-stream): New. - - * dns.el (dns-make-network-process): Use it. - - Take care of some differences between XEmacs 21.1 and newer - versions of XEmacs. - -2003-04-30 Teodor Zlatanov - - * gnus-registry.el (gnus-registry-split-fancy-with-parent): added - diagnostic message - (gnus-registry-grep-in-list): don't run when word is nil - (gnus-registry-fetch-message-id-fast): new function - (gnus-registry-delete-group, gnus-registry-add-group): make sure - the id and group are not nil - (gnus-registry-register-message-ids): new function - (gnus-register-action): optimized logical flow - (gnus-summary-prepare-hook): added gnus-registry-register-message-ids - -2003-04-30 Kai Gro,A_(Bjohann - - * gnus-delay.el (gnus-delay-article): Call - `gnus-agent-queue-setup' to create the delay group. - - * gnus-agent.el (gnus-agent-queue-setup): Support optional arg - for the (queue) group name. - -2003-04-30 Simon Josefsson - - * mm-util.el (mm-charset-to-coding-system): Use user specified - charset unless coding-system-get is fboundp. - -2003-04-30 Kevin Greiner - - * gnus-agent.el (gnus-agent-cat-defaccessor, gnus-agent-cat-name): - Wrapped in eval-when-compile. - (gnus-agent-mode): Bind gnus-agent-go-online to nil as you - shouldn't be asked twice to go online with each server. - (gnus-agent-get-undownloaded-list, gnus-agent-fetch-articles, - gnus-agent-crosspost, gnus-agent-flush-cache, - gnus-agent-fetch-session, gnus-agent-unread-articles, - gnus-agent-uncached-articles, gnus-agent-regenerate-group, - gnus-agent-group-covered-p): Expanded pop macros used for - effect. Avoids compilation warning in emacs 21.3. - - * gnus-int.el (gnus-open-server): Restructured to only open - nnagent when gnus-plugged is nil. - -2003-04-30 Katsumi Yamaoka - - * lpath.el: Fbind string-to-multibyte. - -2003-04-30 Steve Youngs - - * dgnushack.el: Add some missing autoloads for XEmacs 21.1. - -2003-04-29 Teodor Zlatanov - - * gnus-registry.el (gnus-registry-fetch-group): faster - (gnus-registry-delete-group): new function - (gnus-registry-add-group): new function - (gnus-register-spool-action): use it - (gnus-register-action): use it - (gnus-registry-translate-from-alist) - (gnus-registry-translate-to-alist): remove the headers registry - for now - -2003-04-29 Reiner Steib - - * gnus-art.el (gnus-button-alist): Fixed CTAN regexp. - -2003-04-29 Teodor Zlatanov - - * spam-report.el (spam-report-gmane): gnus-summary-article-number - is not necessary, just use the function parameter - -2003-04-29 Karl Pfl,Ad(Bsterer - - * spam-stat.el (spam-stat-save): No longer font-locks the file - when saving - -2003-04-29 Katsumi Yamaoka - - * canlock.el: Bind mail-header-separator when compiling (XEmacs - provides it in mail-lib/auto-autoloads.el). - -2003-04-29 Simon Josefsson - - * mml2015.el (mml2015-pgg-sign): Use mml-sender instead of - message-sender. - - * mml.el (mml-generate-mime-1): Set mml-sender too. - -2003-04-29 Jesper Harder - - * gnus-sum.el (gnus-summary-display-while-building): Docstring fix. - - * mm-url.el (mm-url-use-external): do. - -2003-04-29 Simon Josefsson - - * canlock.el (mail-fetch-field): Autoload it (fix xemacs compile - warnings). - - * sieve-mode.el (c-mode): Ditto. - - * pgg.el (run-at-time): Ditto. - - * mm-url.el (require): Require timer when compiling for - with-timeout macro (fix xemacs compile warnings). - -2003-04-28 Dave Love - - * gnus-util.el (nnheader): Don't require. - (Nnheader-narrow-to-headers, nnheader-replace-chars-in-string): - Autoload. - - * spam.el: Require cl when compiling. - - * dns.el: Require cl when compiling. - -2003-04-28 Jesper Harder - - * gnus-art.el (gnus-article-goto-next-page) - (gnus-article-goto-prev-page): Revert 2003-02-12 change to make - gnus-pick-mode work. - -2003-04-28 Steve Youngs - - * Makefile.in (FLAGS): Use @FLAGS@. - -2003-04-27 Reiner Steib - - * gnus-art.el (gnus-mime-display-multipart-as-mixed) - (gnus-mime-display-multipart-alternative-as-mixed) - (gnus-mime-display-multipart-related-as-mixed): Added doc-strings, - allow customization. - -2003-04-27 Kevin Greiner - - * dgnushack.el (dgnushack-compile-verbosely): New function. Not - currently called (See source for explanation). - -2003-04-27 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-catchup): Don't mark ticked messages. - (gnus-summary-mark-read-and-unread-as-read): Take an optional - mark. - - * gnus.el (gnus-version-number): Bump. - -2003-04-27 06:47:31 Lars Magne Ingebrigtsen - - * gnus.el: Oort Gnus v0.19 is released. - -2003-04-27 Kevin Greiner - - * gnus-registry.el (gnus-register-spool-action): Replaced literal - carriage-return character with its escape sequence. - -2003-04-27 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-catchup-from-here): Doc fix. - - * nnrss.el (nnrss-node-text): Use only one - gnus-replace-in-string. - - * gnus.el: Remove gnus-functionp throughout. - - * gnus-util.el (gnus-functionp): Removed. - - * gnus-msg.el (gnus-summary-wide-reply-with-original): Doc fix. - - * message.el (message-required-headers): Add In-Reply-To. - -2003-04-27 Marshall T. Vandegrift - - * gnus-fun.el (gnus-face-from-file): Bind coding-system-for-read - to binary. - -2003-04-27 Jesper Harder - - * mml.el (mml-preview): do. - - * message.el (message-mode): do. - - * gnus-undo.el (gnus-undo-mode): do. - - * gnus-topic.el (gnus-topic-mode): do. - - * gnus-sum.el (gnus-summary-mode, gnus-summary-edit-article): do. - - * gnus-msg.el (gnus-setup-message) - (gnus-inews-add-send-actions, gnus-configure-posting-styles): do. - - * gnus-gl.el (gnus-grouplens-mode): do. - - * gnus-art.el (gnus-mime-save-part-and-strip) - (gnus-mime-delete-part): Use it. - - * gnus-util.el (gnus-make-local-hook): New function. - -2003-04-25 Simon Josefsson - - * nnrss.el (nnrss-node-text): Don't use a star. - (nnrss-node-text): Use g-r-i-s, not g-r-r-i-s which doesn't exist. - -2003-04-24 Dave Love - - * mm-encode.el (mm-long-lines-p): Autoload. - (mm-encode-content-transfer-encoding): Don't try to make buffer - unibyte before decoding. Don't ignore errors for base64 encoding. - - * qp.el (quoted-printable-decode-region): Use mm-insert-byte. - Signal error on malformed text, as for base64. - (quoted-printable-encode-region): DTRT in Emacs 22. - - * mm-util.el (mm-make-temp-file, mm-insert-byte): New. - (mm-auto-save-coding-system): Consider utf-8-emacs. - (mm-mime-mule-charset-alist, mm-mule-charset-to-mime-charset) - (mm-charset-to-coding-system, mm-mime-charset) - (mm-find-mime-charset-region): Check for :mime-charset coding - systems property. - - * mml-sec.el (mml2015, mml1991): Don't require. - (mml2015-sign, mml2015-encrypt, mml1991-sign, mml1991-encrypt) - (message-goto-body, mml-insert-tag): Autoload. - - * mm-decode.el (mm-tmp-directory): Re-write to help avoid warnings. - - * gnus-start.el (message-make-date): Autoload rather than - requiring message. - - * gnus-group.el (gnus-group-name-charset-group-alist): Use - mm-coding-system-p. - (gnus-cache-active-altered): Defvar when compiling. - (gnus-group-delete-group): Re-write to help avoid warnings. - - * gnus-art.el (gnus-use-idna): Use mm-coding-system-p. - - * pgg.el: Split eval-when-compile forms. - -2003-04-24 Reiner Steib - - * gnus-group.el (gnus-large-ephemeral-newsgroup) - (gnus-fetch-old-ephemeral-headers): News variables. - (gnus-group-read-ephemeral-group): Use them. - -2003-04-24 Simon Josefsson - - * sieve.el (sieve-upload): Don't use replace-regexp-in-string. - - * nnrss.el (nnrss-node-text): Ditto. - -2003-04-24 Katsumi Yamaoka - - * gnus-msg.el (gnus-inews-do-gcc): Make sure the obsolete variable - gnus-inews-mark-gcc-as-read exists. - -2003-04-23 Simon Josefsson - - * gnus-sieve.el (gnus-sieve-generate): Rewrite regexp search so it - doesn't exceed the regexp stack space. - -2003-04-23 Jesper Harder - - * gnus-msg.el (gnus-inews-mark-gcc-as-read): Don't defvar it. - - * gnus-art.el (gnus-article-hide-pgp-hook): do. - -2003-04-23 Reiner Steib - - * mml.el (mml-preview): Bind `=', RET, and mouse-2. - -2003-04-23 Jesper Harder - - * mm-bodies.el (mm-decode-body): Don't override supplied charset. - -2003-04-23 Katsumi Yamaoka - - * dgnushack.el (merge, copy-list): Remove compiler macros. - (butlast): Add a compiler macro. - -2003-04-22 Paul Jarc - - * gnus-util.el (gnus-merge): Added "type" argument to match CL - merge and gnus-sum.el's expectations. - -2003-04-21 Reiner Steib - - * gnus-art.el (gnus-button-url-regexp): Added nntp. - - * message.el (message-generate-headers-first): Default to - '(references). - - * gnus-art.el (gnus-mime-delete-part): Require confirmation. - -2003-04-21 Jesper Harder - - * smime.el (smime-decrypt-region): Insert From header. - -2003-04-21 Gaute B Strokkenes (tiny change) - - * gnus-fun.el (gnus-face-from-file, gnus-convert-png-to-face): - Max length of header is 726, not 740. - -2003-04-20 Jesper Harder - - * nndb.el, mml1991.el: Fix license template. - -2003-04-20 Simon Josefsson - - * nnimap.el (nnimap-split-articles): Don't download body unless - required. - - * imap.el (imap-gssapi-open, imap-ssl-open): Erase buffer before - starting process, like imap-kerberos4-open does. - - * mml-smime.el, rfc1843.el, dig.el, smime.el, uudecode.el: Fix - license template. - - * mml-sec.el: Fix license template. - - * gnus-sieve.el, sieve.el, sieve-manage.el, sieve-mode.el: Fix - license template. - - * pgg-def.el, pgg.el, pgg-gpg.el, pgg-parse.el, pgg-pgp5.el, - pgg-pgp.el: Fix license template. - -2003-04-19 Jesper Harder - - * gnus-sum.el (gnus-summary-delete-article): Improve docstring. - -2003-04-19 Teodor Zlatanov - - * spam.el (spam-move-spam-nonspam-groups-only): dumb typo fix - -2003-04-18 Teodor Zlatanov - - * spam.el (spam-split): allow a particular check as a parameter, - e.g. (: spam-split 'spam-use-bogofilter) - (spam-mark-only-unseen-as-spam): new parameter, see doc - (spam-mark-junk-as-spam-routine): use - spam-mark-only-unseen-as-spam, simplify routine to take advantage - of gnus-newsgroup-unread as well as gnus-newsgroup-unseen - -2003-04-17 Teodor Zlatanov - - * gnus.el (gnus-group-short-name, gnus-group-prefixed-p): new functions - (gnus-group-guess-full-name): don't prefix the group twice - - * nnmail.el (nnmail-split-fancy-with-parent): docstring fix - - * gnus-registry.el (gnus-registry-clear) - (gnus-registry-fetch-group, gnus-registry-grep-in-list) - (gnus-registry-split-fancy-with-parent): new functions - (gnus-register-spool-action, gnus-register-action): simplified the format - (gnus-registry): new customization group - (gnus-registry-unfollowed-groups): new variable - -2003-04-17 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-button-alist): Add nntp: urls. - (gnus-header-button-alist): Ditto. - -2003-04-17 Dave Love - - * gnus-util.el (gnus-string-equal): Revert last change. - -2003-04-17 Lars Magne Ingebrigtsen - - * gnus-srvr.el (gnus-browse-make-menu-bar): Fix typo. - -2003-04-17 Mike Woolley - - * gnus-sum.el (gnus-sum-thread-tree-false-root): New variable. - -2003-04-15 Michael Shields - - * gnus-art.el (article-hide-boring-headers): Hide Reply-To: if - the broken-reply-to group parameter is set. Idea from Vasily - Korytov . - -2003-04-17 Steve Youngs - - * dgnushack.el: 'setenv' is in env.el for XEmacsen <= 21.4, but in - process.el in XEmacsen >= 21.5. - -2003-04-17 Steve Youngs - - * dgnushack.el: Add a whole swag of autoloads and defaliases to - satisfy the byte-compiler when building with XEmacs. - - * lpath.el (maybe-bind): Add 'w3-meta-content-type-charset-regexp' - and 'w3-meta-charset-content-type-regexp' in XEmacs. The upstream - W3 doesn't have these. - - * mailcap.el: Maybe require 'lpr in XEmacs. - -2003-04-16 Simon Josefsson - - * mml2015.el (mml2015-pgg-sign): Bind pgg-default-user-id to MML - sender tag, if available. - -2003-04-16 Teodor Zlatanov - - * gnus-registry.el (gnus-register-action) - (gnus-register-spool-action, hashtable-to-alist) - (gnus-registry-translate-from-alist, alist-to-hashtable) - (gnus-registry-translate-to-alist, gnus-registry-headers-hashtb): - new variables and function fixes - - * gnus.el (gnus-registry-headers-alist): new variable to hold - article header data - (gnus-variable-list): save gnus-registry-headers-alist - - * spam-report.el (Module): new module for spam reporting - - * gnus.el (spam-process): added - gnus-group-spam-exit-processor-report-gmane to the list of choices - (gnus-install-group-spam-parameters): defined new spam exit processor - - * spam.el (autoload): autoload spam-report-gmane when needed - (spam-report-gmane-register-routine): glue for spam-report.el - (spam-group-spam-processor-report-gmane-p): glue for the - gnus-group-spam-exit-processor-report-gmane spam processor - (spam-summary-prepare-exit): check the report-gmane spam processor - and run spam-report-gmane-register-routine if it's active - -2003-04-16 John Wiegley - - * spam.el (spam-bogofilter-score): check bogofilter headers before - checking bogofilter itself - -2003-04-16 Dave Love - - * gnus-agent.el: Wrap defsetf in eval-when-compile. - (gnus-agent-cat-defaccessor): Don't use gensym. - - * mml1991.el: Require cl, mm-util when compiling. - (quoted-printable-decode-region, quoted-printable-encode-region): - Autoload. - - * pgg.el: Require cl when compiling. - - * nnmail.el (gnus): Require. - - * gnus-util.el: Move provide to end. - (gnus-string-equal): Maybe use compare-strings. - (gnus-merge): New. - - * gnus-sum.el (gnus-summary-prepare-threads): Don't use copy-list. - (gnus-summary-insert-articles): Use gnus-merge. - - * gnus-fun.el: Require cl and mm-util when compiling. - - * gnus-diary.el (gnus-diary-delay-format-french) - (gnus-diary-delay-format-english): Don't use setf with nthcdr. - - * nndiary.el (nndiary-compute-reminders): Don't use setf with - nthcdr. - -2003-04-16 Kevin Greiner - - * gnus-agent.el (gnus-agent-make-cat): Added optional parameter to - specify a predicate other than false. - (gnus-category-read): Use the new feature to create a 'default' - category with a 'short' predicate. - -2003-04-16 Lars Magne Ingebrigtsen - - * message.el (message-unique-id): Comment change. - - * gnus-art.el (gnus-article-next-page-1): New function. - (gnus-article-next-page): Use it. - -2003-04-15 Teodor Zlatanov - - * spam.el (spam-split): added save-restriction to save-excursion - -2003-04-15 Julien Avarre - - * gnus-fun.el: Fixed autoload cookie. - -2003-04-15 Remi Letot - - * nnmaildir.el (nnmaildir-request-scan): Use gnus-remove-if - instead of remove-if. - -2003-04-14 Katsumi Yamaoka - - * gnus-msg.el (gnus-summary-news-other-window): Use delq and - copy-sequence instead of remove which is a cl run-time function in - Emacs 20. - -2003-04-14 Jesper Harder - - * gnus-msg.el (gnus-summary-news-other-window): Make a buffer - local copy of gnus-discouraged-post-methods with the current - method removed. - -2003-04-14 Simon Josefsson - - * mailcap.el (mailcap-mime-data): Add application/pgp-keys. - -2003-04-13 Reiner Steib - - * mm-util.el (mm-sort-coding-systems-predicate): Convert elements - of `mm-coding-system-priorities' to base coding system. - - * gnus-sum.el: Added coding cookie ("middle dot" in - gnus-summary-morse-message). - -2003-04-13 Simon Josefsson - - * gnus-art.el (article-fill-long-lines) - (article-verify-x-pgp-sig, article-decode-group-name) - (gnus-mime-button-menu): Split >80 character lines. - -2003-04-13 Jesper Harder - - * gnus-sum.el (gnus-summary-local-variables): Use defvar since - we're let-binding it. - - * nnmbox.el (nnmbox-mbox-buffer): It's not a constant. - -2003-04-13 Lars Magne Ingebrigtsen - - * message.el (message-hide-headers): Don't do intangible. - - * gnus.el (gnus-group-prefixed-name): Comment out the test for - colon. - - * gnus-srvr.el (gnus-browse-read-group): Don't give the real name - to the ephemeral entry, but the prefixed name. - - * gnus.el (gnus-group-prefixed-name): Clean up. - -2003-04-13 Kevin Greiner - - * gnus-agent.el (gnus-agent-group-pathname): Bind - gnus-command-method so that gnus-agent-directory will always - return a valid directory. - * gnus-cache.el (gnus-cache-enter-article): Remove article from - gnus-newsgroup-undownloaded so that the summary will display the - article as downloaded. - (gnus-cache-remove-article): If the article isn't in the agent, - remove it from gnus-newsgroup-undownloaded so that the summary - will display the article as undownloaded. - -2003-04-13 Lars Magne Ingebrigtsen - - * gnus.el (gnus-version-number): Bump. - -2003-04-13 01:12:01 Lars Magne Ingebrigtsen - - * gnus.el: Oort Gnus v0.18 is released. - -2003-04-13 Lars Magne Ingebrigtsen - - * gnus-draft.el (gnus-draft-send): Add message-hidden-headers. - -2003-04-12 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-next-page): Use - gnus-article-over-scroll. - (gnus-article-over-scroll): New variable. - - * message.el (message-newline-and-reformat): Place a boundary - before filling. - (message-make-forward-subject-function): Changed default to - message-forward-subject-name-subject. - (message-forward-subject-name-subject): New function. - - * nnimap.el (nnimap-split-fancy): Ditto. - - * gnus-sum.el (gnus-summary-line-message-size): Ditto. - - * gnus-cus.el (gnus-group-parameters): Removed "which see". - - * mml.el (mml-minibuffer-read-file): Bind - completion-ignored-extensions to nil. - - * message.el (message-fix-before-sending): Comment fix. - (message-fix-before-sending): Make hidden headers visible. - (message-hide-headers): Bind after-change-functions to nil. - (message-forbidden-properties): Put invisible and intangible - back. - (message-strip-forbidden-properties): Ignore message-hidden text. - - * gnus-msg.el: Hide headers. - - * message.el (message-hidden-headers): New variable. - (message-hide-headers): New function. - (message-hide-header-p): New function. - (message-hide-header-p): Change logic. - (message-forbidden-properties): Remove intangible nil invisible - nil. - (message-hide-headers): Narrow to headers. - - * lpath.el (featurep): Bind Info-directory, Info-menu. - -2003-04-12 Jesper Harder - - * mm-bodies.el (mm-body-charset-encoding-alist): UTF-16 *must* be - encoded. - (mm-encode-body): Don't corrupt UTF-16. - (mm-body-encoding): Pay attention to mm-body-charset-encoding-alist. - -2003-04-10 Kevin Greiner - - * gnus-agent.el (gnus-agent-get-undownloaded-list): Articles in - the CACHE are now detected and handled the same as an article - downloaded into the agent. - (gnus-agent-group-path): Modified to match nnmail-group-pathname - so that the agent front-end and back-end (nnagent) always use the - same directory. - (gnus-agent-group-pathname): New function. Wrapper for - nnmail-group-pathname. - (gnus-agent-expire-unagentized-dirs): New variable. May be - customized to disable gnus-agent-expire-unagentized-dirs. - (gnus-agent-expire-unagentized-dirs): Expand gnus-agent-directory - as the directories in gnus-agent-expire-current-dirs were - expanded. - -2003-04-10 Jesper Harder - - * gnus-sum.el (gnus-summary-make-menu-bar): Disable "Encrypt - body" entry in read only groups. - -2003-04-09 Jesper Harder - - * gnus-sum.el (gnus-summary-make-menu-bar): Disable "Import file" - and "Create article" items in non-editable groups. - -2003-04-09 Kevin Greiner - - * gnus-agent.el (gnus-agent-write-active): Added option of - replacing, rather than updating, the agent's active file. Do NOT - use the fully qualified group name as gnus-active-to-gnus-format - blindly prefixes group names with server names. - (gnus-agent-save-group-info): Merge BOTH min/max of current active - range, was just merging min, with specified active range. - (gnus-agent-expire): Save agent's active ranges after - expiring all groups. - (gnus-agent-expire-group-1): Update min of agent's active range to - min article currently fetched. - (gnus-agent-expire-unagentized-dirs): Avoid asking to delete the - same ancestor multiple times. - - * gnus-async.el (gnus-asynchronous): Moved defcustom of - gnus-asynchronous away from defgroup of gnus-asynchronous. This - seems to fix an intermittant error in which loading gnus-async - fails to define gnus-asynchronous (the variable). - - * gnus-sum.el: Concur with Steve Young, 5th argument to 'load' is - non-essential. Removed on all platforms. - (gnus-select-newsgroup): When the agent is active, expand the - group's active range to include fetched articles that are no - longer in the server's active range. - - * gnus-util.el (gnus-with-output-to-file): Removed all of the - print-* bindings as they should be handled by the function doing - the printing. - -2003-04-09 Jesper Harder - - * mm-uu.el (mm-uu-copy-to-buffer): buffer-file-coding-system - might be unbound in non-MULE XEmacsen. - -2003-04-08 Jesper Harder - - * mm-uu.el (mm-uu-diff-groups-regexp, mm-uu-type-alist) - (mm-uu-diff-extract, mm-uu-diff-test): New functionality: - recognize diffs. - - * mm-bodies.el (mm-decode-body): Use the supplied charset - unconditionally if `code-pages' hasn't been loaded. - -2003-04-07 Jesper Harder - - * gnus-art.el (article-verify-x-pgp-sig): Don't use - `insert-buffer', the docstring says "This function is meant for - the user to run interactively. Don't call it from programs!" - - * mm-extern.el (mm-extern-mail-server): do. - - * mml1991.el (mml1991-mailcrypt-sign, mml1991-mailcrypt-sign) - (mml1991-gpg-sign, mml1991-gpg-encrypt, mml1991-pgg-sign) - (mml1991-pgg-encrypt): do. - - * pgg.el (pgg-decrypt-region): do. - - * mm-view.el (mm-view-pkcs7-decrypt): do. - - * mml-smime.el (mml-smime-verify): do. - - * mml.el (mml-insert-mime, mml-preview): do. - - * mml2015.el (mml2015-gpg-decrypt-1, mml2015-gpg-sign) - (mml2015-gpg-encrypt, mml2015-pgg-clear-decrypt) - (mml2015-pgg-encrypt): do. - -2003-04-06 Katsumi Yamaoka - - * mm-bodies.el (mm-decode-body): Silence XEmacs when compiling. - -2003-04-06 Jesper Harder - - * mm-uu.el (mm-uu-copy-to-buffer): Copy - `buffer-file-coding-system' to the new buffer. - (mm-uu-pgp-signed-extract-1): Don't copy - `buffer-file-coding-system' here. - - * mm-bodies.el (mm-decode-body): last-coding-system-used doesn't - exist in XEmacs. - (mm-decode-body): Add missing quote. - - * mm-uu.el (mm-uu-pgp-signed-extract-1): Set - buffer-file-coding-system. - - * mm-bodies.el (mm-decode-body): Set buffer-file-coding-system to - last-coding-system-used. - - * mml2015.el (mml2015-pgg-clear-verify): Encode the text - according to buffer-file-coding-system. - - * pgg-gpg.el (pgg-gpg-process-region): Revert previous change. - - * pgg-pgp.el (pgg-pgp-process-region, pgg-pgp-verify-region) - (pgg-pgp-snarf-keys-region): do. - - * pgg-pgp5.el (pgg-pgp5-verify-region) - (pgg-pgp5-snarf-keys-region, pgg-pgp5-process-region): do. - - * pgg.el (pgg-make-temp-file, pgg-temporary-file-directory): do. - -2003-04-05 Teodor Zlatanov - - * spam.el (spam-split): (save-excursion) around (widen) - (spam-ham-move-routine): Use spam-group-ham-mark-p, not - spam-group-spam-mark-p (from Michael Shields ) - -2003-04-05 Steve Youngs - - * gnus-sum.el: XEmacs doesn't support the 5th arg to 'load', so - don't use it when loading gnus-sum.el if we're in XEmacs. - -2003-04-05 Kevin Greiner - - * gnus-start.el (gnus-gnus-to-quick-newsrc-format): Bound - print-escape-nonascii to fix more characters in compiled format - specs. - -2003-04-05 Jesper Harder - - * gnus-audio.el (gnus-audio-au-player, gnus-audio-wav-player): - Fix customization type. - -2003-04-04 Kevin Greiner - - * gnus-start.el (gnus-gnus-to-quick-newsrc-format): Bound - print-quoted, print-readably, print-escape-multibyte, and - print-level to match original behavior of gnus-prin1. This should - repair the format of .newsrc.eld when using compiled format specs. - -2003-04-04 Jesper Harder - - * gnus-group.el (tool-bar-map): defvar it. - - * gnus-art.el (tool-bar-map): do. - - * gnus-sum.el (tool-bar-map): do. - -2003-04-03 Jesper Harder - - * earcon.el (earcon-regexp-alist): catmeow is a wav file. - -2003-04-03 Reiner Steib - - * gnus-art.el (gnus-button-ctan-directory-regexp): Changed meaning - and value. - (gnus-button-alist): Use it. - -2003-04-03 Jesper Harder - - * pgg-gpg.el (pgg-gpg-process-region): do. - - * pgg-pgp.el (pgg-pgp-process-region, pgg-pgp-verify-region) - (pgg-pgp-snarf-keys-region): do. - - * pgg-pgp5.el (pgg-pgp5-verify-region) - (pgg-pgp5-snarf-keys-region, pgg-pgp5-process-region): Use it. - - * pgg.el (pgg-make-temp-file): New function. `make-temp-name' is - unsafe. - (pgg-temporary-file-directory): Remove. - -2003-04-02 Katsumi Yamaoka - - * lpath.el: Fbind Info-directory and Info-menu. - -2003-04-02 Reiner Steib - - * gnus-util.el (gnus-message): Added doc-string. - - * gnus-score.el (gnus-score-find-trace): Changed behavior of `q'. - (gnus-score-edit-file-at-point): Goto first match when using `e'. - -2003-04-01 Reiner Steib - - * gnus-art.el (gnus-button-ctan-directory-regexp): New variable. - (gnus-button-alist): Use it. Changed CTAN and "setq" entries. - -2003-04-01 Katsumi Yamaoka - - * nntp.el (nntp-via-rlogin-command-switches): Doc fix. - (nntp-open-via-rlogin-and-telnet): Disable the telnet linemode. - -2003-03-31 Kevin Greiner - - * gnus-start.el (gnus-gnus-to-quick-newsrc-format): Bound - print-escape-newlines to print escape sequences rather than - literal newline characters. - -2003-03-31 Reiner Steib - - * gnus-art.el (gnus-button-valid-fqdn-regexp): Use - `message-valid-fqdn-regexp' for initialization. - (gnus-button-handle-info-url): Renamed and extended version of - `gnus-button-handle-info'. - (gnus-button-message-level): Renamed from `gnus-button-mail-level' - (gnus-button-handle-symbol, gnus-button-handle-library) - (gnus-button-handle-info-keystrokes): New functions. - (gnus-button-browse-level): New variable. - (gnus-button-alist): Use them. Added levels. - (gnus-header-button-alist): Added levels. - -2003-03-31 Lars Magne Ingebrigtsen - - * gnus.el (gnus-version-number): Bump. - -2003-03-31 20:08:19 Lars Magne Ingebrigtsen - - * gnus.el: Oort Gnus v0.17 is released. - -2003-03-31 Lars Magne Ingebrigtsen - - * gnus-start.el (gnus-unload): Removed. - - * pop3.el (pop3-read-response): Use - nnheader-accept-process-output. - (pop3-retr): Ditto. - - * mm-view.el (mm-text-html-renderer-alist): Add -nolist to Lynx. - (mm-text-html-washer-alist): Ditto. - -2003-03-31 Simon Josefsson - - * imap.el (imap-gssapi-program): Also try GNU SASL. - (imap-gssapi-open): Accept GNU SASL greeting. - (imap-read-timeout): New. - (imap-wait-for-tag): Use it. - -2003-03-31 Lars Magne Ingebrigtsen - - * nntp.el (nntp-accept-process-output): Use new function. - - * nnheader.el (nnheader-read-timeout): New variable. - (nnheader-accept-process-output): New function. - - * nntp.el (nntp-read-timeout): Removed. - - * gnus-sum.el (gnus-summary-prepare-threads): Add comment. - -2003-03-30 Katsumi Yamaoka - - * gnus-cache.el (gnus-cache-braid-nov): Revoke last change. - -2003-03-30 Simon Josefsson - - * message.el (message-idna-inside-rhs-p): Narrow to header before - searching. - - * gnus-art.el (article-decode-idna-rhs): More restrictive regexp. - -2003-03-30 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-process-mmdf-mail-format): Indent. - -2003-03-28 Vasily Korytov - - * message.el (message-make-in-reply-to): Use - mail-extract-address-components to determine sender's - name/address. - -2003-03-30 Lars Magne Ingebrigtsen - - * nndoc.el (nndoc-type-alist): Move mime-parts further ahead. - - * gnus-registry.el (gnus-registry-translate-to-alist): Make a - valid lambda. - (gnus-registry-translate-from-alist): Ditto. - - * gnus-start.el (gnus-gnus-to-quick-newsrc-format): Bind - print-length to nil. - - * gnus-sum.el (gnus-summary-highlight-line-0): Indent. - - * gnus-fun.el (gnus-fun-ppm-change-string): New function. - (gnus-grab-cam-face): Use it. - -2003-03-28 Paul Jarc - - * nnmaildir.el (nnmaildir-request-set-mark) - (nnmaildir-close-group): Allow each mark directory in a group to - have its own inode for mark files, to accommodate AFS. - -2003-03-28 Teodor Zlatanov - - * gnus-start.el (gnus-read-newsrc-el-hook): new hook called by - gnus-read-newsrc-el-file - (gnus-read-newsrc-el-file): call the gnus-read-newsrc-el-hook - - * gnus-registry.el (gnus-registry-translate-to-alist) - (gnus-registry-translate-from-alist: new functions - (gnus-register-spool-action): add a spool item to the registry - - * gnus.el (gnus-variable-list): added gnus-registry-alist to the - list of saved variables - (gnus-registry-alist): new variable - -2003-03-28 Andreas Fuchs - - * gnus-registry.el (alist-to-hashtable, hashtable-to-alist): New - functions. - -2003-03-27 Simon Josefsson - - * gnus-art.el (article-decode-group-name): Be correct instead of - smart. - -2003-03-27 Katsumi Yamaoka - - * lpath.el: Bind url-current-object for Emacs; bind - gnus-agent-expire-current-dirs for XEmacs; fbind open-ssl-stream - for both Emacsen. - -2003-03-27 Jesper Harder - - * gnus-sum.el (gnus-article-loose-mime) - (gnus-article-emulate-mime): Move to gnus-article-mime customize - group. - - * gnus-msg.el (gnus-mailing-list-groups): Fix customize type and - doc string. - -2003-03-26 Kevin Ryde - - * gnus-sum.el (gnus-summary-find-for-reselect): Renamed from - gnus-summary-find-uncancelled, skip temporary articles inserted by - "refer" functions. - -2003-03-26 Vasily Korytov - - * smiley.el (smiley-buffer): New function. - -2003-03-26 Kevin Greiner - - * gnus-agent.el (gnus-agent-fetch-selected-article): Replaced - gnus-summary-update-line (which updated the article's face) with - gnus-summary-update-download-mark (which updates the article's - face by calling gnus-summary-update-line AND updates the download - mark to show that the article was fetched). - -2003-03-23 Kevin Greiner - - * gnus-agent.el (gnus-agent-expire-unagentized-dirs): Provides - option of deleting agent directories for groups/servers that are - not currently agentized. - (gnus-agent-expire): Use gnus-agent-expire-unagentized-dirs. - - * gnus-int.el (gnus-open-server): Report backend errors in - condition handler. - -2003-03-23 Simon Josefsson - - * message.el (message-idna-to-ascii-rhs-1): Don't continue outside - header. - - * rfc2047.el (rfc2047-header-encoding-alist): Make Followup-To - same as Newsgroups. - - * nntp.el (nntp-open-connection-function): Mention - nntp-open-tls-stream. - (nntp-open-tls-stream): New function. - - * tls.el: New file. - - * nnimap.el (nnimap-server-port, nnimap-stream): Say TLS/SSL - instead of SSL. - (nnimap-stream): Add other streams, link to imap variables. - (nnimap-authenticator): Add other authenticator, link to imap - variables. - - * imap.el: Autoload open-tls-stream. - (imap-streams): Add tls in front of ssl. - (imap-stream-alist): Add tls. - (imap-default-tls-port): New variable. - (imap-tls-p, imap-tls-open): New functions. - -2003-03-22 ShengHuo ZHU - - * mm-url.el (mm-url-insert-file-contents): parse url only if - results is a list. - -2003-03-22 Lars Magne Ingebrigtsen - - * mail-source.el (mail-source-fetch-imap): Revert. - -2003-03-22 Svend Tollak Munkejord - - * deuglify.el (gnus-outlook-repair-attribution-outlook): Use a - less strict regexp. - -2003-03-22 Lars Magne Ingebrigtsen - - * mail-source.el (mail-source-fetch-imap): Use buffer name for - more imap function. - -2003-03-21 Simon Josefsson - - * gnus-art.el (article-decode-group-name): Replace Newsgroups and - Followup-To data inline. - -2003-03-21 Jesper Harder - - * gnus-art.el (gnus-treat-display-xface): Don't enable if - icontopbm isn't available. - -2003-03-21 Kevin Greiner - - * gnus-int.el (gnus-open-server): Catch errors in backend's - open-server method. Returns nil rather than crashing startup. - - * gnus-sum.el (eval-when-compile): Modified to resolve - compile-time warnings. - - * gnus-uu.el (gnus-uu-mark-series): Added informative msg. - Reports length of series so that the user can compare N with a - subject that should, if the entire series is present, contain - '(.../N)'. - (gnus-uu-delete-work-dir): Avoid hanging when O/S forbids deletion - of temp file (Win-XP may leave the temp file locked when the - uudecode process fails). - -2003-03-20 ShengHuo ZHU - - * message.el (message-split-line): Ignore error. - - * lpath.el (split-line): Avoid split-line warning message. - -2003-03-20 Kim F. Storm - - * message.el (message-split-line): New function. - (message-mode-map): Remap split-line to message-split-line. - -2003-03-20 Katsumi Yamaoka - - * message.el (message-make-overlay): Defalias it to make-overlay. - (message-delete-overlay): Defalias it to delete-overlay. - (message-overlay-put): Defalias it to overlay-put. - (message-idna-to-ascii-rhs-1): Use them. - - * messagexmas.el (message-xmas-redefine): Defalias some overlay - functions to extent functions. - -2003-03-20 Reiner Steib - - * message.el (message-check-news-header-syntax): Fixed regexp. - -2003-03-20 ShengHuo ZHU - - * rfc2231.el (rfc2231-decode-encoded-string): Downcase charset. - - * mm-url.el (mm-url-insert): Move url-current-object stuff into - mm-url-insert-file-contents. - - * nnrss.el (nnrss-fetch): Fetch the local stuff. - (nnrss-check-group): Use it. - -2003-03-20 Mark A. Hershberger - - * nnrss.el: Primitive XML Name-space support. This means that RSS - feeds like Kevin Burton's[1] can now be read in Gnus. - - Implemented support for Mark Pilgrim's RSS Autodiscovery.[2] This - means that if you want to read the RSS feed for example.com, all - you have to do is hit "G R http://www.example.com/ RET" and - nnrss.el will find and the feed listed on the site or (if you have - loaded xml-rpc.el) look it up on syndic8.com. - - Marked the message as HTML (by adding a Content-Type header) so - that Gnus will render it as html if the user wants that. - - Implemented the ability to save nnrss-group-alist so that any new - feeds the you subscribe to will be found the next time you start - up. - - Implemented support for RSS 2.0 elements (author, pubDate). - - Prefer for over where both - elements exist. - - * mm-url.el (mm-url-insert): Set url-current-object. - - * gnus-group.el (gnus-group-make-rss-group): New function. - -2003-03-20 Katsumi Yamaoka - - * message.el (message-idna-to-ascii-rhs-1): Don't use replace-* - for highlight overlays. - -2003-03-20 Katsumi Yamaoka - - * gnus-cache.el (gnus-cache-braid-nov): Test if a line looks like - a NOV. - -2003-03-20 Simon Josefsson - - * message.el (message-use-idna): Disable if UTF-8 unavailable. - (message-idna-to-ascii-rhs): Use it. - - * gnus-art.el (gnus-use-idna): Disable if UTF-8 unavailable. - -2003-03-19 Teodor Zlatanov - - * spam.el (spam-group-ham-mark-p, spam-group-spam-mark-p) - (spam-group-ham-marks, spam-group-spam-marks): new functions - (spam-spam-marks, spam-ham-marks): removed in favor of the - spam-marks and ham-marks parameters - (spam-generic-register-routine, spam-ham-move-routine): use the - new spam-group-{spam,ham}-mark-p functions - - * gnus.el (spam-marks, ham-marks): new group parameters with - default values same as the old spam-spam-marks and spam-ham-marks - -2003-03-19 Simon Josefsson - - * gnus-art.el (gnus-article-decode-hook): Add IDNA. - (gnus-use-idna): New variable. - (article-decode-idna-rhs): New function. - - * message.el (message-use-idna): New variable. - (message-mode-field-menu): Add entry for IDNA. - (message-idna-inside-rhs-p, message-idna-to-ascii-rhs-1) - (message-idna-to-ascii-rhs): New function. - (message-generate-headers): Invoke IDNA code. - -2003-03-19 Paul Jarc - - * nnmaildir.el (nnmaildir--system-name): New function. - (nnmaildir-request-accept-article): Use it. - -2003-03-19 Katsumi Yamaoka - - * gnus-util.el (gnus-byte-compile): Make it work silently as the - gnus-compile function does. - - * gnus-sum.el (gnus-summary-highlight-line-0): Revoke the last - bogus change. - -2003-03-19 Jesper Harder - - * mm-util.el (mm-mule-charset-to-mime-charset): Test if - sort-coding-systems is defined. - -2003-03-18 Paul Jarc - - * nnmaildir.el (nnmaildir-open-server, nnmaildir-request-scan) - (nnmaildir-request-create-group, nnmaildir-request-delete-group): - Replace create-directory with target-prefix. - -2003-03-18 Jesper Harder - - * mm-bodies.el (mm-decode-coding-region-safely): Don't use - find-charset-string which is slooow in XEmacs. - -2003-03-18 Katsumi Yamaoka - - * gnus-sum.el (gnus-summary-highlight-line-0): Silence the byte- - compiler under XEmacs. - -2003-03-18 Jesper Harder - - * gnus-art.el (gnus-treat-highlight-signature): Make the default - work for multipart/signed where the message text isn't `last'. - -2003-03-18 Katsumi Yamaoka - - * mm-view.el (mm-setup-w3m): Set w3m-display-inline-images to - the value of mm-inline-text-html-with-images. - (mm-inline-text-html-render-with-w3m): Don't bind - w3m-display-inline-images. - - * gnus-art.el (gnus-article-wash-html-with-w3m): Don't bind - w3m-display-inline-images. - - * lpath.el: Bind w3m-display-inline-images; bind mm-w3m-mode-map - regardless of an Emacs flavor. - -2003-03-18 Lars Magne Ingebrigtsen - - * gnus.el (gnus-version-number): Bump. - -2003-03-18 00:38:22 Lars Magne Ingebrigtsen - - * gnus.el: Oort Gnus v0.16 is released. - -2003-03-18 Lars Magne Ingebrigtsen - - * lpath.el (featurep): Bind mm-w3m-mode-map. - -2003-03-17 Paul Jarc - - * nnmail.el (nnmail-cache-primary-mail-backend): Not all - 'respool-able backends define a global nnchoke-get-new-mail - variable. - -2003-03-17 Reiner Steib - - * gnus-art.el (gnus-mime-delete-part): New function. - (gnus-mime-action-alist, gnus-mime-button-commands): Use it. - -2003-03-17 Lars Magne Ingebrigtsen - - * message.el (message-check-news-header-syntax): Don't push - groups twice onto list of unknown groups. - - * nndoc.el (nndoc-type-alist): Move exim-bounce a bit further - back. - - * nnheader.el (nnheader-find-etc-directory): Doc fix. - - * gnus-msg.el (gnus-inews-add-send-actions): Don't restore window - config unless the summary buffer exists. - - * gnus-sum.el (gnus-summary-next-group): Semi-exit group first to - that target group is computed correctly when articles are marked - as read by Xref handling. - - * mail-source.el (mail-source-fetch-imap): Pass buffer-name to - imap-open. - - * message.el (message-send-mail): Add courtesy string to Bcc's, - too. - - * gnus-cite.el (gnus-cited-line-p): New function. - -2003-03-15 Jesper Harder - - * mm-bodies.el (mm-decode-body): Add new optional parameter, - force, to use the supplied charset unconditionally. - - * gnus-art.el (article-decode-charset): Use it. - -2003-03-14 Jesper Harder - - * mm-bodies.el (mm-decode-coding-region-safely): New function. - (mm-decode-body): Use it. - - * rfc2047.el (rfc2047-decode-region): do. - (rfc2047-decode-string): Guess coding system if the default is - invalid. - -2003-03-12 Paul Jarc - - * nnmaildir.el (nnmaildir-request-update-info): Pretend missing - articles are marked 'read, so we get correct article counts. - -2003-03-13 Katsumi Yamaoka - - * gnus-art.el (gnus-insert-mime-button): Exclude a newline from - the button. - (gnus-insert-prev-page-button): Ditto. - (gnus-insert-next-page-button): Ditto. - (gnus-insert-mime-security-button): Ditto. - - * mm-view.el (mm-inline-image-emacs): Open the bottom of an image - one line. Suggested by Greg Klanderman . - (mm-inline-image-xemacs): Ditto. - -2003-03-12 Paul Jarc - - * nnmaildir.el (nnmaildir--parse-filename, nnmaildir--sort-files, - nnmaildir--scan, nnmaildir-request-accept-article): Changes for - the recent filename uniqueness discussion. - -2003-03-12 Katsumi Yamaoka - - * mm-view.el (mm-inline-image-emacs): Make it delete an excessive - newline next time. - (mm-inline-image-xemacs): Ditto. - -2003-03-10 Jesper Harder - - * gnus-agent.el (gnus-agent-synchronize-flags-server): Don't use - kill-line. - -2003-03-09 Jesper Harder - - * gnus-msg.el (gnus-inews-insert-archive-gcc): Don't use - kill-line. - -2003-03-09 Kevin Greiner - - * gnus-agent.el (gnus-agent-fetched-hook): New variable. Just - fixing the code to match the documentation. - (gnus-agent-fetch-selected-article): Replaced - gnus-summary-update-article-line with gnus-summary-update-line as - the former did not correctly recalculate the thread indentation. - (gnus-agent-find-parameter): The agent-predicate, if not found - anywhere else, defaults to the value of gnus-agent-predicate. - (gnus-agent-fetch-session): Fixed typo; now executes - gnus-agent-fetched-hook rather than the undocumented - gnus-agent-fetch-hook. - (gnus-agent-fetch-group-1): Removed part of 2003-03-06 fix. The - default agent predicate is now provided by - gnus-agent-find-parameter. - (gnus-agent-message): New macro. This macro avoids potentially - costly parameter evaluation when the message's level is too high - to display. - (gnus-agent-expire-group-1): Disabled undo tracking in temp - overview buffer. Uses new gnus-agent-message macro to reduce - overhead of optional messages. Reversed message levels to - emphasize percent completion messages. Detailed messages of - little use except when debugging code. - -2003-03-08 Teodor Zlatanov - - * spam.el (spam-ham-move-routine): use - spam-mark-ham-unread-before-move-from-spam-group - (spam-mark-ham-unread-before-move-from-spam-group): new variable - -2003-03-07 Teodor Zlatanov - - * spam.el: load nnimap.el when compiling - (spam-setup-widening): use - nnimap-split-download-body-default instead of - nnimap-split-download-body which is a user-customizable variable - -2003-03-07 Simon Josefsson - - * nnimap.el (nnimap-split-download-body-default): New, holds - default for n-s-d-b. - (nnimap-split-download-body): Add new setting (symbol default), - which uses contents of n-s-d-b-d, and made it the default. - -2003-03-07 Teodor Zlatanov - - * spam.el (spam-use-hashcash): new variable - (spam-list-of-checks): added spam-use-hashcash with associated - spam-check-hashcash - (spam-check-hashcash): new function, installed iff hashcash.el is - loaded - (spam-setup-widening): don't use (return) - -2003-03-06 Kevin Greiner - - * gnus-agent.el (gnus-agent-fetch-group-1): Added default - predicate of `false' to avoid an error when a group defines no - predicate. Fixed typo that disabled agent scoring (i.e. the - low/high predicates should now work). - -2003-03-06 Teodor Zlatanov - - * spam.el: add spam-maybe-spam-stat-load to - gnus-get-top-new-news-hook, remove it from gnus-get-new-news-hook - (spam-bogofilter-register-with-bogofilter): use - spam-bogofilter-spam-switch and spam-bogofilter-ham-switch - (spam-bogofilter-spam-switch, spam-bogofilter-ham-switch): new - custom variables to replace "-s" and "-n" - - * gnus-group.el (gnus-group-get-new-news): call the new - gnus-get-top-new-news-hook hook - - * gnus-start.el (gnus-get-top-new-news-hook): new hook, run ONLY - by gnus-get-new-news, NOT by gnus-group-get-new-news-this-group - -2003-03-06 Lars Magne Ingebrigtsen - - * mm-uu.el (mm-uu-pgp-encrypted-test): Fix message. - -2003-03-06 Katsumi Yamaoka - - * gnus-cus.el (gnus-group-customize): Don't use delete-if which is - a cl run-time function. - -2003-03-06 Kevin Greiner - - * gnus-agent.el (gnus-agent-fetch-group-1): Added missing binding - on gnus-agent-short-article. - (gnus-category-read): Replaced CL function mapcar* with new macro: - gnus-mapcar. - * gnus-util.el (gnus-mapcar): New macro. Generalizes mapcar to - support functions that accept multiple parameters. A separate - sequence must be provided for each parameter in the function. - Iteration stops when the end of the shortest list is reached. - -2003-03-06 Jesper Harder - - * nnimap.el (nnimap-request-accept-article): Use delete-region. - - * html2text.el (html2text-clean-dtdd, html2text-delete-tags) - (html2text-delete-single-tag, html2text-clean-anchor) - (html2text-remove-tags): Use delete-region. - (html2text-fix-paragraphs): Simplify. - - * mml1991.el (mml1991-mailcrypt-sign, mml1991-mailcrypt-encrypt) - (mml1991-gpg-sign, mml1991-gpg-encrypt, mml1991-pgg-sign) - (mml1991-pgg-encrypt, mml1991-pgg-encrypt): Use delete-region, not - kill-region. - -2003-03-04 John Paul Wallington - - * gnus-agent.el (gnus-agent-enable-expiration) - (gnus-agent-article-alist, gnus-agent-article-alist) - (gnus-agent-cat-defaccessor): Doc fixes. - -2003-03-04 Kai Gro,A_(Bjohann - - * gnus-agent.el (gnus-function-implies-unread-1): Grok - byte-compiled functions. - -2003-03-04 Kevin Greiner - - * gnus-sum.el (gnus-auto-goto-ignores): New variable. Provides - customization between new maneuvering (which permits selecting - undownloaded articles) and old maneuvering (which skipped over - undownloaded articles) behaviors. - (gnus-summary-find-next): Pass through the unread and subject - parameters when calling gnus-summary-find-prev. - (gnus-summary-find-next,gnus-summary-find-prev): Apply - gnus-auto-goto-ignores to filter out unacceptable articles. - -2003-03-04 Jesper Harder - - * mail-source.el (mail-source-read-passwd): Remove. `read-passwd' - exists in all supported Emacs versions, so we don't need this - compatibility function. - (mail-source-fetch-pop, mail-source-check-pop) - (mail-source-fetch-webmail): Use read-passwd. - - * nntp.el (nntp-send-authinfo, nntp-send-nosy-authinfo) - (nntp-open-telnet, nntp-open-via-telnet-and-telnet): Use - read-passwd. - - * nnwarchive.el (nnwarchive-open-server): Use read-passwd. - - * imap.el (imap-read-passwd): Remove. - (imap-interactive-login): Use read-passwd. - - * canlock.el (canlock-read-passwd): Remove. - (canlock-insert-header, canlock-verify): Use read-passwd. - - * sieve-manage.el (sieve-manage-read-passwd): Remove. - (sieve-manage-interactive-login): Use read-passwd. - - * pop3.el (pop3-read-passwd): Remove. - (pop3-movemail, pop3-get-message-count, pop3-apop): Use - read-passwd. - - * pgg.el (pgg-read-passphrase): Simplify. - -2003-03-04 Kevin Greiner - - * gnus-agent.el (gnus-agent-mode): Fixed the mode line reports - 'plugged' when actually 'unplugged' bug. - (gnus-category-read): Ignore nil values when converting an - old-format category so that the new-format category will default - those attributes to the global variables. - -2003-03-03 Reiner Steib - - * mail-source.el (mail-source-delete-old-incoming-confirm): Fixed - doc-string. - -2003-03-03 Jesper Harder - - * nnrss.el (nnrss-decode-entities-unibyte-string): Use `buffer-string'. - * nndoc.el (nndoc-dissect-mime-parts-sub): do. - * nndb.el (nndb-request-accept-article, nndb-status-message): do. - * mm-url.el (mm-url-decode-entities-string): do. - * mml1991.el (mml1991-mailcrypt-sign, mml1991-gpg-sign): do. - * mm-decode.el (mm-find-raw-part-by-type): do. - * message.el (message-send-mail-partially) - (message-send-mail-with-sendmail): do. - * gnus-uu.el (gnus-uu-save-article, gnus-uu-reginize-string): do. - * gnus-kill.el (gnus-pp-gnus-kill): do. - * gnus-art.el (gnus-article-treat-unfold-headers) - (gnus-article-encrypt-body): do. - -2003-02-24 Reiner Steib - - * mail-source.el (mail-source-delete-incoming): Allow integer value. - (mail-source-delete-old-incoming-confirm): New variable. - (mail-source-delete-old-incoming): Use it. New function. - (mail-source-callback): Call `mail-source-delete-old-incoming' if - `mail-source-delete-incoming' is a nonnegative integer. - -2003-03-03 Reiner Steib - - * gnus-msg.el (gnus-extended-version): Fix for 'emacs-gnus-config. - (gnus-user-agent): Fixed typo. - -2003-03-03 Kevin Greiner - - * gnus-agent.el (gnus-agent-enable-expiration): Fixed documentation. - (gnus-agent-expire-group-1): Removed invalid (interactive) specifier. - -2003-03-03 Lars Magne Ingebrigtsen - - * gnus-agent.el (gnus-agent-fetch-articles): Fix nil message. - (gnus-agent-fetch-session): Allow debugging to take place. - -2003-03-03 Jesper Harder - - * gnus-sum.el (gnus-highlight-selected-summary) - (gnus-article-get-xrefs, gnus-summary-show-thread): Use - `gnus-point-at-bol' and `gnus-point-at-eol' instead of - `(progn (beginning-of-line) (point))'. It's shorter, faster, - and makes it clear that we don't need the side effect. - * gnus-util.el (gnus-delete-line): do. - * gnus-xmas.el (gnus-group-add-icon): do. - * nnmail.el (nnmail-article-group, nnmail-cache-fetch-group): do. - * nntp.el (nntp-send-authinfo-from-file): do. - * nnml.el (nnml-header-value): do. - * nnheader.el (nnheader-insert-references): do. - * gnus-cite.el (gnus-article-highlight-citation) - (gnus-cite-parse): do. - * gnus-score.el (gnus-score-followup): do. - * gnus-draft.el (gnus-draft-send): do. - * gnus-group.el (gnus-group-highlight-line): do. - * gnus-cache.el (gnus-cache-braid-nov): do. - * nnfolder.el (nnfolder-retrieve-headers) - (nnfolder-request-article): do. - * gnus-art.el (article-hide-boring-headers) - (gnus-article-hide-header): do. - - * nnheader.el (nnheader-find-nov-line): Use gnus-delete-line. - * nnml.el (nnml-request-replace-article): do. - * nnmbox.el (nnmbox-request-move-article, nnmbox-delete-mail): do. - * nnfolder.el (nnfolder-request-move-article): do. - * gnus-cache.el (gnus-cache-possibly-remove-article): do. - * gnus-art.el (gnus-mm-display-part): do. - - * gnus-art.el (gnus-article-goto-part): Use gnus-goto-char. - -2003-03-02 Kevin Greiner - - * nntp.el (nntp-possibly-change-group): Avoid calling - process-buffer on nil (Which happened when you lost your - connection while fetching); instead signal a "Server Closed - Connection" error. - -2003-03-02 Kevin Greiner - - * gnus-agent.el (gnus-agent-enable-expiration): New - variable. Either ENABLE or DISABLE. Sets default behavior for - selecting which groups are expired. - (gnus-agent-cat-set-property, gnus-agent-cat-defaccessor, - gnus-agent-set-cat-groups): Provides abstract interface for - accessing agent category. Category now implemented by an alist. - (gnus-agent-add-group, gnus-agent-remove-group, - gnus-category-insert-line, gnus-category-edit-predicate, - gnus-category-edit-score, gnus-category-edit-groups, - gnus-category-copy, gnus-category-add, gnus-group-category): Use - new agent category abstraction. - (gnus-agent-find-parameter): New function. Search for agent - configuration parameter first in the group's parameters, then its - topics (if any), and then the group's category. If not found - anywhere, use the original defined constants. - (gnus-agent-fetch-headers, gnus-agent-fetch-group-1): Use new - gnus-agent-find-parameter. - (gnus-agent-fetch-headers, gnus-agent-uncached-articles): Clearing - gnus-agent-cache now blocks retrieving headers and articles from - the local cache. Fetched content is still added to the cache - before being returned. - (gnus-agent-fetch-session): Use error-message-string to generate - displayed error message. - (gnus-agent-customize-category): New Command. 'e' in category - buffer opens category customization buffer. - (gnus-category-read): Reads either positional or alist format; - returns alist format. - (gnus-category-write): Writes category file compatible with - current, and previous, versions of gnus-agent. - (gnus-category-make-function, gnus-category-make-function-1): - Corrected documentation; parameter is predicate NOT category. - (gnus-predicate-implies-unread): Now works in more cases per the - todo comment. - (gnus-function-implies-unread-1): New function. Supports - gnus-predicate-implies-unread. - (gnus-agent-expire-group): Command now provides default of group - under point. - (gnus-agent-expire-group-1): Obeys new agent-enable-expiration and - agent-days-until-old parameters. No longer supports - gnus-agent-expire-days being set to an alist. - (gnus-agent-request-article): Now performs its own checks of - gnus-agent, gnus-agent-cache, and gnus-plugged rather than - assuming that the caller will do them correctly. - (): Added one-time hook to gnus-group-prepare-hook. Detects when - gnus-agent-expire-days is set to an alist. Converts said alist - into group parameter so that gnus-agent-expire-days will not be - needed. - * gnus-art.el (gnus-request-article-this-buffer): Conditional - checks surrounding gnus-agent-request-article removed; now - performed by gnus-agent-request-article. - * gnus-cus.el (gnus-agent-parameters): New variable. List of - customizable group/topic parameters that regulate the agent. - (gnus-group-customize): Uses gnus-agent-parameters. Replaced - kill-buffer with gnus-kill-buffer to remove the killed buffer from - the list of gnus buffers. - (gnus-trim-whitespace): Removes leading and trailing whitespace - from multiline strings. - (gnus-agent-cat-prepare-category-field, - gnus-agent-customize-category): Constructs a category - customization buffer. - * gnus-int.el (gnus-retrieve-headers, - gnus-request-expire-articles): No longer checks gnus-agent-cache - as it is handled internally by the agent. - (gnus-request-head, gnus-request-body): Conditional checks - surrounding gnus-agent-request-article removed; now performed by - gnus-agent-request-article. - - * gnus-start.el (): Added defvar statements to resolve compilation - warnings. - (gnus-long-file-names): New function. Isolates platform dependent - msdos-long-file-names. - (gnus-save-startup-file-via-temp-buffer): New variable. Provides - option of writing directly to file. Avoids memory exhausted - errors when .newsrc.eld is huge. - (gnus-save-newsrc-file): Uses new - gnus-save-startup-file-via-temp-buffer. - (gnus-gnus-to-quick-newsrc-format): Rewritten to write to - standard-output. - (gnus-display-time-event-handler): Changed to alias from a defun - to avoid a compile-time warning when display-time-event-handler is - not defined. - * gnus-util.el (gnus-with-output-to-file): New macro. Binds - standard-output such that prin1 and princ will write directly to a - file. - - * gnus.el (gnus-agent-cache): Expanded documentation. - (gnus-summary-high-undownloaded-face): Removed second bold keyword - so that this face is actually bold. - - * nnkiboze.el (nnkiboze-request-article): Only use the cache when - gnus-use-cache has been set. - -2003-03-02 Jesper Harder - - * nnvirtual.el (nnvirtual-update-xref-header): Simplify. - -2003-03-01 Jesper Harder - - * gnus-art.el (gnus-article-refer-article): Be more permissive. - -2003-03-01 ShengHuo ZHU - - * spam.el: Fix typo. - -2003-03-01 Satyaki Das - - * pgg-gpg.el (pgg-gpg-process-region): Insert process status into - errors-buffer. This produces a nicer error message in case of - problems. - -2003-03-01 Teodor Zlatanov - - * spam.el (spam-maybe-spam-stat-load, spam-maybe-spam-stat-load): - load stats iff spam-use-stat is on - - * spam.el: add spam-maybe-spam-stat-load to gnus-startup hook, - also use spam-maybe-spam-stat-load and spam-maybe-spam-stat-save - instead of spam-stat-load and spam-stat-save in the - gnus-get-new-news-hook and gnus-save-newsrc-hook, respectively - -2003-03-01 ShengHuo ZHU - - * mm-view.el (mm-inline-text): Ignore errors from enriched-decode. - -2003-03-01 Lars Magne Ingebrigtsen - - * message.el (message-make-fqdn): Protect against nil user-mail. - -2003-02-28 Vasily Korytov - - * gnus-art.el (gnus-boring-article-headers): New values: - 'to-list and 'cc-list. - -2003-02-28 Teodor Zlatanov - - * spam.el (spam-setup-widening): new function to set - nnimap-split-download-body, we add it to gnus-get-new-news-hook - (spam-list-of-statistical-checks): list of statistical splitter - checks - (spam-split): added a widen call when a statistical check is - enabled - -2003-02-28 Reiner Steib - - * gnus-msg.el (gnus-user-agent): Changed default to - 'emacs-gnus-type, renamed 'full. - -2003-02-28 ShengHuo ZHU - - * nnfolder.el (nnfolder-request-accept-article): Don't use - mail-header-unfold-field. - -2003-02-27 ShengHuo ZHU - - * imap.el (imap-ssl-open): Don't depend on ssl.el. - * nntp.el (nntp-open-ssl-stream): Don't depend on ssl.el. - -2003-02-26 Teodor Zlatanov - - * spam.el: add spam-stat-load to gnus-get-new-news-hook - (spam-split): remove spam-stat-load call - -2003-02-26 Simon Josefsson - - * gnus-sum.el (gnus-summary-toggle-header): Run - gnus-article-decode-hook instead of calling a-decode-encoded-words - directly (the latter is run as part of the former). - -2003-02-26 ShengHuo ZHU - - * gnus-agent.el (gnus-agent-expire-group): Remove debug. - -2003-02-25 Jesper Harder - - * message.el (message-sendmail-envelope-from): New option. - (message-sendmail-envelope-from): New function. - (message-send-mail-with-sendmail): Use it. - -2003-02-25 Reiner Steib - - * gnus-art.el (gnus-button-mid-or-mail-heuristic-alist): Added - compensation for TDMA addresses. - -2003-02-24 Reiner Steib - - * gnus-msg.el (gnus-user-agent): New variable. - (gnus-version-expose-system): Removed. Obsoleted by - `gnus-user-agent'. - (gnus-extended-version): Use `gnus-user-agent'. - -2003-02-24 Teodor Zlatanov - - * spam.el (spam-stat-register-spam-routine, - spam-stat-register-ham-routine): remove spam-stat-save - (spam-stat hook): add spam-stat-save to the gnus-save-newsrc-hook - -2003-02-24 Kevin Greiner - - * gnus-group.el (gnus-topic-mode-p): Fixed free variable - reference. - -2003-02-24 Kevin Greiner - - * nnheader.el (nnheader-find-nov-line): Changed midpoint - calculation to avoid integer overflow. - -2003-02-24 Reiner Steib - - * gnus-start.el (gnus-backup-startup-file): Fixed custom type. - -2003-02-24 Ted Zlatanov - - * spam.el: disabled spam-get-article-as-filename - -2003-02-24 Michael Shields - - * gnus-group.el (gnus-group-is-exiting-without-update-p): New. - * gnus-sum.el (gnus-summary-exit-no-update): Use it. - * gnus-sum.el (gnus-summary-expire-articles): Use it. - * spam.el (spam-summary-prepare-exit): Use it. - * gnus.el (gnus-install-group-spam-parameters): New. - * spam.el (spam-group-ham-processor-copy-p): New. - * spam.el (spam-summary-prepare-exit): Support for ham copying. - * spam.el (spam-mark-spam-as-expired-and-move-routine): Fix bug - that would cause the current message to be moved if the group had - no spam. - * spam.el (spam-ham-move-routine): New `copy' argument. - -2003-02-24 Martin Thornquist - - * gnus-topic.el (gnus-topic-select-group): Select last group if - after last group. - * gnus-group.el (gnus-group-select-group): Ditto. - -2003-02-24 Katsumi Yamaoka - - * gnus-art.el (popup-menu): Compiler macro for Emacs 20. - (gnus-article-refer-article): Use gnus-point-at-(b|e)ol instead of - point-at-(b|e)ol which aren't available in Emacs 20. - - * gnus-registry.el (puthash): Alias to cl-puthash for Emacs 20. - -2003-02-23 Kevin Greiner - - * gnus-start.el (gnus-activate-group): Re-enabled the catch error - clause of the condition-case statement. Errors connecting to a - server no longer terminate gnus. - - * gnus-agent.el (gnus-agent-toggle-plugged): Renamed parameter to - make its use obvious. Added no-nothing case to avoid - opening(closing) servers when already open(closed). - (gnus-agent-while-plugged): Added macro to facilitate internal use - of gnus-agent-toggle-plugged. - (gnus-agent-fetch-group): Use new gnus-agent-while-plugged to - temporarily open servers. - (gnus-agent-get-undownloaded-list): Sort list of article numbers - as sorting gnus-newsgroup-headers is wrong. - (gnus-agent-summary-fetch-group): Use new gnus-agent-while-plugged - to temporarily open servers. Corrected logic to handle setting - gnus-agent-mark-unread-after-downloaded. - (gnus-agent-fetch-articles): Now handles headers with missing - article sizes and/or missing article lengths. Now clears the - message buffer when finished. - (gnus-agent-fetch-group-1): Position point before calling - gnus-summary-set-agent-mark. - (gnus-get-predicate): Corrected description, parameter is - predicate not category. - (gnus-agent-expire-group): Adapted the gnus-agent-expire-* code to - provide a separate single group expiration function. - (gnus-agent-regenerate-group): Now clears the message buffer when - finished. - -2003-02-23 Kai Gro,A_(Bjohann - - * gnus.el (gnus-agent-target-move-group-header): New variable. - * gnus-draft.el (gnus-draft-send): If special header - "X-Gnus-Agent-Target-Move-Group" is present, do like Gcc into - that group, instead of performing the regular sending functions. - -2003-02-23 Katsumi Yamaoka - - * gnus-xmas.el (gnus-xmas-mime-button-menu): Accept a prefix arg. - -2003-02-20 Reiner Steib - - * message.el (message-user-fqdn, message-valid-fqdn-regexp): New - variables. - (message-make-fqdn): Use it. Improved validity check. - -2003-02-23 Lars Magne Ingebrigtsen - - * message.el (message-user-mail-address): Check whether - user-mail-address looks valid. - - * gnus-msg.el (gnus-mailing-list-followup-to): New function. - - * gnus-util.el (gnus-fetch-original-field): New function. - -2003-02-23 Kai Gro,A_(Bjohann - - * message.el (message-mode): \\(...\\) around additional - paragraph-separate alternative. - -2003-02-23 Jesper Harder - - * gnus-art.el (gnus-mime-button-commands): Add ellipsis. - (gnus-mime-button-menu): Define MIME popup menu with easy-menu to - display key bindings. - (gnus-mime-button-menu): Rewrite. - -2003-02-23 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-button-url-regexp): Removed `. - -2003-02-23 Max Froumentin - - * gnus-art.el (gnus-button-url-regexp): Remove `, enter '. - -2003-02-23 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-mime-action-on-part): Require a match - interactively. - - * gnus-start.el (gnus-save-newsrc-file): Use - gnus-backup-startup-file. - (gnus-backup-startup-file): New variable. - -2003-02-22 Lars Magne Ingebrigtsen - - * gnus.el (gnus-summary-buffer-name): Moved function here. - - * gnus-draft.el (defun): Remove debug. - -2003-02-22 Jesper Harder - - * gnus-sum.el (gnus-summary-refer-article): Skip method if we - can't open server. - -2003-02-22 Lars Magne Ingebrigtsen - - * gnus-draft.el (defun): Configure posting styles. - - * gnus-start.el (gnus-get-unread-articles-in-group): Make sure - the entry for the group exists before we alter it. - -2003-02-22 David S. Goldberg (tiny change) - - * message.el (message-mode): MML tags separate paragraphs. - -2003-02-22 Kai Gro,A_(Bjohann - - * gnus-agent.el (gnus-agent-get-undownloaded-list): Sort - `gnus-newsgroup-headers'. - -2003-02-22 Karl Pfl,Ad(Bsterer - - * gnus-art.el (gnus-article-refer-article): Grok more message id - formats. - -2003-02-22 Jesper Harder - - * mm-decode.el (mm-path-name-rewrite-functions): Doc fix: don't - use "path name". - -2003-02-21 Teodor Zlatanov - - * gnus-sum.el (gnus-summary-move-article) - (gnus-summary-expire-articles): send data header for article, not - just article ID - - * gnus-registry.el (gnus-registry-hashtb, gnus-register-action) - (gnus-register-spool-action): added hashtable of message ID keys - with message motion data - -2003-02-21 Reiner Steib - - * gnus-art.el (gnus-button-mid-or-mail-heuristic-alist): New - variable, used in `gnus-button-mid-or-mail-heuristic'. - (gnus-button-mid-or-mail-heuristic): New function derived from - Florian Weimer's Perl script. - (gnus-button-handle-mid-or-mail): Allow a function instead of - 'guess. - (gnus-button-guessed-mid-regexp): Removed. - -2003-02-20 Katsumi Yamaoka - - * message.el (message-resend): Bind message-setup-hook to nil; - remove X-Draft-From header. - -2003-02-20 Jesper Harder - - * gnus-sum.el (gnus-simplify-subject-fully, gnus-subject-equal) - (gnus-newsgroup-undownloaded) - (gnus-summary-save-parts-default-mime, gnus-auto-select-next): - Doc fixes. - -2003-02-17 John Paul Wallington - - * gnus.el (gnus-shell-command-separator, gnus-email-address) - (gnus-default-charset, gnus-other-frame-parameters): Doc fixes. - -2003-02-20 Jesper Harder - - * gnus-spec.el (gnus-xmas-format): Use insert instead of - insert-string which is obsolete in Emacs 22.1. - - * message.el (message-cross-post-followup-to-header): do. - - * spam.el (spam-ifile-register-with-ifile) - (spam-stat-register-spam-routine) - (spam-stat-register-ham-routine) - (spam-bogofilter-register-with-bogofilter): do. - - * mailcap.el (mailcap-mime-data): Fix typo. - - * gnus-topic.el (gnus-topic-make-menu-bar): Add ellipsis. - -2003-02-19 Reiner Steib - - * gnus-cite.el (gnus-cite-unsightly-citation-regexp) - (gnus-cite-parse): Renamed `gnus-unsightly-citation-regexp' to - `gnus-cite-unsightly-citation-regexp'. - -2003-02-19 Katsumi Yamaoka - - * gnus-msg.el (gnus-copy-article-buffer): Copy an article header - even if there's just a header. - -2003-02-19 Jesper Harder - - * message.el (message-fix-before-sending): Fix highlighting of - illegible and invisible text. - - * gnus-util.el (gnus-multiple-choice): Separate choices with - ",,A (B". Suggested by Dan Jacobson . - -2003-02-18 Jesper Harder - - * gnus-sum.el (gnus-summary-exit-no-update): Use gnus-kill-buffer. - -2003-02-18 Teodor Zlatanov - - * spam.el (spam-ham-move-routine) - (spam-mark-spam-as-expired-and-move-routine): use - gnus-summary-kill-process-mark and gnus-summary-yank-process-mark - around process-mark manipulation on the group - -2003-02-17 Kai Gro,A_(Bjohann - - * gnus-sum.el (gnus-summary-make-menu-bar): Add MIME/Multipart - submenu. - -2003-02-17 Lars Magne Ingebrigtsen - - * mail-source.el (mail-source-fetch): Reverse the return value of - the continuation question. - -2003-02-16 Lars Magne Ingebrigtsen - - * nndraft.el (nndraft-request-move-article): Bind - nnmh-allow-delete-final to t. - -2003-02-14 ShengHuo ZHU - - * mm-uu.el (mm-uu-uu-filename): Fix use of character constant. - -2003-02-11 Stefan Monnier - - * nntp.el (nntp-accept-process-output): Don't use point-max to get - the buffer's size. - -2003-01-31 Joe Buehler - - * nnheader.el: Added cygwin to system-type comparisons. - -2003-01-27 Juanma Barranquero - - * imap.el (imap-mailbox-status): Fix typo. - -2003-02-14 ShengHuo ZHU - - * gnus-art.el (gnus-article-prepare): Don't set agent mark if - online. - -2003-02-14 Kai Gro,A_(Bjohann - - * gnus-agent.el (gnus-agent-group-make-menu-bar): Include all - commands. - * gnus-sum.el: Small change from Frank Weinberg - : - (gnus-auto-center-group): New variable. - (gnus-summary-read-group-1): Use it. - (gnus-summary-next-group): Fix docstring. - -2003-02-13 Katsumi Yamaoka - - * gnus-util.el (gnus-faces-at): Simplify. - -2003-02-13 Teodor Zlatanov - - * spam.el (spam-ham-move-routine) - (spam-mark-spam-as-expired-and-move-routine): made the article - move conditional, so it's not called even if there's nothing to move - -2003-02-13 Kurt B. Kaiser - - * message.el (message-unix-mail-delimiter): Accept any whitespace - after the email address and before the date; do not require the - space character. - -2003-02-13 Katsumi Yamaoka - - * gnus-art.el (gnus-article-only-boring-p): Make sure that the - gnus-article-boring-faces variable is bound; use gnus-faces-at. - - * gnus-util.el (gnus-faces-at): New macro. - -2003-02-13 Michael Shields - - * gnus-cite.el - (gnus-cite-attribution-suffix, gnus-cite-parse): - Better handling for Microsoft citation styles. - (gnus-unsightly-citation-regexp): New. - -2003-02-12 Michael Shields - - * gnus-art.el (article-strip-banner): Strip both per-group and - per-user-address banners. - (article-really-strip-banner): New. - -2003-02-12 Michael Shields - - * gnus-sum.el (gnus-article-goto-next-page, - gnus-article-goto-prev-page): Call gnus-summary-*-page, instead of - relying on the summary bindings of `n' and `p'. - -2003-02-12 Michael Shields - - * gnus-art.el (gnus-article-only-boring-p): New. - (gnus-article-skip-boring): New. - * gnus-cite.el (gnus-article-boring-faces): New. - * gnus-sum.el (gnus-summary-next-page): Use - gnus-article-only-boring-p. - -2003-02-12 Teodor Zlatanov - - * spam.el (spam-mark-spam-as-expired-and-move-routine) - (spam-ham-move-routine): unmark all articles before marking those - of interest and calling gnus-summary-move-article - -2003-02-12 Jesper Harder - - * gnus.el (gnus-kill-buffer): Move to gnus.el because it's - logically the complement of gnus-get-buffer-create and - gnus-add-buffer. - - * gnus-util.el (gnus-kill-buffer): do. - - * nnmail.el: Autoload gnus-kill-buffer. - -2003-02-11 Kevin Greiner - - * gnus-agent.el (gnus-summary-set-agent-mark): Added call to - gnus-summary-goto-subject as gnus-summary-update-mark operates on - the current LINE. - (gnus-agent-summary-fetch-group): Minimized the number of times - that the article is updated in the buffer. - -2003-02-11 Teodor Zlatanov - - * spam.el (spam-ham-move-routine): use the process-mark instead of - gnus-current-article when moving articles - (spam-mark-spam-as-expired-and-move-routine): ditto, use the process-mark - -2003-02-11 Lars Magne Ingebrigtsen - - * gnus-topic.el (gnus-topic-expire-articles): Recursive. - (gnus-topic-catchup-articles): Ditto. - (gnus-topic-mark-topic): Reverse recursive logic. - -2003-02-11 Jesper Harder - - * gnus-sum.el (gnus-summary-refer-thread): Handle case where - gnus-refer-thread-limit is t. - -2003-02-10 Jesper Harder - - * mm-util.el (mm-mule-charset-to-mime-charset): Use - sort-coding-systems to prefer utf-8 over utf-16. - -2003-02-09 Kevin Greiner - - * gnus-agent.el (gnus-agent-expire-days): - gnus-request-move-article depends on gnus-agent-expire to clean up - the cache after moving the article. Therefore, g-a-e-d can NOT - default to nil or can gnus-agent-expire be disabled by doing so. - If you don't want to run gnus-agent-expire, don't call it. - (gnus-agent-expire): The broken test to disable gnus-agent-expire - when g-a-e-d was NOT nil was removed. - (gnus-agent-article-name): Removed unnecessary input test as - article IDs are always strings. - (gnus-agent-regenerate-group): Added check to protect against - servers that generate absurdly long article IDs. Valid IDs are - less than 10 digits to avoid overflow errors. Fixed logic error - when ensuring that the final article ID is present in the new - alist. - -2003-02-09 Lars Magne Ingebrigtsen - - * gnus-topic.el (gnus-topic-goto-missing-topic): Just move to the - next line after finding the parent. - -2003-02-08 Lars Magne Ingebrigtsen - - * gnus.el (gnus-version-number): Bumped. - -2003-02-08 23:23:27 Lars Magne Ingebrigtsen - - * gnus.el: Oort Gnus v0.15 is released. - -2003-02-08 Michael Welsh Duggan - - * nnmail.el (nnmail-split-it): If a message ends up matching the - same mailbox more than once, it will cause duplicates to appear - in the mailbox. - -2003-02-08 Simon Josefsson - - * gnus-sum.el (gnus-summary-select-article): Remove blink removal - code that only worked under Emacs. - -2003-02-08 Satyaki Das - - * pgg-gpg.el (pgg-gpg-process-region): Don't blink. - -2003-02-08 Jesper Harder - - * gnus-art.el (gnus-article-refer-article): Use - gnus-replace-in-string. - - * gnus-util.el (gnus-map-function): Remove unneeded let-binding. - (gnus-remove-duplicates): do. - -2003-02-07 Teodor Zlatanov - - * gnus-int.el (gnus-internal-registry-spool-current-method): new variable - (gnus-request-scan): set - gnus-internal-registry-spool-current-method to gnus-command-method - before a request-scan operation - - * gnus-registry.el (regtest-nnmail): use - gnus-internal-registry-spool-current-method - -2003-02-07 Lars Magne Ingebrigtsen - - * mail-source.el (mail-source-fetch): Typo fix. - -2003-02-07 Teodor Zlatanov - - * nnmail.el (nnmail-spool-hook): new hook - (nnmail-cache-insert): call nnmail-spool-hook - - * gnus-registry.el: new file with examples of using the hooks - - * gnus.el (gnus-registry): added registry customization group - (gnus-group-prefixed-name): improve function to return full group - name optionally - (gnus-group-guess-prefixed-name): shortcut to - gnus-group-prefixed-name, using just the group name - (gnus-group-full-name): always get a group's full name - (gnus-group-guess-full-name): shortcut, using just the group name - - * gnus-sum.el (gnus-summary-article-move-hook) - (gnus-summary-article-delete-hook) - (gnus-summary-article-expire-hook): new hooks - (gnus-summary-move-article, gnus-summary-expire-articles) - (gnus-summary-delete-article): invoke the new hooks - -2003-02-07 Frank Weinberg - - * gnus-art.el (gnus-article-refer-article): Strip leading "news:" - from message-ID - -2003-02-07 Jesper Harder - - * gnus-util.el (gnus-run-hooks): Use save-current-buffer. - -2003-02-07 John Paul Wallington - - * mm-util.el (mm-delete-duplicates, mm-append-to-file) - (mm-write-region, mm-detect-coding-region): Doc fixes. - -2003-02-07 Lars Magne Ingebrigtsen - - * mail-source.el (mail-source-fetch): Ignore errors. - (mail-source-ignore-errors): New variable. - - * gnus-sum.el (gnus-summary-refer-thread): Don't re-fetch current - articles. - - * gnus-msg.el (gnus-version-expose-system): Change default. - -2003-02-07 Vasily Korytov - - * gnus-msg.el (gnus-version-expose-system): New variable. - -2003-02-07 Simon Josefsson - - * mml-sec.el (mml-unsecure-message): Don't use kill-region. Tiny - patch from deskpot@myrealbox.com (Vasily Korytov). - -2003-02-02 Lars Magne Ingebrigtsen - - * gnus-art.el (article-display-face): Get the Face header from - the current buffer. - -2003-02-06 Katsumi Yamaoka - - * gnus-art.el (gnus-mime-view-part-internally): Bind - buffer-read-only to nil. - -2003-02-05 Katsumi Yamaoka - - * gnus-agent.el (gnus-agent-expire-1,2): Pass the dir argument - from g-a-e-1 to g-a-e-2. - -2003-02-05 Teodor Zlatanov - - * spam.el (spam-check-BBDB): no need to regexp-quote the argument - of bbdb-search-simple, use spam-use-BBDB-exclusive - (spam-check-whitelist): use spam-use-whitelist-exclusive - (spam-use-whitelist-exclusive): new variable affecting - spam-use-whitelist - (spam-use-BBDB-exclusive): new variable affecting spam-use-BBDB - -2003-02-05 Simon Josefsson - - * gnus-agent.el (gnus-agent-expire-days): Change default to nil. - (gnus-agent-expire): Don't expire if g-a-e-d is nil. - (gnus-agent-expire): Move most code into gnus-agent-expire-1. - (gnus-agent-expire-1): New. - (gnus-agent-expire-1): Move code into gnus-agent-expire-2. - (gnus-agent-expire-2): New. - -2003-02-05 Jesper Harder - - * gnus-util.el (gnus-delete-if): Rename to gnus-remove-if. - "delete-if" is misleading because it isn't actually destructive. - - * gnus-topic.el (gnus-group-prepare-topics): Use new name. - - * nnmail.el (nnmail-purge-split-history): do. - - * gnus-win.el (gnus-get-buffer-window): do. - - * gnus-sum.el (gnus-simplify-whitespace): Remove unnecessary - let-binding. - (gnus-simplify-all-whitespace): do. - -2003-02-05 Katsumi Yamaoka - - * gnus-delay.el (gnus-delay-article): Fix binding of the - nndraft:delayed group. - -2003-02-04 Teodor Zlatanov - - * gnus.el (spam group parameters): change 'other to 'const in - the group parameter definitions to soothe XEmacs - -2003-02-04 Kai Gro,A_(Bjohann - - * gnus-delay.el (gnus-delay-article): Really create - nndraft:delayed group if it doesn't exist. - -2003-02-04 Jesper Harder - - * gnus-sum.el (gnus-summary-search-article): Speed up by - disabling various visual features while searching. - (gnus-summary-recenter): Test gnus-auto-center-summary first. - -2003-02-03 Jesper Harder - - * spam.el (spam-list-of-checks): Don't quote nil and t in - docstrings. From the elisp manual: - - When a documentation string refers to a Lisp symbol, write - it [..] with single-quotes around it. [..] There are two - exceptions: write t and nil without single-quotes. - - * messcompat.el (message-from-style): do. - - * message.el (message-send-mail): do. - - * gnus-util.el (gnus-use-byte-compile): do. - - * gnus-score.el (gnus-score-lower-thread): do. - - * gnus-int.el (gnus-server-unopen-status): do. - - * gnus.el (gnus-define-group-parameter, gnus-large-newsgroup) - (large-newsgroup-initial, gnus-install-group-spam-parameters): do. - - * gnus-cus.el (gnus-group-customize, gnus-score-parameters) - (gnus-group-parameters): do. - - * gnus-art.el (gnus-article-mime-match-handle-function): do. - - * mm-decode.el (mm-text-html-renderer): do. - -2003-02-02 Katsumi Yamaoka - - * nnheader.el (nnheader-directory-separator-character): Change the - way to compute the dafault value. - -2003-02-02 Jesper Harder - - * gnus-art.el (gnus-button-handle-describe-key): Implement it. - (gnus-button-alist): Fix regexp for describe-key. - (gnus-button-handle-describe-function) - (gnus-button-handle-describe-variable) - (gnus-button-handle-apropos, gnus-button-handle-apropos-command) - (gnus-button-handle-apropos-variable) - (gnus-button-handle-apropos-documentation): Docstring fix. - - * gnus-util.el (gnus-kill-buffer): Use get-buffer. - -2003-02-01 Lars Magne Ingebrigtsen - - * gnus-draft.el (gnus-group-send-queue): Bind gnus-posting-styles - to nil. - - * nnmail.el: Removed gnus-util autoload. - - * gnus.el: Use gnus-prin1-to-string throughout. - - * gnus-util.el (gnus-prin1-to-string): Bind print-length and - print-level. - - * gnus-art.el (article-display-x-face): Removed grey x-face stuff. - (gnus-treat-display-grey-xface): Removed. - - * gnus-fun.el (gnus-grab-cam-face): New. - (gnus-convert-image-to-gray-x-face): Removed. - (gnus-convert-gray-x-face-to-xpm): removed. - (gnus-convert-gray-x-face-region): Removed. - (gnus-grab-gray-x-face): Removed. - - * nnmail.el (nnmail-expiry-wait-function): Doc indent. - -2003-01-31 Jesper Harder - - * gnus-util.el (gnus-kill-buffer): Functions in gnus-util - shouldn't depend on the rest of Gnus, so test if gnus-buffers is - bound. - - * nnmail.el (nnmail-cache-close): Use gnus-kill-buffer. - -2003-01-30 Jesper Harder - - * gnus-cite.el (gnus-cite-reply-regexp, gnus-cite-always-check): - Remove -- these are bogus options which are never used. - -2003-01-29 Jesper Harder - - * gnus-art.el (gnus-article-mode): Use summary tool bar. - -2003-01-27 Teodor Zlatanov - - * spam.el (spam-check-blackholes) - (spam-blackhole-good-server-regex): new variable to skip some IPs - when checking blackholes; use it - (spam-check-bogofilter-headers) - (spam-bogofilter-bogosity-positive-spam-header): new variable, in - case more X-Bogosity is used than just "Yes/No" - (spam-ham-move-routine): semi-fixed, only first article is - properly moved now - -2003-01-27 Jesper Harder - - * gnus-util.el (gnus-kill-buffer): Remove buffer from gnus-buffers - as well. - - * gnus-sum.el (gnus-select-newsgroup): Use gnus-kill-buffer. - - * gnus-score.el (gnus-score-headers, gnus-score-find-bnews): do. - - * gnus-start.el (gnus-save-newsrc-file, gnus-clear-system): do. - - * gnus-bcklg.el (gnus-backlog-shutdown): do. - - * gnus-srvr.el (gnus-server-exit, gnus-browse-exit): do. - -2003-01-26 Lars Magne Ingebrigtsen - - * gnus-fun.el (gnus-face-encode): New function. - (gnus-convert-png-to-face): Use it. - - * gnus-sum.el (gnus-summary-make-menu-bar): Added M-& to marks. - -2003-01-26 Jesper Harder - - * mm-decode.el (mm-dissection-list): Remove. - (mm-dissect-singlepart): Don't push to mm-dissection-list, it's - only used in mm-remove-all-parts. - (mm-remove-all-parts): Remove it, it's never called. - -2003-01-25 Simon Josefsson - - * gnus-group.el (gnus-group-make-group): Report errors. - - * nnimap.el (nnimap-request-create-group): Ditto. - - * sieve-manage.el (sieve-manage-is-okno): Parse literal strings. - - * sieve.el (sieve-upload): Fix error printing. - - * mm-encode.el (mm-qp-or-base64): Always QP iff - mm-use-ultra-safe-encoding and cleartext PGP. - - * gnus-sum.el (gnus-summary-select-article): Inhibit - redisplay (mainly for secured messages). - - * nnmail.el (nnmail-article-group): Copy body too (but don't - process it). - -2003-01-25 Jesper Harder - - * gnus-art.el (gnus-article-setup-buffer): Reset - gnus-button-marker-list. - -2003-01-25 Lars Magne Ingebrigtsen - - * nntp.el (nntp-read-timeout): Default to using a second delay - under Microsoft Windows. - -2003-01-24 Lars Magne Ingebrigtsen - - * nnheader.el (nnheader-directory-separator-character): New - variable. - -2003-01-24 Kai Gro,A_(Bjohann - - * gnus-agent.el (gnus-agent-max-fetch-size) - (gnus-agent-article-alist, gnus-agent-get-undownloaded-list) - (gnus-agent-catchup, gnus-agent-summary-fetch-group) - (gnus-agent-fetch-articles, gnus-agent-backup-overview-buffer) - (gnus-agent-flush-cache, gnus-agent-fetch-headers) - (gnus-agent-braid-nov, gnus-agent-load-alist) - (gnus-agent-article-alist-save-format) - (gnus-agent-read-agentview, gnus-agent-save-alist) - (gnus-agent-fetch-group-1, gnus-agent-expire) - (gnus-agent-uncached-articles, gnus-agent-retrieve-headers) - (gnus-agent-regenerate-group): Reformat to keep under eighty - columns. Reword docstrings so that first line is under eighty - chars and a complete sentence. Still need to work on the rear - end of the file, in particular gnus-agent-expire. - -2003-01-24 Lars Magne Ingebrigtsen - - * gnus-agent.el (gnus-agentize): Indent. - - * gnus.el (gnus-version-number): Bumped. - -2003-01-24 20:32:44 Lars Magne Ingebrigtsen - - * gnus.el: Oort Gnus v0.14 is released. - -2003-01-24 Mark Thomas (tiny change) - - * gnus-sum.el (gnus-summary-prepare-threads): Reset state for %B - before beginning. - -2003-01-24 Teodor Zlatanov - - * spam.el (spam-check-blackholes, spam-split) - (spam-mark-junk-as-spam-routine, spam-summary-prepare-exit): added - gnus-message calls to show to users what spam.el is doing - -2003-01-24 Jesper Harder - - * gnus-msg.el (gnus-message-replysign) - (gnus-message-replyencrypt): Fix typo. - -2003-01-24 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-mime-security-show-details): Toggle showing - details. - -2003-01-23 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-press-button): let* -> let. - (gnus-mime-security-show-details): Cleaned up. - (gnus-mime-security-press-button): Save excursion. - (gnus-insert-mime-security-button): Clean up. - - * gnus-sum.el (gnus-summary-force-verify-and-decrypt): Doc fix. - - * gnus-async.el (gnus-async-wait-for-article): Don't use a - timeout. - - * nntp.el (nntp-accept-process-output): Removed timeout. - (nntp-read-timeout): New variable. - (nntp-accept-process-output): Use it. - - * gnus-sum.el (gnus-data-find-list): Remove *. - -2003-01-23 Kevin Greiner - - * gnus-sum.el (gnus-summary-first-subject): Fixed bug that I - introduced on 2002-01-22. - (gnus-summary-first-unseen-or-unread-subject): Ditto. - -2003-01-23 Teodor Zlatanov - - * spam.el (spam-check-regex-headers, spam-list-of-checks) - (spam-regex-headers-spam, spam-regex-headers-ham): added spam/ham - checks of incoming mail based on simple header regexp matching - -2003-01-22 Teodor Zlatanov - - * gnus-sum.el (gnus-spam-mark): set to `$' - -2003-01-22 Kevin Greiner - - * gnus-agent.el (gnus-agent-get-undownloaded-list): Now computes - gnus-newsgroup-unfetched, the list of articles whose headers have - not been fetched from the server. - - * gnus-sum.el (gnus-summary-find-next): Removed undownloaded - parameter as it never worked due to a bug. Added check to prevent - selection of any article in the gnus-newsgroup-unfetched list. - (gnus-summary-find-prev): Added check to prevent selection of any - article in the gnus-newsgroup-unfetched list. - (gnus-summary-first-subject): Documented API. Modified - implementation so that constraints are handled independently. - Added check to prevent selection of any article in the - gnus-newsgroup-unfetched list. - (gnus-summary-first-unseen-subject): Updated parameters in - gnus-summary-first-subject call to match new API. - (gnus-summary-first-unseen-or-unread-subject): Ditto. - (gnus-summary-catchup): Do not mark unfetched articles as read. - -2003-01-22 Jesper Harder - - * gnus-art.el (gnus-treat-strip-pgp, gnus-article-hide-pgp-hook): - make-obsolete-variable allows only two arguments in XEmacs and - Emacs 20. - - * gnus-sum.el (gnus-summary-wash-hide-map): Remove - gnus-article-hide-pgp. - (gnus-summary-make-menu-bar): do. - - * gnus-art.el (gnus-treat-strip-pgp): Make obsolete. - (gnus-treatment-function-alist): Remove gnus-treat-strip-pgp and - gnus-article-hide-pgp. - (article-hide-pgp): Remove. - (gnus-article-hide): Remove gnus-article-hide-pgp. - - * gnus.el: Remove gnus-article-hide-pgp - -2003-01-21 Lars Magne Ingebrigtsen - - * message.el (message-required-headers): Doc fix. - -2003-01-21 Teodor Zlatanov - - * spam.el (spam-group-ham-processor-bogofilter-p): fixed bug - (spam-ifile-register-ham-routine, spam-ifile-ham-category): new - option to make ifile a purely binary classifier - -2003-01-21 Lars Magne Ingebrigtsen - - * mml-sec.el (mml-secure-sign-pgpauto): Renamed. - (mml-secure-encrypt-pgpmime): Removed double. - - * gnus-sum.el (gnus-summary-mark-article-as-replied): Added - debugging statements. - -2003-01-21 Andreas Fuchs - - * mml-sec.el (mml-sign-alist): Added pgpauto. - -2003-01-21 Lars Magne Ingebrigtsen - - * gnus.el (gnus-version-number): Bumped version number. - -2003-01-21 07:15:41 Lars Magne Ingebrigtsen - - * gnus.el: Oort Gnus v0.13 is released. - -2003-01-21 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-button-url-regexp): Removed |. - - * message.el (message-send-hook): Doc fix. - - * gnus-win.el (gnus-buffer-configuration): Display article - instead of article-copy when `reply'. - -2003-01-21 Jesper Harder - - * gnus.el (gnus-format): Change customize group to gnus. - (gnus-cache): Add link. - (gnus-group-charter-alist): Fix docstring. - -2003-01-20 Jesper Harder - - * mailcap.el (mailcap-print-command): lpr-command might be - unbound in XEmacs. - -2003-01-18 Kevin Greiner - - * gnus-agent.el (gnus-agent-regenerate-group): Added interactive form. - - * gnus-sum.el (gnus-summary-update-article-line): Fixed - calculation of net characters added for use in the gnus-data - structure. - -2003-01-18 Kai Gro,A_(Bjohann - - * nnmail.el (nnmail-process-unix-mail-format): Improve error - message. Suggested by Jari Aalto. - -2003-01-17 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-followup-with-original): Clean up. - (gnus-article-reply-with-original): Ditto. - - * gnus-sum.el (gnus-summary-catchup): Make sure downloadable, - read articles don't become unread. - -2003-01-17 Simon Josefsson - - * gnus-fun.el (gnus-x-face-from-file): - (gnus-face-from-file): Suggest image format in minibuffer prompt. - - * gnus-fun.el (gnus-convert-image-to-x-face-command) - (gnus-convert-image-to-face-command): Doc fix. - -2003-01-17 Lars Magne Ingebrigtsen - - * gnus-fun.el (gnus-convert-face-to-png): Protect against errors. - -2003-01-17 Jesper Harder - - * gnus-art.el (gnus-mime-print-part): Use mm-save-part-to-file to - avoid encoding problems. - - * mailcap.el (mailcap-ps-command): New variable. - (mailcap-mime-data): Add print entry where applicable. Use - pdftotext on a tty. - -2003-01-16 ShengHuo ZHU - - * gnus-sum.el (gnus-alter-header-function): Add type and group. - -2003-01-16 Simon Josefsson - - * gnus-fun.el (gnus-convert-image-to-x-face-command) - (gnus-convert-image-to-face-command, gnus-x-face-from-file) - (gnus-face-from-file): Doc fix; don't mention image format. - -2003-01-16 Teodor Zlatanov - - * spam.el (spam-get-article-as-filename): new function (unused for now) - (spam-get-article-as-buffer): new function - (spam-get-article-as-string): use spam-get-article-as-buffer - (spam-summary-prepare-exit): fixed bug, noticed by Malcolm Purvis - -2003-01-15 ShengHuo ZHU - - * gnus-agent.el: Don't use `path'. - From the GNU coding standards: - - Please do not use the term ``pathname'' that is used in Unix - documentation; use ``file name'' (two words) instead. We use - the term ``path'' only for search paths, which are lists of - directory names. - - * nnsoup.el (nnsoup-file-name): Ditto. - - * nnmail.el (nnmail-pathname-coding-system): Ditto. - (nnmail-group-pathname): Ditto. - - * nnimap.el (nnimap-group-overview-filename): Ditto. - - * nnheader.el (nnheader-pathname-coding-system): Ditto. - (nnheader-group-pathname): Ditto. - - * nnfolder.el (nnfolder-group-pathname): Ditto. - - * gnus.el (gnus-home-directory): Ditto. - - * gnus-group.el (gnus-group-icon-list): Ditto. - -2003-01-16 Jesper Harder - - * gnus-art.el (gnus-mime-print-part): Use mm-handle-media-type. - - * message.el (message-mode-menu): Use it. - (message-mode-menu): Deactivate "Yank Original" if there's no - reply buffer. - - * messagexmas.el (message-xmas-redefine): Redefine in XEmacs. - - * message.el (message-mark-active-p): New function. - -2003-01-15 Teodor Zlatanov - - * spam.el (spam-use-bogofilter-headers, spam-bogofilter-header) - (spam-bogofilter-database-directory): new variables - (spam-check-bogofilter-headers, spam-check-bogofilter) - (spam-bogofilter-register-with-bogofilter) - (spam-bogofilter-register-spam-routine) - (spam-bogofilter-register-ham-routine) - (spam-group-ham-processor-bogofilter-p): new functions for the new - Bogofilter interface - (spam-summary-prepare-exit): use the new Bogofilter functions - (spam-list-of-checks): added spam-use-bogofilter-headers - (spam-bogofilter-score): rewrote function - (spam-check-bogofilter): optional score parameter, uses - spam-check-bogofilter-headers better - (spam-check-bogofilter-headers): optional score parameter - - * gnus.el (gnus-install-group-spam-parameters): new variable, t by - default, in the gnus-start customization group. Used to disable - the spam-*/ham-* parameters. - (gnus-group-ham-exit-processor-bogofilter): new ham processor - -2003-01-15 Jesper Harder - - * gnus-xmas.el (gnus-xmas-redefine): Use region-exists-p in - XEmacs. - - * gnus-ems.el (gnus-mark-active-p): do. - -2003-01-15 Kevin Ryde - - * gnus.texi (Using MIME): Mention auto-compression-mode with - gnus-mime-copy-part. - -2003-01-15 Lars Magne Ingebrigtsen - - * message.el (message-send): Don't warn about duplicates when - superseding. - -2003-01-15 Simon Josefsson - - * nnimap.el (nnimap-split-download-body): New variable. - (nnimap-split-articles): Use it. - -2003-01-14 Kevin Greiner - - * gnus-agent.el (gnus-agent-check-overview-buffer): This data - integrity checker was incorrectly flagging, and removing, articles - whose article number was negative. - (gnus-agent-fetch-group-1): When executed in the group's summary - buffer, refresh each downloaded line to update the status flag and - font. Preserve the value of gnus-newsgroup-headers so that - gnus-agent-fetch-articles can split the requests by size. - (gnus-agent-expire): Corrected day calculation for when - gnus-agent-expire-days contains a list. - -2003-01-14 Lars Magne Ingebrigtsen - - * gnus-audio.el (gnus-audio-au-player): Use executable-find. - -2003-01-13 Jhair Tocancipa Triana - - * gnus-audio.el (gnus-audio-au-player, gnus-audio-wav-player): Use - /usr/bin/play as default player. - (gnus-audio-play): Added ARG-DESCRIPTOR to prompt for a file to play. - -2003-01-14 Katsumi Yamaoka - - * gnus-msg.el (gnus-inews-add-send-actions): Allow a list of - articles to be marked as well. - -2003-01-14 Kevin Greiner - * gnus-agent.el (gnus-agent-get-undownloaded-list): Include the - fictious headers generated by nnagent (ie. Undownloaded Article - ####) in the list of articles that have not been downloaded. - - * gnus-int.el (): Added require declarations to resolve - compile-time warnings. - (gnus-open-server): If the server status is set to offline, - recursively execute gnus-open-server to open the offline backend - (e.g. nnagent). - -2003-01-14 Jesper Harder - - * gnus-art.el (gnus-article-reply-with-original): Use - gnus-mark-active-p. - (gnus-article-followup-with-original): do. - -2003-01-13 Reiner Steib - - * gnus-sum.el: Removed `(when t ...)' around `gnus-define-keys'. - -2003-01-13 Reiner Steib - - * gnus-score.el (gnus-score-edit-file-at-point): New function. - (gnus-score-find-trace): Bind it to `e' key. Added `q' for quit. - -2003-01-13 Romain FRANCOISE - - * gnus-fun.el (gnus-x-face-from-file): Quote file name. - (gnus-face-from-file): Ditto. - -2003-01-13 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-articles-to-read): Don't just apply - gnus-alter-articles-to-read-function to the unread articles. - -2003-01-13 Reiner Steib - - * deuglify.el (gnus-article-outlook-unwrap-lines) - (gnus-article-outlook-repair-attribution) - (gnus-article-outlook-rearrange-citation): New function names, - renamed from "gnus-outlook-" to "gnus-article-outlook-". Changed - doc-string. - - * gnus-sum.el (gnus-summary-mode-map): Use new function names, - removed `W k' key binding (use `W Y f' instead). - (gnus-summary-make-menu-bar): Use new function names. - -2003-01-13 Simon Josefsson - - * gnus-fun.el (gnus-random-x-face): Doc fix. - (gnus-insert-random-x-face-header): New function. - -2003-01-13 Jesper Harder - - * gnus-sum.el (gnus-summary-make-menu-bar): Deactivate items if - mark is not active. - - * gnus-msg.el (gnus-inews-do-gcc): Comment. - - * gnus-ems.el (gnus-mark-active-p): New function. - - * gnus-group.el (gnus-topic-mode-p): New function. - (gnus-group-make-menu-bar): Show more key bindings in topic mode. - Deactivate items if mark is not active. - -2003-01-12 Lars Magne Ingebrigtsen - - * gnus.el (gnus-version-number): Bumped version. - (gnus-summary-line-format): Doc fix. - -2003-01-12 22:02:49 Lars Magne Ingebrigtsen - - * gnus.el: Oort Gnus v0.12 is released. - -2003-01-12 Lars Magne Ingebrigtsen - - * mail-source.el (mail-sources): Removed autoload to make it - compile under XEmacs. - -2003-01-12 Raymond Scholz - - * gnus-msg.el (gnus-confirm-mail-reply-to-news): May be a - regexp or a function too. - (gnus-confirm-treat-mail-like-news): New variable. Ask for - confirmation even if the original article is mail. - -2003-01-12 Lars Magne Ingebrigtsen - - * gnus-msg.el (gnus-inews-add-send-actions): Get the right - articles to be marked when not yanking. - -2003-01-12 Fran,Ag(Bois-David Collin - - * mm-decode.el (mm-get-part): Use mm-with-unibyte-current-buffer. - -2003-01-12 Lars Magne Ingebrigtsen - - * gnus-fun.el (gnus-face-from-file): Autoload. - - * gnus-cite.el (gnus-cite-delete-overlays): Protect against more - errors. - -2003-01-12 Simon Josefsson - - * sieve.el (sieve-upload-and-bury): New. Suggested by - kai.grossjohann@uni-duisburg.de (Kai Gro,A_(Bjohann). - - * sieve-mode.el (sieve-mode-map): Bind s-u-a-b to C-c C-c. - Suggested by kai.grossjohann@uni-duisburg.de (Kai Gro,A_(Bjohann). - -2003-01-12 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-ignored-headers): Don't include the ^ and : - in every string. - - * gnus.el (gnus-version-number): Bumped version number. - -2003-01-12 13:46:20 Lars Magne Ingebrigtsen - - * gnus.el: Oort Gnus v0.11 is released. - -2003-01-12 Jesper Harder - - * message.el (message-fetch-reply-field): Narrow to headers. - - * gnus-msg.el (gnus-inews-do-gcc): Don't try to mark GCC's as read - if Gnus isn't alive. - -2003-01-11 Kevin Greiner - - * gnus-agent.el (gnus-agent-fetch-group-1): Remove downloadable - marks from articles that are already stored in the agent. - (gnus-agent-backup-overview-buffer): New debug tool. Creates a - backup copy of an invalid .overview file for later analysis. - -2003-01-12 Gregorio Gervasio, Jr. - - * gnus-sum.el (gnus-summary-exit): Reverse change to make group - exit work with two frames. - -2003-01-11 Fran,Ag(Bois-David Collin - - * message.el (message-forward-make-body): Use mule4. - -2003-01-11 Lars Magne Ingebrigtsen - - * message.el (message-mode-map): Move wide-reply command. - -2003-01-10 Reiner Steib - - * deuglify.el (gnus-outlook-deuglify-attrib-verb-regexp): Added - castellano. - (gnus-outlook-display-hook): New variable. - (gnus-outlook-display-article-buffer): New function. - (gnus-outlook-unwrap-lines, gnus-outlook-repair-attribution) - (gnus-outlook-deuglify-article): Made them interactive and added - optional arg. Use `g-o-d-a-b'. - (gnus-article-outlook-deuglify-article): Use `g-o-d-a-b'. - - * gnus-sum.el: Added autoloads. - (gnus-summary-mode-map): Added gnus-summary-wash-deuglify-map. - (gnus-summary-make-menu-bar): Added "(Outlook) Deuglify" menu. - -2003-01-11 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-display-mime): Use the mime emulation - variable. - - * gnus-sum.el (gnus-article-emulate-mime): New variable. - - * gnus-start.el (gnus-read-newsrc-el-file): Make sure that the - newsrc-alist is initialized properly. - - * mail-source.el (mail-sources): Autoload. - - * gnus-sum.el (gnus-summary-make-false-root-always): Default to - nil. - - * gnus-msg.el (gnus-configure-posting-styles): Make sure we don't - insert two newlines. - - * message.el (message-check-news-header-syntax): Compute the - header length correctly. - -2003-01-10 Kevin Greiner - - * gnus-agent.el (gnus-agent-expire): Do not remove article from - alist when keeping fetched article file. - (gnus-agent-retrieve-headers): When parsing response for article - numbers, use the same algorithm as gnus-agent-braid-nov to protect - against garbage in the server's response. - - * gnus-int.el (gnus-request-expire-articles, - gnus-request-move-article): Only expire when the group's server - has been agentized. - -2003-01-10 Lars Magne Ingebrigtsen - - * gnus-cite.el (gnus-cite-delete-overlays): Protect against - errors when deleting overlays. - - * gnus-score.el (gnus-score-followup): Allow tracing. - - * gnus-art.el (gnus-treat-display-face): New variable. - (article-display-face): New command. - - * gnus-fun.el (gnus-face-from-file): New function. - (gnus-convert-face-to-png): Ditto. - - * gnus-art.el (gnus-ignored-headers): Added Face. - -2003-01-10 Simon Josefsson - - * nndraft.el (nndraft-request-group): Avoid crash in - directory-files when draft directory doesn't exists. - - * gnus-sum.el (gnus-select-article-hook): Add :option. - -2003-01-10 Teodor Zlatanov - - * spam.el (spam-use-stat): new variable - (spam-group-spam-processor-stat-p) - (spam-group-ham-processor-stat-p): new convenience functions - (spam-summary-prepare-exit): add spam/ham processors to sequence - (spam-list-of-checks): add spam-use-stat to list of checks - (spam-split): conditionally load the spam-stat tables - (spam-stat-register-spam-routine, spam-stat-register-ham-routine, - spam-check-ifile): new functions - - * spam-stat.el (spam-stat): typo fix - (spam-stat-install-hooks): new variable - (spam-stat-split-fancy-spam-group): added documentation clarification - (spam-stat-split-fancy-spam-threshhold): new variable - (spam-stat-install-hooks): make hooks conditional - (spam-stat-split-fancy): use spam-stat-split-fancy-spam-threshhold - - * gnus.el (gnus-group-ham-exit-processor-stat, spam-process): add - spam-stat ham/spam processor symbols - -2003-01-10 Lars Magne Ingebrigtsen - - * gnus-start.el (gnus-read-newsrc-el-file): Make sure the .eld - file exists. - -2003-01-10 Simon Josefsson - - * gnus-sum.el (gnus-summary-read-group-1): Don't select first - undownloaded/downloadable only when unplugged. - -2003-01-10 Jesper Harder - - * gnus-srvr.el (gnus-browse-foreign-server): Optimize inner loop. - -2003-01-09 Teodor Zlatanov - - * spam.el (spam-check-ifile): fixed call-process-region to use the - db parameter only if it's set - (spam-ifile-register-with-ifile): ditto - -2003-01-09 Alex Schroeder - - * spam-stat.el (spam-stat-save): Set spam-stat-ngood and - spam-stat-nbad before creating the hash table. - (spam-stat-reset): Set spam-stat-ngood and spam-stat-nbad to 0. - Changed copyright statement to FSF. - -2003-01-09 Kevin Greiner - - * gnus-agent.el (gnus-agent-catchup): Do not mark cached nor - processable articles as read. - (gnus-agent-summary-fetch-series): Remove processable and - downloadable marks on all downloaded articles in the series. - - * nntp.el (nntp-report): Throw error after reporting the problem. - (nntp-accept-process-output): Corrected error check to report an - error when the process is nil. - -2003-01-09 Simon Josefsson - - * message.el (message-tool-bar-map): Add preview. - -2003-01-09 Jesper Harder - - * mml.el (mml-preview): Get rid of MIME handles and buffers after - previewing. - -2003-01-08 Paul Jarc - - * nnmaildir.el (nnmaildir--grp-add-art): Fix wrong-type-argument - bug when the (n+1)th article to be added to a group has a smaller - number than the n articles already added. - -2003-01-08 Jesper Harder - - * message.el (message-mode-field-menu): Use backquote. - -2003-01-08 Teodor Zlatanov - - * spam.el: fixed the BBDB autoloads again, using - bbdb-search-simple now (which is not a macro, thank god) - - * lpath.el (bbdb-search): removed function from maybe-fbind list - - * gnus.el (ham-process-destination): added new parameter for - destination of ham articles found in spam groups at summary exit - - * spam.el (spam-get-ifile-database-parameter): use spam-ifile-database-path - (spam-check-ifile, spam-ifile-register-with-ifile): use spam-get-ifile-database-parameter - (spam-ifile-database-path): added new parameter for ifile's database - (spam-move-spam-nonspam-groups-only): new parameter to determine - if spam should be moved from all groups or only some - (spam-summary-prepare-exit): fixed logic to use - spam-move-spam-nonspam-groups-only when deciding to invoke - spam-mark-spam-as-expired-and-move-routine; always invoke that - routine after the spam has been expired-or-moved in case there's - some spam left over; use spam-ham-move-routine in spam groups - (spam-ham-move-routine): new function to move ham articles to the - ham-process-destinations group parameter - -2003-01-08 Lars Magne Ingebrigtsen - - * gnus-spec.el (gnus-parse-complex-format): %~ => ~*. - - * gnus-agent.el (gnus-agent-fetch-selected-article): Use - gnus-summary-update-article-line. - -2003-01-08 Simon Josefsson - - * nnmail.el (nnmail-expiry-target-group): Request group, create it - not successful. - -2003-01-08 Katsumi Yamaoka - - * lpath.el (bbdb-records): Fbind it for both Emacs and XEmacs. - -2003-01-07 Teodor Zlatanov - - * spam.el (spam-check-ifile): fixed the spam-ifile-all-categories - logic, finally - -2003-01-08 Lars Magne Ingebrigtsen - - * gnus-spec.el (gnus-parse-format): %C is a complex format. - (gnus-parse-format): Change to %~. - - * message.el (message-generate-headers): Don't generate optional - empty headers. - -2003-01-07 Reiner Steib - - * message.el (message-cross-post-default) - (message-cross-post-note-function, message-shoot-gnksa-feet) - (message-strip-subject-trailing-was, message-change-subject) - (message-mark-insert-file, message-cross-post-followup-to) - (message-cross-post-followup-to, message-mode-map) - (message-generate-unsubscribed-mail-followup-to) - (message-make-mail-followup-to): Minor changes to doc-strings and - error messages. Updated copyright line. - - * message.el (message-make-mail-followup-to, - message-generate-unsubscribed-mail-followup-to): New function - names. Renamed functions: "-mft" -> "-mail-followup-to". - (message-make-mft, message-gen-unsubscribed-mft): Removed function - names. - - * mml.el (mml-preview-insert-mail-followup-to): New function name. - (mml-preview-insert-mft): Removed function name. - (mml-preview): Use new function names. - - * gnus-art.el (gnus-article-edit-mode-map): Use new function names. - - * message.el (message-mode-field-menu): Moved header related - commands from "Message" to "Field" menu. - -2003-01-07 Reiner Steib - - * message.el (message-generate-headers-first): Added customization - if variable is a list. - -2003-01-07 Michael Shields - - * gnus-art.el (gnus-article-next-page): Correctly handle the case - where the last line of the article is the last line of the window. - -2003-01-08 Lars Magne Ingebrigtsen - - * gnus-msg.el (gnus-debug): Use ignore-errors. - - * gnus-agent.el (gnus-agent-fetch-selected-article): Use - `gnus-summary-update-line'. - -2003-01-08 Simon Josefsson - - * gnus-art.el (gnus-unbuttonized-mime-types) - (gnus-buttonized-mime-types): Doc fix. - -2003-01-08 Jesper Harder - - * mm-decode.el (mm-inline-media-tests): .xpm is 'x-xpixmap'. - -2003-01-07 ShengHuo ZHU - - * nnrss.el (nnrss-group-alist): Add and clear up. - -2003-01-07 Teodor Zlatanov - - * spam.el: removed unnecessary condition-case for loading bbdb-com.el - - * lpath.el (bbdb-search): added BBDB functions for a better way to - fix missing functions - - * spam.el (spam-check-ifile): if should be an unless - - * spam.el: define 'ignore alias for spam-BBDB-register-routine, - spam-enter-ham-BBDB, and bbdb-create-internal initially to hush up warnings - (spam-ifile-all-categories): doc string fixed to be less than 80 chars - -2003-01-07 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-make-menu-bar): Added - gnus-summary-refer-thread to thread menu. - -2003-01-07 Kevin Greiner - - * gnus-agent.el (gnus-agent-fetch-group-1): When fetching within a - summary buffer, articles that cannot be fetched are marked as - canceled. - - * nntp.el (nntp-with-open-group): The quit signal handler must - propagate the quit signal to the next outer handler so that the - caller knows that the request aborted abnormally. - -2003-01-07 Teodor Zlatanov - - * spam.el (spam-check-ifile, spam-ifile-register-with-ifile) - (spam-ifile-register-spam-routine) - (spam-ifile-register-ham-routine): added ifile functionality that - does not use ifile-gnus.el to classify and register articles - (spam-get-article-as-string): convenience function - (spam-summary-prepare-exit): added ifile spam and ham registration - (spam-ifile-all-categories, spam-ifile-spam-category) - (spam-ifile-path, spam-ifile): added customization options - - * gnus.el (gnus-group-ham-exit-processor-ifile): added ifile ham - exit processor - (spam-process): added gnus-group-ham-exit-processor-ifile to the - list of choices - -2003-01-07 Lars Magne Ingebrigtsen - - * gnus-score.el (gnus-score-followup): Also score immediate - followups. - -2003-01-06 Lars Magne Ingebrigtsen - - * nnweb.el (nnweb-asynchronous-p): Changed to nil. - -2003-01-07 Simon Josefsson - - * message.el (message-mode-menu): Fix receipt balloon help. - -2003-01-07 Jesper Harder - - * gnus-msg.el (gnus-group-post-news): Don't assume that "" will - always be interpreted as news. - -2003-01-07 Simon Josefsson - - * gnus-sieve.el (gnus-sieve-script): Use the crosspost argument to - gnus-sieve-script, instead of the global variable - gnus-sieve-crosspost. One-line patch from Steinar Bang - . - -2003-01-06 Kevin Greiner - - * gnus.el: Renamed gnus-summary-*-uncached-face as - gnus-summary-*-undownloaded-face to avoid confusing the agent with - the cache. - - * gnus-sum.el: Ditto. - -2003-01-06 Kevin Greiner - - * gnus-agent.el (gnus-agent-fetch-group): Modified to permit execution - in either the group or summary buffer. - New command "JS", in summary buffer, will fetch articles per the - group's category, predicate, and processable flags. - (gnus-agent-summary-fetch-series): Rewritten to call - gnus-agent-session-fetch-group once with all articles in the - series. - (gnus-agent-summary-fetch-group): Fixed bug and modified code to - return list of fetched articles. - (gnus-agent-fetch-articles): Split fetch list into sublists such - that the article buffer is only slightly larger than - gnus-agent-max-fetch-size. Added unwind-protect to ensure that - the group's article alist is saved. - (gnus-agent-fetch-headers): The 'killed' and 'cached' marks no - longer result in the agent trying to fetch an article. - (gnus-agent-fetch-group-1): Can now be called in either the group - or summary buffer. Removed the max-fetch-size code that I added - on 2002-12-13 as that capability is now part of - gnus-agent-fetch-articles. Added code to update summary buffer. - When called in the group buffer, articles that can not be fetched - are AUTOMATICALLY MARKED AS READ. - - * gnus-sum.el (): Modified eval-when-compile to minimize - misleading compilation warnings. - (gnus-update-summary-mark-positions): Changed code to use - gnus-undownloaded-mark rather than gnus-downloaded-mark. - - * nnheader.el (nnheader-insert-nov-file): Do not try to insert an - empty file as the parser assumes that the file isn't empty. - - * nntp.el (nntp-send-string): The process-send-string call can, - because it performs I/O on the process, change the process' state - from open to closed. If this happens, call nntp-report - immediately to report the broken connection. - (nntp-report): Rewritten to avoid needing a global variable to - determine the appropriate course of action. Instead, two function - implementations are provided and the nntp-report function value is - bound to the appropriate implementation. - (nntp-retrieve-data): Moved nntp-report call to end of implementation. - (nntp-with-open-group): Now binds nntp-report's function cell - rather than binding gnus-with-open-group-first-pass. Added a - condition-case to detect a quit during a nntp command. When the - quit occurs, the current connection is closed as a fetch articles - request could have several megabytes queued up for reading. - (nntp-retrieve-headers): Bind articles to itself. If - nntp-with-open-group repeats this command, I must have access to - the original list of articles. - (nntp-retrieve-groups): Ditto for groups. - (nntp-retrieve-articles): Ditto for articles. - (*): Replaced nntp-possibly-change-group calls to - nntp-with-open-group forms in all, but one, occurrance. - (nntp-accept-process-output): Bug fix. Detect when called with - null process. - -2003-01-06 Jesper Harder - - * mm-util.el (mm-find-mime-charset-region): Don't do Latin-9 hack - if we don't need to. - (mm-iso-8859-x-to-15-region): Fix misplaced parenthesis. - -2003-01-06 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-make-web-group): Pass the select - method on to group-create. - (gnus-group-line-format-alist): %U is an integer. - - * gnus-sum.el (gnus-summary-exit-no-update): Don't update - ephemeral groups. - (gnus-summary-read-group-1): Ditto. - (gnus-group-make-articles-read): Ditto. - - * mm-url.el (mm-url-program): Doc fix. - - * message.el (message-mode-map): Rebound - message-insert-wide-reply. - -2003-01-05 Katsumi Yamaoka - - * gnus-xmas.el (gnus-xmas-group-startup-message): Bind the oort - color as `gnus-group-startup-message' does. - -2003-01-05 Teodor Zlatanov - - * spam.el: fixed line lengths to 80 chars or less - - * gnus-sum.el (gnus-read-mark-p): added the spam-mark as a - "not-read" mark - (gnus-summary-mark-forward): added the spam-mark to the list of - marks not to be marked as "read" when viewed - -2003-01-05 Lars Magne Ingebrigtsen - - * gnus-msg.el (gnus-inews-make-draft): Quote article-reply. - - * gnus-group.el (gnus-number-of-unseen-articles-in-group): - Protect against unactive groups. - - * message.el (message-check-news-header-syntax): Check long - header lines. - (message-check-news-header-syntax): Update `start'. - - * gnus-group.el (gnus-group-expire-articles): Doc fix. - (gnus-group-line-format): %U. - (gnus-group-line-format-alist): ?U. - (gnus-number-of-unseen-articles-in-group): New function. - - * nntp.el (nntp-accept-process-output): Use a 0.1 second timeout. - - * gnus.el (gnus-version-number): Bump version number. - -2003-01-05 01:53:30 Lars Magne Ingebrigtsen - - * gnus.el: Oort Gnus v0.10 is released. - -2003-01-05 Lars Magne Ingebrigtsen - - * gnus.el (gnus-version-number): Fix version number. - -2003-01-05 01:40:09 Lars Magne Ingebrigtsen - - * gnus.el: Oort Gnus v0.08 is released. - -2003-01-04 Jesper Harder - - * mm-util.el: Add mm-string-make-unibyte. - - * gnus-group.el (gnus-group-jump-to-group): Make it work for - UTF-8 groups. - -2003-01-04 Lars Magne Ingebrigtsen - - * gnus.el (gnus-variable-list): Write gnus-format-specs last. - - * gnus-sum.el (gnus-summary-goto-subjects): Fix typo. - -2003-01-04 Kevin Ryde - - * gnus-art.el (gnus-mime-jka-compr-maybe-uncompress): New - function. - -2003-01-04 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-exit): Bind gnus-group-is-exiting-p. - (gnus-summary-read-group-1): Update group line. - (gnus-summary-exit-no-update): Update group on exit. - - * gnus-group.el (gnus-group-line-format): Add %*. - (gnus-group-line-format-alist): Ditto. - (gnus-group-insert-group-line): Set it. - (gnus-group-is-exiting-p): New variable. - (gnus-group-insert-group-line): Use it. - -2003-01-03 Teodor Zlatanov - - * spam.el (spam-enter-ham-BBDB, spam-BBDB-register-routine): - enable BBDB ham processing - (spam-blacklist-register-routine): enable blacklist spam processing - (spam-whitelist-register-routine): enable whitelist ham processing - (spam-fetch-field-from-fast): fast fetching of the "from" field - from (gnus-data-list) - (spam-summary-prepare-exit): works completely now - (spam-use-blacklist): oops, should be nil by default - (spam-summary-prepare-exit): spam-use-PROCESSOR is only for - split processing now; before it was for summary exit as - well but that's done with the spam-contents and spam-process - parameters now - -2003-01-03 Jesper Harder - - * mml.el (mml-insert-tag): Don't quote non-ASCII unibyte - characters. - -2003-01-02 Teodor Zlatanov - - * spam.el (spam-group-spam-contents-p, spam-group-ham-contents-p) - (spam-group-processor-p, spam-group-processor-bogofilter-p) - (spam-group-processor-ifile-p, spam-group-processor-blacklist-p) - (spam-group-processor-whitelist-p, spam-group-processor-BBDB-p) - (spam-mark-spam-as-expired-and-move-routine) - (spam-generic-register-routine, spam-BBDB-register-routine) - (spam-ifile-register-routine, spam-blacklist-register-routine) - (spam-whitelist-register-routine): new functions - (spam-summary-prepare-exit): added summary exit processing (expire - or move) of spam-marked articles for spam groups; added slots for - all the spam-*-register-routine functions - -2003-01-03 Lars Magne Ingebrigtsen - - * pop3.el (pop3-retr): Wait 500 msecs. - (pop3-read-response): Ditto. - - * gnus-msg.el (gnus-setup-message): Get the evaliation order - right. - (gnus-inews-make-draft): New function. - (gnus-setup-message): Use it. - - * message.el (message-required-headers): Add From. - -2003-01-02 Norbert Koch (tiny change) - - * gnus-msg.el (gnus-gcc-externalize-attachments): Fix typo. - -2003-01-02 Lars Magne Ingebrigtsen - - * message.el (message-generate-headers): Let header formatters do - their work. - -2003-01-02 Raymond Scholz - - * deuglify.el (gnus-article-outlook-deuglify-article): - Rehighlight, reapply treatments and call - `gnus-article-prepare-hook'. Suggested by Niels Olof Bouvin. - (gnus-outlook-repair-attribution-block): Recognize cited - attributions. Suggested by Niklas Morberg. - -2003-01-02 Pete Kazmier - - * gnus-art.el (gnus-treat-predicate): Check condition first. - -2003-01-02 Jesper Harder - - * lpath.el: Add url-http-file-exists-p. - - * gnus-group.el (gnus-group-fetch-charter): Use - http://TLH.news-admin.org/charters/GROUPNAME as a fallback. - -2003-01-02 Lars Magne Ingebrigtsen - - * message.el (message-draft-headers): Also generate From to get a - nicer draft buffer summary. - - * gnus-xmas.el (gnus-xmas-read-event-char): Take an optional - parameter. - - * gnus-art.el (article-wash-html): Clean up. - (article-wash-html): Typo fix. - - * gnus-msg.el (gnus-summary-mail-forward): Clean up. - (gnus-summary-mail-forward): To many lists of lists. - - * gnus-art.el (article-wash-html): Clean up. - -2003-01-02 pete-temp - - * gnus-art.el (gnus-treat-wash-html): New variable. - -2003-01-02 Lars Magne Ingebrigtsen - - * message.el (message-check-news-header-syntax): Allow posting. - (message-check-news-header-syntax): Fix logic for sure, this - time. - -2003-01-02 Matthieu Moy - - * message.el (message-check-news-header-syntax): Check syntax of - continuation headers. - -2003-01-02 Reiner Steib - - * gnus-art.el (gnus-button-url-regexp, - (gnus-button-mid-or-mail-regexp, gnus-button-alist, - (gnus-header-button-alist): Regexps are case insensitive here. - -2003-01-02 Simon Josefsson - - * dig.el (query-dig): Doc fix. - -2003-01-02 Kai Gro,A_(Bjohann - - * gnus-agent.el (gnus-agent-fetch-selected-article): Update whole - summary buffer line, not just the download mark. - -2003-01-02 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-goto-subjects): New function. - (gnus-summary-insert-dormant-articles): New command and - keystroke. - - * gnus-cache.el (gnus-summary-insert-cached-articles): Use new - function for mass insertion of subjects. - - * nndraft.el (nndraft-generate-headers): Don't move point. - - * gnus.el (nnheader): Require nnheader. - - * nndraft.el (nndraft-request-associate-buffer): Use - make-local-variable. - -2003-01-02 Michael Shields - - * nndraft.el (nndraft-request-associate-buffer): Make - write-contents-hooks buffer-local before setting it. - -2003-01-02 Lars Magne Ingebrigtsen - - * gnus.el (gnus-group-parameter-value): Take an extra param. - (gnus-group-fast-parameter): Let group param results be nil. - - * gnus-art.el (gnus-article-forward-header): New function. - (article-date-ut): Use it to remove continuation date headers. - - * gnus-sum.el (gnus-summary-walk-group-buffer): Supply prompt to - read-event. - (gnus-summary-remove-bookmark): Clean up. - (gnus-summary-set-bookmark): Clean up. - - * gnus-util.el (gnus-read-event-char): Take an optional prompt. - - * gnus.el (gnus-group-startup-message): Bind data-directory to - the Gnus etc directory. - -2003-01-01 Teodor Zlatanov - - * spam.el (spam-summary-prepare-exit): added slots for spam- and - ham-processing of articles; use the new - spam-group-(spam|ham)-contents-p functions - (spam-group-spam-contents-p, spam-group-ham-contents-p): new - convenience functions - (spam-mark-junk-as-spam-routine): use the new - spam-group-spam-contents-p function - - * gnus.el (spam-process, spam-contents, spam-process-destination): - added new parameters with corresponding global variables - (gnus-group-spam-exit-processor-ifile, - gnus-group-spam-exit-processor-bogofilter, - gnus-group-spam-exit-processor-blacklist, - gnus-group-spam-exit-processor-whitelist, - gnus-group-spam-exit-processor-BBDB, - gnus-group-spam-classification-spam, - gnus-group-spam-classification-ham): added new symbols for the - spam-process and spam-contents parameters - - * spam.el (spam-ham-marks, spam-spam-marks): changed list - customization and list itself to store mark symbol rather than - mark character. - (spam-bogofilter-register-routine): added logic to generate mark - values list from spam-ham-marks and spam-spam-marks, so (member) - would work. - -2003-01-02 Katsumi Yamaoka - - * message.el (message-cross-post-followup-to): Fix comment. - -2003-01-01 Teodor Zlatanov - - * spam.el (spam-ham-marks, spam-spam-marks): changed list - customization and list itself to store mark symbol rather than - mark character. - (spam-bogofilter-register-routine): added logic to generate mark - values list from spam-ham-marks and spam-spam-marks, so (member) - would work. - -2003-01-01 Raymond Scholz - - * message.el (message-signature-insert-empty-line): New variable. - -2002-12-30 Reiner Steib - - * message.el: Renamed functions and variables: "xpost" -> - "cross-post", "-fup2" -> "-followup-to". - (message-cross-post-old-target, message-cross-post-default, - message-cross-post-note, message-followup-to-note, - message-cross-post-note-function): New variables names. - (message-xpost-old-target, message-xpost-default, - message-xpost-note, message-fup2-note, - message-xpost-note-function): Removed variable names. - (message-cross-post-followup-to-header, - message-cross-post-insert-note, message-cross-post-followup-to): - New function names. - (message-xpost-fup2-header, message-xpost-insert-note, - message-xpost-fup2): Removed function names. - -2002-12-30 Reiner Steib - - * message.el (message-send-mail): Added message-cleanup-headers to - prevent newlines in headers. - -2003-01-01 Lars Magne Ingebrigtsen - - * dns.el (dns-make-network-process): Comment. - - * gnus-sum.el (gnus-summary-display-while-building): Default to - nil. - -2003-01-01 Wes Hardaker - - * gnus-sum.el (gnus-summary-display-while-building): New - variable. - -2003-01-01 Raymond Scholz - - * deuglify.el (gnus-outlook-rearrange-article): Kill overlays - before rearranging the article. - -2003-01-01 Lars Magne Ingebrigtsen - - * nndraft.el (nndraft-generate-headers): New function. - (nndraft-request-associate-buffer): Use it to write headers on - buffer save. - - * message.el (message-generate-headers): Let the function be a - lambda form. - (message-draft-headers): New variable. - - * gnus-msg.el (gnus-inews-make-draft-meta-information): New - function. - (gnus-setup-message): Use it. - - * message.el (message-generate-headers-first): Doc fix. - (message-setup-1): Use new function for getting which headers to - generate. - (message-headers-to-generate): New function. - -2003-01-01 ShengHuo ZHU - - * gnus-agent.el (gnus-agent-save-alist): Make directory. - -2002-12-31 Reiner Steib <4uce.02.r.steib@gmx.net> - - * gnus-sum.el (gnus-summary-limit-to-age): Make prompt string - mention negatives. - -2002-12-31 Raymond Scholz - - * deuglify.el (gnus-outlook-rearrange-article): Use - `transpose-regions' instead of tempering the kill-ring. - (gnus-article-outlook-deuglify-article): Rehighlight article - instead of a complete redisplay. - -2002-12-31 Teodor Zlatanov - - * spam.el: most defvars are defcustoms now - - patches from Michael Shields - - * spam.el (spam-bogofilter-articles): Select the article - body using gnus-summary-show-article t instead of - gnus-summary-select-article; this presents the raw text - without running any hooks. - - * spam.el (spam-bogofilter-articles): Use message-remove-header - to remove headers; the old way incorrectly removed just the first - line of folded headers. - -2002-12-31 Katsumi Yamaoka - - * gnus-start.el (gnus-load): Replace `ding-file' with `file'. - -2002-12-30 Lars Magne Ingebrigtsen - - * gnus-start.el (gnus-load): New function. - (gnus-read-newsrc-el-file): Use it. - -2002-12-30 Reiner Steib - - * gnus-art.el (gnus-button-valid-fqdn-regexp): New variable. - (gnus-button-handle-apropos-documentation): New function. - (gnus-button-handle-ctan): New function. - (gnus-button-alist): Use them. Improve some regexps. - (gnus-button-prefer-mid-or-mail): Addition to doc-string. - -2002-12-30 Reiner Steib - - * message.el (message-subscribed-p): New function. - (message-send-mail): Use it. - * mml.el (mml-preview-insert-mft): New function. - (mml-preview): Use it. - -2002-12-30 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-thread-latest-date): Protect against errors - when sorting by date. - - * gnus-art.el (gnus-article-edit-mode): New variable. - (gnus-article-setup-buffer): Warn user about discarding edits. - - * gnus-sum.el (gnus-summary-pipe-output): Clean up. - (gnus-summary-pipe-output): Take a symbolic prefix to save all - headers. - - * mm-uu.el (mm-uu-configure-list): Default to (shar . disabled). - -2002-12-30 Reiner Steib - - * message.el (message-completion-alist): Added "Mail-Followup-To" - and "Mail-Copies-To". - -2002-07-21 Jesper harder - - * gnus-group.el: Add key bindings for - gnus-group-sort-groups-by-real-name and - gnus-group-sort-selected-groups-by-real-name. - -2002-07-21 Jesper harder - - * gnus.texi (Sorting Groups): Add key bindings for - gnus-group-sort-groups-by-real-name and - gnus-group-sort-selected-groups-by-real-name. - -2002-12-30 Teodor Zlatanov - - * spam.el (spam-use-dig): new variable for blackhole checking - through dig.el - (spam-check-blackholes): added dig.el checking functionality and - more verbose reporting; query-dig is autoloaded from dig.el - (spam-use-blackholes): disabled by default - (spam-blackhole-servers): removed rbl.maps.vix.com from the - blackhole servers list - -2002-12-30 Lars Magne Ingebrigtsen - - * message.el (message-required-headers): New variable. - -2002-12-30 Teodor Zlatanov - - * dig.el (query-dig): new function - -2002-12-30 Lars Magne Ingebrigtsen - - * flow-fill.el (fill-flowed): Don't infloop on too long fill - prefixes. - - * dns.el (query-dns): Protect against errors. - - * gnus-msg.el (gnus-article-yanked-articles): New variable. - (gnus-inews-add-send-actions): Mark all answered messages as - answered. - -2002-08-10 Jari Aalto - - * nnmail.el (nnmail-split-it): Added tracing to - `:' split rule - -2002-08-13 Hrvoje Niksic - - * mm-decode.el (mm-mailcap-command): Remove the quotes around '%s' - and "%s" so we don't overquote them. - -2002-08-13 Hrvoje Niksic - - * (mm-display-external): Display the actual command that has been - executed in the echo area. - -2002-12-29 Lars Magne Ingebrigtsen - - * gnus-topic.el (gnus-topic-display-missing-topic): Bind entry. - - * message.el (message-with-reply-buffer): New macro. - (message-fetch-reply-field): Use it. - (message-insert-wide-reply): New command and keystroke. - (message-carefully-insert-headers): New function. - (message-insert-to): Use new function. - - * gnus-topic.el (gnus-topic-display-missing-topic): New function. - (gnus-topic-goto-missing-group): Use it. - - * message.el (message-required-news-headers): Removed Lines. - (message-reply): Don't insert References first. - (message-followup): Ditto. - (message-make-references): New function. - (message-followup): Set message-reply-headers before generating - the buffer stuff. - -2002-12-29 Jesper Harder - - * mml.el (mml-generate-mime-1): Reverse the order of - encoding/flowing. - -2002-12-29 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-expiry-target-group): Mark articles as read - after moving them. - - * gnus-sum.el (gnus-summary-dummy-line-format): Update format to - fit with newer standard format. - (gnus-summary-make-false-root-always): New variable. - (gnus-gather-threads-by-subject): Use it. - - * message.el (message-get-reply-headers): Take an address list - optional argument. - -2002-12-28 Lars Magne Ingebrigtsen - - * gnus.el (gnus-keep-backlog): Change default to 20. - - * gnus-agent.el (gnus-agent-check-overview-buffer): Start from - start. - (gnus-agent-check-overview-buffer): Remove negative article - numbers. - - * nnmail.el (nnmail-split-fancy-with-parent-ignore-groups): Doc fix. - (nnmail-cache-ignore-groups): Doc fix. - - * nnimap.el (nnimap-debug): Made into a flag and defcustomed. - (nnimap-debug-buffer): New variable. - (nnimap-debug): Use it. - -2002-12-28 Lars Magne Ingebrigtsen - - * gnus.el (gnus-summary-high-uncached-face): New color scheme. - -2002-12-28 Lars Magne Ingebrigtsen - - * gnus-agent.el (gnus-agent-check-overview-buffer): Sort lines if - they aren't already sorted. - -2002-12-28 Jesper Harder - - * message.el (message-mode-menu): Add ellipses to menu items - expecting user interaction. - (message-mode-field-menu): do. - -2002-12-26 Jesper Harder - - * gnus-sum.el (gnus-summary-highlight-line): Don't bind `list' -- - it isn't used any more. - -2002-12-22 Jesper Harder - - * binhex.el (binhex-decoder-program): Fix docstring. - -2002-12-21 Laurent Martelli - - * mm-decode.el (mm-mailcap-command): Do not backslash-quote - special chars if the mailcap file uses single quotes around %s. - -2002-12-19 Paul Jarc - - * gnus-int.el (gnus-request-update-info): nnchoke-r-u-i might not - return the info object. - -2002-12-18 Paul Jarc - - * gnus-int.el (gnus-request-update-info): Artificially add - (1 . (1- min)) to the read range, in case the backend doesn't - store marks for nonexistent articles. - -2002-12-17 Katsumi Yamaoka - - * binhex.el (binhex-insert-char): Eval-and-compile. - -2002-12-17 Jesper Harder - - * lpath.el: Add tool-bar-local-item-from-menu. - - * message.el (message-tool-bar-local-item-from-menu): New function. - (message-tool-bar-map): Use it. - -2002-12-14 Jesper Harder - - * gnus-uu.el (gnus-uu-digest-headers): Mention nil value in docstring. - - * gnus-art.el (gnus-article-header-rank): Last header in - gnus-sorted-header-list should have higher rank than non-members. - -2002-12-13 Lars Magne Ingebrigtsen - - * gnus-agent.el (gnus-close-agent): Don't blank out the list of - covered methods. - -2002-12-12 Kai Gro,A_(Bjohann - - * nntp.el (nntp-with-open-group-first-pass): Do not wrap in - eval-when-compile. Suggested by Kevin Greiner. - -2002-12-13 Kevin Greiner - - * gnus-agent.el (gnus-agent-max-fetch-size): New, defcustom. - (gnus-agent-fetch-headers): Initialize gnus-agent-overview-buffer - even though no headers may have been fetched - (gnus-agent-fetch-group-1, and perhaps others, require this - behavior). - (gnus-agent-fetch-group-1): Fetch articles in chucks so that the - server buffer is constrained by gnus-agent-max-fetch-size. - Multiple chunks in the same group may perform arbitrarily large - updates. - -2002-12-12 Kevin Greiner - - * gnus-agent.el (gnus-agent-fetch-selected-article): Added call to - gnus-summary-update-download-mark to update the article in the - summary. - -2002-12-11 Kevin Greiner - - * gnus.el (gnus-summary-high-uncached-face, - gnus-summary-normal-uncached-face, gnus-summary-low-uncached-face) - New faces. - - * gnus-agent.el (gnus-agent-downloaded-article-face): REMOVED. I - added this on 2002-11-23 but it just wasn't working out as - intended. The idea isn't entirely dead, three new faces - gnus-summary-*-uncached-face are being added to gnus.el to provide - the basis for an improved implementation. - (gnus-agent-read-servers): Undo the change made on 2002-11-23. The - proper file to open is lib/servers. - (gnus-summary-set-agent-mark): Expanded documentation. Unmarking - (i.e. removing the article from gnus-newsgroup-downloadable) will - now restore the article's default mark rather than simply setting - no mark. - (gnus-agent-get-undownloaded-list): Corrected documentation. - Added code to set new summary local variable, - gnus-newsgroup-agentized. Reworked impl so that it doesn't create - a temporary list. No longer sets gnus-newsgroup-downloadable. - (gnus-agent-summary-fetch-group): Keep gnus-newsgroup-undownloaded - up to date. Call new gnus-summary-update-download-mark to keep - summary buffer up-to-date. - (gnus-agent-fetch-selected-article): Keep - gnus-newsgroup-undownloaded up to date. - (gnus-agent-fetch-articles): Return list of articles that were - successfully fetched. - (gnus-agent-check-overview-buffer): No more thingatpt. - (gnus-agent-expire): No longer deletes NOV entries of unread - articles. - (gnus-agent-unread-articles): New function. - (gnus-agent-regenerate-group): The article number must be - terminated by a tab character. Added more messages to report - repairs. Inhibit quits while writing changes so it is now safe - have to quit regeneration. Renamed gnus-tmp-downloaded back to - downloaded to 1) resolve the unbound references and 2) avoid - confusing this list with the gnus-tmp-downloaded in gnus-sum.el - - * gnus-art.el (gnus-article-prepare): The agent - downloaded/undownloaded mark is no longer stored as the article's - mark. - - * gnus-salt.el (gnus-tree-highlight-node): Added uncached as - gnus-summary-highlight may use it. Added downloaded as - gnus-summary-highlight was using it. - - * gnus-sum.el (gnus-undownloaded-mark): Changed from ?@ to ?- as - the download mark now follows Kai's +/- convention. - (gnus-downloaded-mark): Added ?+ mark. - (gnus-summary-highlight): Added rules to select - gnus-summary-high-uncached-face, - gnus-summary-normal-uncached-face, and - gnus-summary-low-uncached-face. Removed the - gnus-agent-downloaded-article-face. - (gnus-summary-line-format-alist): Implemented the download flag - format (?O) as named in the manual. This implementation displays - either gnus-undownloaded-mark, gnus-downloaded-mark, or - gnus-no-mark. - (gnus-newsgroup-agentized): New local variable that identifies - which groups are agentized. While the agent is now on by default, - you don't have to agentize every server that you use. - (gnus-update-summary-mark-positions): Completed support for the - download type of mark. - (gnus-summary-insert-line): Added undownloaded to the parameters. - (gnus-summary-prepare-threads): Set gnus-tmp-downloaded for - reference by the gnus-summary-line-format-spec. - - * nntp.el (nntp-with-open-group): This macro handles dropped or - broken connections by opening a new connection and repeating the - failed command. - (nntp-retrieve-headers-with-xover): Some NNTP servers respond to - XOVER commands preceeding the active articles with the nov entry - of the first available article. When gnus connected to such a - server, the unexpected nov entry would result in duplicate lines - in the agent's overview file. This patch fixes the duplicate - lines problem and improves performance by skipping over all - articles IDs that preceed the first nov entry in the server's - reply. - -2002-12-11 Katsumi Yamaoka - - * gnus-sum.el (gnus-tmp-downloaded): New internal variable. - (gnus-summary-highlight): Use it instead of `downloaded'. - (gnus-summary-highlight-line): Ditto. - - * gnus-agent.el (gnus-agent-regenerate-group): Ditto. - -2002-12-11 Lars Magne Ingebrigtsen - - * gnus.el (gnus-variable-list): Add gnus-agent-covered-methods. - - * gnus-agent.el (gnus-agent-check-overview-buffer): Remove debug - calls. - - * gnus-sum.el (gnus-summary-highlight-line): Don't set the - downloaded variable if we're in an uncovered group. - - * gnus-agent.el (gnus-agent-downloaded-article-face): Change the - font to soemthing less noticeable. - (gnus-agent-group-covered-p): New function. - -2002-12-09 ShengHuo ZHU - - * gnus-agent.el (gnus-agent-braid-nov): Remove corrupted lines. - Because of an unknown bug, the group buffer is saved in .overview - file. - -2002-12-09 Kai Gro,A_(Bjohann - - * nntp.el (nntp-send-command): Braino in last commit. Replace - `and' with `or'. - -2002-12-08 Kai Gro,A_(Bjohann - - * nntp.el (nntp-send-command): Assume that echo does not happen - when nntp-open-connection-function is nntp-open-network-stream. - Suggested by Sebastian D.B. Krause . - -2002-12-07 ShengHuo ZHU - - * nnslashdot.el (nnslashdot-retrieve-headers-1): Update the parser. - -2002-12-06 Paul Jarc - - * nnmaildir.el (nnmaildir-request-group): bugfix: don't erase - nntp-server-buffer if we aren't going to write to it. - -2002-12-04 Itai Zukerman (tiny change) - - * mm-decode.el (mm-w3m-safe-url-regexp): Fix parenthesis. - -2002-12-04 Katsumi Yamaoka - - * rfc2047.el (rfc2047-decode-region): Remove newlines between - decoded words. - -2002-12-03 Kai Gro,A_(Bjohann - - * gnus.el (fboundp): After loading mm-util, make sure it was the - right one. - -2002-11-29 Kai Gro,A_(Bjohann - - * gnus-art.el (gnus-inhibit-mime-unbuttonizing): Moved here from - gnus-sum. Made into a user option. - - * gnus-sum.el (gnus-simplify-ignored-prefixes) - (gnus-summary-mark-article-as-unread) - -2002-11-29 ShengHuo ZHU - - * time-date.el (date-to-time): Typo. - - * parse-time.el: Typo. - - * nnsoup.el (nnsoup-retrieve-headers): Typo. - - * nnmail.el (nnmail-split, nnmail-process-unix-mail-format): Typos. - - * nnimap.el: - (nnimap-split-rule, nnimap-find-minmax-uid): Typos. - - * mm-encode.el (mm-safer-encoding): Typo. - - * messcompat.el: Typo. - - * message.el (message-face-alist): Typo. - - * imap.el (imap-interactive-login, imap-open): Typos. - - * ietf-drums.el (ietf-drums-text-token, ietf-drums-qtext-token): Typos. - - * gnus.el: Typo. - - * gnus-win.el (gnus-configure-frame): Typo. - - * gnus-util.el (gnus-atomic-progn-assign): Typo. - - * gnus-topic.el (gnus-topic-sort-topics): Typo. - - * gnus-sum.el (gnus-summary-article-number) - (gnus-summary-read-group-1, gnus-summary-mark-article) - (gnus-summary-fetch-faq, gnus-refer-article-methods): Typos. - - * gnus-mule.el (gnus-mule-add-group): Typo. - - * gnus-mlspl.el (gnus-group-split-fancy): Typo. - - * gnus-group.el (gnus-group-fetch-faq): Typo. - - * gnus-art.el (gnus-decode-header-methods): Typo. - - * flow-fill.el: Typo. - -2002-11-19 Stefan Monnier - - * binhex.el (binhex-decode-region): Don't hardcode point-min == 1. - -2002-11-29 Kai Gro,A_(Bjohann - - * gnus-sum.el (gnus-simplify-ignored-prefixes) - (gnus-summary-mark-article-as-unread) - (gnus-mark-article-as-unread, gnus-summary-highlight-line): - Reformatting to avoid long lines. - (gnus-inhibit-mime-unbuttonizing): Moved to gnus-art. - -2002-11-28 Daiki Ueno - - * gnus-agent.el (gnus-agent-fetch-group-1): Article numbers should - be accessed through `mail-header-number'. - -2002-11-27 Kevin Greiner - - * gnus-sum.el (gnus-summary-insert-old-articles): No longer passes - compressed range to gnus-summary-insert-articles. - -2002-11-26 Kevin Ryde - - * gnus-art.el (gnus-mime-copy-part): Look for filename - parameter under content-disposition, not content-type. - - * gnus-sum.el (gnus-summary-find-uncancelled): New function. - (gnus-summary-reselect-current-group): Use it. - -2002-11-26 ShengHuo ZHU - - * gnus-agent.el (gnus-agent-uncached-articles): if - gnus-agent-load-alist fails, return ARTICLES. - - * nnrss.el (nnrss-group-alist): Update the link of Jabber. - -2002-11-26 Kai Gro,A_(Bjohann - - * gnus-sum.el (gnus-summary-insert-old-articles): Remove - superfluous function call. - (gnus-summary-catchup-all, gnus-summary-catchup-all-and-exit): - Add warning to docstring. - -2002-11-26 Katsumi Yamaoka - - * gnus-agent.el: Autoload number-at-point instead. - (gnus-agent-check-overview-buffer): No warning for deactivate-mark. - -2002-11-26 Kai Gro,A_(Bjohann - - * gnus-agent.el (gnus-agent-check-overview-buffer): Explicitly - require thingatpt (for number-at-point) and protect against - deactivate-mark being unbound (on XEmacs). - -2002-11-25 Kai Gro,A_(Bjohann - - * gnus-agent.el (gnus-agent-check-overview-buffer): Make debugger - print message on entry. - -2002-11-25 Kevin Greiner . - - * gnus-range.el (gnus-range-difference): New function. - * gnus-sum.el (gnus-summary-insert-old-articles): Use it. - -2002-11-24 Kai Gro,A_(Bjohann - - * gnus-sum.el (gnus-summary-insert-old-articles): Use - gnus-remove-from-range instead of gnus-range-difference which - doesn't exist. - -2002-11-23 Kevin Greiner - - * gnus-agent.el (gnus-agent-downloaded-article-face): New face, - used for showing which articles have been downloaded. - (gnus-agent-article-alist): Format change. Add documentation. - (gnus-agent-summary-mode-map): New keybinding `J s' for fetching - process-marked articles. - (gnus-agent-summary-fetch-series): Command for `J s'. Articles - in the series are individually fetched to minimize lose of - content due to an error/quit. - (gnus-agent-synchronize-flags-server, gnus-agent-add-server): Use - gnus-message instead of message. - (gnus-agent-read-servers): Use file lib/methods instead of - lib/servers. TODO: Why? - (gnus-summary-set-agent-mark): Adapt to new agent-alist format. - (gnus-agent-get-undownloaded-list): Remove articles that appear to - come from the agent. This means that they are not downloaded. - (gnus-agent-fetch-selected-article): Don't use history. - (gnus-agent-save-history, gnus-agent-enter-history) - (gnus-agent-article-in-history-p, gnus-agent-history-path): - Removed function; history is not used anymore. - (gnus-agent-fetch-articles): Fix handling of crossposted articles. - (gnus-agent-crosspost): Started rewrite then realized that a typo - in gnus-agent-fetch-articles ensures that this function is never - called. This will need to be fixed later. - (gnus-agent-check-overview-buffer): Some sanity checks on the - agent overview buffer. This is a safety net used during - development. - (gnus-agent-flush-cache): The gnus-agent-article-alist format has - changed, write a number to the file indicating this. - (gnus-agent-fetch-headers): Rewrite to respect - gnus-agent-consider-all-articles without relying on the - `.fetched' files. Make it fast. - (gnus-agent-braid-nov): Change resulting from - gnus-agent-fetch-headers change. - (gnus-agent-load-alist, gnus-agent-save-alist): Don't use - `.fetched' files. - (gnus-agent-read-agentview): New function, used by - gnus-agent-load-alist. - (gnus-agent-load-fetched-headers): Remove. - (gnus-agent-save-alist): Rewrite to accomodate new format. - (gnus-agent-fetch-group-1): Make sure list of articles is in the - same order as in gnus-newsgroup-headers. - (gnus-agent-expire): Document and implement extra args ARTICLES, - GROUP, FORCE. Do not restrict usage. - (gnus-agent-uncached-articles): New function. - (gnus-agent-retrieve-headers): Use it. - (gnus-agent-regenerate-group): No longer needs to be called from - gnus-agent-regenerate. Individual groups may be regenerated. The - regeneration code now fixes duplicate, and mis-ordered, NOV entries. - The article fetch dates are validated in the article alist. The - article alist is pruned of entries that do not reference existing - NOV entries. All changes are computed then applied with - inhibit-quit bound to t. As a result, it is now safe to quit out of - regeneration. The optional clean parameter has been replaced with - an optional reread parameter. Clean is no longer necessary as - regeneration gets the appropriate setting from - gnus-agent-consider-all-articles. The new reread parameter will - result in fetched, or all, articles being marked as unread. - (gnus-agent-regenerate): Removed code to regenerate the history - file as it is no longer used. - - * gnus-start.el (gnus-make-ascending-articles-unread): New - function, for efficient mass-marking. - - * gnus-sum.el (gnus-summary-highlight): Use new face for - downloaded articles. - (gnus-article-mark): Prefer to indicate read/unread status over - downloaded status. - (gnus-summary-highlight-line-0): New function, maybe rehighlights - line. - (gnus-summary-highlight-line): Use new face for downloaded - articles. - (gnus-summary-insert-old-articles): Improved performance by - replacing the initial LIST of older articles with a compressed - RANGE of older articles. Some servers appear to lie about - their active range so the original list could contain millions - of article numbers. The range is not expanded into a list - until the optional ALL parameter has been applied. - -2002-11-18 Kai Gro,A_(Bjohann - - * gnus-agent.el (gnus-category-mode): Typo in doc string. - -2002-11-21 Teodor Zlatanov - - * spam.el: - added patch from Andreas Fuchs to prevent apply errors - - * spam.el: added `M s t' and `M s x' key mappings - -2002-11-20 Simon Josefsson - - * gnus-sum.el (gnus-summary-morse-message): Narrow to body. - -2002-11-19 Simon Josefsson - - * gnus-sum.el (gnus-summary-morse-message): Load - morse.el (unmorse-region not autoloaded in Emacs 20 nor XEmacs). - (unmorse-region): Autoload it instead. - -2002-11-18 Simon Josefsson - - * gnus-sum.el (gnus-summary-morse-message): New function. - (gnus-summary-wash-map): Bind to `W m'. - (gnus-summary-make-menu-bar): Add. - - * nnimap.el (nnimap-request-expire-articles): Compress sequence - before storing \Deleted mark on expired articles. - -2002-11-17 Markus Rost (tiny change) - - * gnus-sum.el (gnus-summary-goto-unread): Doc fix - escape open - parens in column 0. - -2002-11-17 Juanma Barranquero - - * nnweb.el (nnweb-google-create-mapping): Fix typo. - - * nnlistserv.el (nnlistserv-kk-create-mapping): Likewise. - - * gnus-nocem.el (gnus-nocem-liberal-fetch): Likewise. - -2002-11-17 ShengHuo ZHU - - * message.el (message-set-auto-save-file-name): Use - make-directory, to avoid the dependence on gnus-util. - -2002-11-16 Simon Josefsson - - * nnimap.el (nnimap-callback-callback-function): - (nnimap-callback-buffer): Removed, these cannot be global but must - be embedded into the callback. - (nnimap-make-callback): New. Embedd article number, callback and - buffer in function. - (nnimap-callback, nnimap-request-article-part): Update. - -2002-11-15 Katsumi Yamaoka - - * mml.el (mml-preview): Bind message-this-is-mail if it is mail. - -2002-11-13 Kai Gro,A_(Bjohann - - * gnus.el (gnus-summary-line-format): Document %C. - -2002-11-11 Simon Josefsson - - * pgg.el (pgg-encrypt, pgg-decrypt, pgg-sign, pgg-verify): Display - output when called interactively. - -2002-11-08 Katsumi Yamaoka - - * gnus-art.el (gnus-article-edit-exit): Kill local variables. - - * message.el (message-draft-coding-system): Improve comment; use - mm-auto-save-coding-system for the default value. - - * nndraft.el (nndraft-request-article): Revert to the state before - 2002-10-29; regexp-quote mail-header-separator. - -2002-11-06 Jesper Harder - - * gnus-draft.el (gnus-draft-setup): Set gnus-message-group-art to - allow editing of drafts from an nnvirtual group. - -2002-11-06 Katsumi Yamaoka - - * nndraft.el (nndraft-request-article): Replace emacs-mule with - mm-auto-save-coding-system. - - * message.el (message-draft-coding-system): Default to - iso-2022-7bit. - - * mm-util.el (mm-auto-save-coding-system): Undo last change to - restore the default value to emacs-mule or escape-quoted. - -2002-11-05 Katsumi Yamaoka - - * gnus-art.el (gnus-article-encrypt-body): Inhibit encrypting of - a delayed or a queued article as well as a draft. - - * gnus-sum.el (gnus-summary-edit-article): Inhibit editing of a - delayed or a queued article in the raw format; treat a delayed - article as a raw article as well as a draft. - (gnus-summary-setup-default-charset): Clear gnus-newsgroup-charset - for the delayed group. - - * nndraft.el (nndraft-request-article): Ignore auto save files for - a delayed or a queued article; don't bother to decode a queued - article; don't bind nnmail-file-coding-system for a queued article. - - * nnmail.el (nnmail-split-fancy-with-parent): Ignore the delayed - and the queue group. - -2002-11-04 Jesper Harder - - * gnus-group.el (gnus-group-delete-group): - gnus-cache-active-hashtb might be void. - -2002-11-02 Raymond Scholz - - * pgg-gpg.el (pgg-gpg-encrypt-region): Makes PGG respect the - setting of the default user ID. - -2002-11-01 Jesper Harder - - * mm-bodies.el (mm-body-encoding): Don't return 8bit for 7bit - charset. - -2002-10-31 Alex Schroeder - - * spam-stat.el (spam-stat-process-directory): add dir to message - (spam-stat-reduce-size): No longer remove words - with values close to 0.5, because the default value is 0.2. - -2002-10-31 Kai Gro,A_(Bjohann - - * gnus-util.el (gnus-user-date-format-alist): Clarify and correct - documentation. - -2002-10-28 Kai Gro,A_(Bjohann - - * gnus-agent.el (gnus-agent-fetched-headers) - (gnus-agent-load-fetched-headers) - (gnus-agent-save-fetched-headers): Remove variable and two - functions. Kevin Greiner's version of gnus-agent-fetch-headers - works better. - (gnus-agent-fetch-headers): New implementation from Kevin - Greiner. Uses gnus-agent-article-alist to store information - about fetched messages which aren't on the server anymore. The - trick is to return a list of considered messages to the caller, - but to only fetch those which haven't been fetched yet. - -2002-10-30 Simon Josefsson - - * pgg-def.el (pgg-passphrase-cache-expiry): New, defcustom. - - * pgg.el (pgg-passphrase-cache-expiry): Removed. - -2002-10-30 TSUCHIYA Masatoshi - - * mm-view.el (mm-w3m-local-map-property): Make it work with older - versions of emacs-w3m than 1.3.3. - - * lpath.el: Bind w3m-minor-mode-map. - - * mm-view.el (mm-w3m-mode-command-alist) - (mm-w3m-mode-dont-bind-keys, mm-w3m-mode-ignored-keys): Removed. - (mm-w3m-mode-map): Undefined for Emacs21 and XEmacs. - (mm-setup-w3m): Simplified. - (mm-w3m-local-map-property): New function. - (mm-inline-text-html-render-with-w3m): Use it. - - * gnus-art.el (gnus-article-wash-html-with-w3m): Use - mm-w3m-local-map-property. - -2002-10-29 Katsumi Yamaoka - - * mm-util.el (mm-auto-save-coding-system): Default to - iso-2022-7bit. - - * nndraft.el (nndraft-request-article): Decode an article using - the coding-system emacs-mule if it seems to have been saved using - emacs-mule. - (nndraft-request-replace-article): Use message-draft-coding-system - instead of mm-auto-save-coding-system for the draft or delayed - group. - -2002-10-28 Josh Huber - - * mml.el (mml-mode-map): Fixed keybindings for mml-secure-* - functions. - -2002-10-28 Mark A. Hershberger - - * mm-url.el (mm-url-insert-file-contents): Make it return the same - type values ("url" size) regardless of the values of - mm-url-use-external. - -2002-10-26 Kai Gro,A_(Bjohann - - * nnimap.el (nnimap-request-article-part): Try harder to show - group name in debugging message. - -2002-10-25 Kai Gro,A_(Bjohann - - * gnus-agent.el (gnus-agent-save-fetched-headers): Create - directory if it doesn't exist. - (gnus-agent-fetch-headers): Remove old cruft that tried to - abstain from downloading articles more than once if - gnus-agent-consider-all-articles was true. This is now done - properly via the .fetched files. - -2002-10-25 Katsumi Yamaoka - - * nndraft.el (nndraft-request-article): Treat delayed articles - like drafts. - -2002-10-24 Katsumi Yamaoka - - * gnus-agent.el (gnus-agent-load-alist): Fix parenthesis. - -2002-10-24 Kai Gro,A_(Bjohann - - * gnus-agent.el (gnus-agent-save-alist, gnus-agent-load-alist): - Remove unused optional arg DIR and corresponding code. - - * nnimap.el (nnimap-request-article-part): Include group name in - debugging output. - -2002-10-24 Paul Jarc - - * gnus-agent.el (gnus-agent-fetch-headers): Add some comments. - -2002-10-23 Kai Gro,A_(Bjohann - - * gnus-agent.el (gnus-agent-fetched-headers): New variable, - contains range of headers that have been fetched by the agent - already. Compare gnus-agent-article-alist. - (gnus-agent-file-header-cache): Like - gnus-agent-file-loading-cache, but for gnus-agent-fetched-headers. - (gnus-agent-fetch-headers): Improve comment. Revert to old - seen/recent logic. - Remember which headers have been fetched before and don't fetch - them again the next time round. - (gnus-agent-load-fetched-headers) - (gnus-agent-save-fetched-headers): New functions, for remembering - which headers have been fetched before. - -2002-10-23 Katsumi Yamaoka - - * lpath.el: Remove useless bindings. - -2002-10-22 Jesper Harder - - * gnus-sum.el (gnus-summary-execute-command): Disable visual - features while searching. - -2002-10-22 TSUCHIYA Masatoshi - - * pgg.el (pgg-snarf-keys): Do not refer unbinded local variables. - -2002-10-22 Simon Josefsson - - * pgg.el (pgg-encrypt, pgg-decrypt, pgg-sign, pgg-verify) - (pgg-snarf-keys): Add. - -2002-10-22 Katsumi Yamaoka - - * lpath.el: Fbind bbdb-records. - - * spam.el: Don't autoload bbdb-records. - -2002-10-22 Katsumi Yamaoka - - * spam.el: Set autoload for bbdb-records after loading bbdb-com to - prevent inf-loop. - -2002-10-22 Lars Magne Ingebrigtsen - - * nnslashdot.el: Removed some test lines. - More test. - -2002-10-21 Kai Gro,A_(Bjohann - - * gnus-agent.el (gnus-agent-fetch-headers): Remove articles that - are known to be downloaded already. - -2002-10-21 Lars Magne Ingebrigtsen - - * mm-view.el (mm-text-html-renderer-alist): Add w3m-standalone. - (mm-text-html-washer-alist): Ditto. - -2002-10-19 TSUCHIYA Masatoshi - - * nnheader.el (nnheader-remove-body): Fix an error of detecting - boundary between headers and body. - * nnml.el (nnml-parse-head): Ditto. - -2002-10-20 Lars Magne Ingebrigtsen - - * nnslashdot.el (nnslashdot-generate-active): Ignore any bogus - entries. - - * gnus-group.el (gnus-fetch-group): Allow an optional - specification of the articles to select. - - * gnus-srvr.el (gnus-server-prepare): Removed superfluous cdr. - -2002-10-20 Kai Gro,A_(Bjohann - - * gnus-agent.el (gnus-agent-fetch-group-1): After fetching - headers from the group, update variable `articles' to contain - only those numbers where headers exist. (When fetching all - articles in a group, Gnus creates lots of numbers where there is - no articles.) - -2002-10-20 Steve Youngs - - * pgg-parse.el (pgg-parse-public-key-algorithm-alist): XEmacs - doesn't have the 'alist custom type, use cons cells instead. - (pgg-parse-symmetric-key-algorithm-alist): Ditto. - (pgg-parse-hash-algorithm-alist): Ditto. - (pgg-parse-compression-algorithm-alist): Ditto. - (pgg-parse-signature-type-alist): Ditto. - - * pgg-gpg.el (pgg-gpg-extra-args): Fix custom mismatch. - - * pgg-pgp5.el (pgg-pgp5-extra-args): Ditto. - - * pgg-pgp.el (pgg-pgp-extra-args): Ditto. - -2002-10-19 Simon Josefsson - - * nnimap.el (nnimap-open-server): Check imap-state in IMAP server - buffer. - -2002-10-18 Kai Gro,A_(Bjohann - - * gnus-spec.el (gnus-make-format-preserve-properties) - (gnus-xmas-format, gnus-parse-simple-format): Preserve text - properties also on XEmacs. `gnus-xmas-format' is like format but - preserves text properties on XEmacs (though it only understands - simple format specs). The variable - `gnus-make-format-preserve-properties' controls whether the - function is used, and is checked in `gnus-parse-simple-format'. - Patch by Paul Moore . - - * gnus-agent.el (gnus-agent-fetch-articles): More debugging - output. - (gnus-agent-consider-all-articles): New variable. - (gnus-agent-get-undownloaded-list): Comment that marks todo item. - (gnus-agent-fetch-headers): Depending on - gnus-agent-consider-all-articles, maybe get all articles. - (gnus-category-predicate-alist, gnus-agent-read-p): New predicate - `read'. - (gnus-predicate-imples-unread): New function. - (gnus-agent-fetch-headers): Optimize to call - gnus-list-of-unread-articles if that is sufficient. - Check unseen and recent instead of seen and recent. - (gnus-agent-fetch-headers): Abstain from calling - gnus-list-range-intersection if range (a . b) would have (> a b). - -2002-10-18 Katsumi Yamaoka - - * message.el (message-send-mail): Make it possible to perform - edebug-defun. - -2002-10-18 Simon Josefsson - - * gnus-art.el (gnus-button-man-handler): Change default to - `manual-entry' (defined in both emacsen). - (gnus-button-man-handler): Remove emacsen difference and use - `manual-entry'. - -2002-10-18 Katsumi Yamaoka - - * spam.el: Wrap autoload settings for bbdb-records, - executable-find and ifile-spam-filter with eval-and-compile. - (spam-display-buffer-contents): Remove. - (spam-bogofilter-score): Merge spam-display-buffer-contents. - -2002-10-17 Ted Zlatanov - - * spam.el (spam-display-buffer-contents): New function. - (spam-bogofilter-score): use spam-display-buffer-contents, patch - from Katsumi Yamaoka . - -2002-10-17 TSUCHIYA Masatoshi - - * nnheader.el (nnheader-parse-naked-head): New function. - (nnheader-parse-head): Use the above function, in order to handle - continuation lines properly. - (nnheader-remove-body): New function. - (nnheader-remove-cr-followed-by-lf): New function. - (nnheader-ms-strip-cr): Use the above function. - - * gnus-agent.el (gnus-agent-regenerate-group): Call - `nnheader-remove-body'; use `nnheader-parse-naked-head' instead of - `nnheader-parse-head'. - * gnus-cache.el (gnus-cache-possibly-enter-article): Ditto. - - * gnus-msg.el (gnus-inews-yank-articles): Do not unfold - continuation lines by itself; call `nnheader-parse-naked-head' - instead of `nnheader-parse-head'. - * nndiary.el (nndiary-parse-head): Ditto. - * nnfolder.el (nnfolder-parse-head): Ditto. - * nnimap.el (nnimap-retrieve-headers-progress): Ditto. - * nnmaildir.el (nnmaildir--update-nov): Ditto. - * nnml.el (nnml-parse-head): Ditto. - -2002-10-17 Steve Youngs - - * gnus-art.el (gnus-button-man-handler): Add 'manual-entry' for - XEmacs, default to it if featurep 'xemacs. - -2002-10-16 Katsumi Yamaoka - - * spam-stat.el: Check for the existence of hash functions instead - of the Emacs version to decide whether to load cl. Suggested by - Kai Gro,A_(Bjohann. - -2002-10-15 Kai Gro,A_(Bjohann - - * gnus-agent.el (gnus-agent-fetch-selected-article): Open history - if it isn't open yet. - -2002-10-14 Katsumi Yamaoka - - * gnus-group.el: Require mm-url only when compiling. - (gnus-group-fetch-charter): Require mm-url. - - * spam-stat.el: Require cl for the functions gethash, - hash-table-count, make-hash-table and mapc for Emacs 20. - (puthash): Alias to cl-puthash for Emacs 20. - (with-syntax-table): New macro for Emacs 20. - -2002-10-12 Jesper Harder - - * gnus-spec.el (gnus-pad-form): Use gnus-string-width-function. - -2002-10-11 Ted Zlatanov - - * spam.el (spam-check-ifile): added ifile as a spam checking - backend, and spam-use-ifle as the variable to toggle that check. - -2002-10-12 Simon Josefsson - - * message.el (message-beginning-of-line): New variable. - (message-beginning-of-line): Use it. - -2002-10-11 Ted Zlatanov - - * spam.el: more compilation fixes for BBDB - - * spam-stat.el: added code from Alex Schroeder - (spam-stat-reduce-size): Interactive. - (spam-stat-reset): New function. - (spam-stat-save): Interactive. - -2002-10-11 Katsumi Yamaoka - - * gnus.el: Autoload gnus-delay-initialize. - - * message.el: Autoload gnus-delay-article. - -2002-10-11 Jesper Harder - - * gnus-spec.el (gnus-balloon-face-function): Use the help-echo - text property in Emacs. - -2002-10-11 Simon Josefsson - - * mml2015.el (mml2015-pgg-decrypt, mml2015-pgg-clear-decrypt) - (mml2015-pgg-verify, mml2015-pgg-clear-verify): Remove CR. - - * mml1991.el (mml1991-pgg-sign): Remove CR. - -2002-10-10 Simon Josefsson - - * mml2015.el (mml2015-pgg-decrypt): Set gnus details even when - decrypt failed. - (mml2015-trust-boundaries-alist): Removed. - (mml2015-gpg-extract-signature-details): Don't use it. - (mml2015-unabbrev-trust-alist): New. - (mml2015-gpg-extract-signature-details): Use it. - -2002-10-10 Ted Zlatanov - - * spam.el: compilation fixes, spam-check-bbdb function is nil if no - BBDB installed - - * spam-stat.el: added code from Alex Schroeder to do - statistical analysis of spam in Lisp only - -2002-10-10 Simon Josefsson - - * nnimap.el (nnimap-open-server): Re-open server if it isn't in - auth, selected or examine state. - - * pgg-gpg.el (pgg-gpg-verify-region): Filter out stuff into output - buffer and error buffer depending on type of information. - - * mml2015.el (mml2015-gpg-extract-signature-details): Parse - --status-fd stuff even if gpg.el is not used (revert earlier - change). - (mml2015-pgg-{clear-,}verify): Store both output and errors as - gnus details. - (mml2015-pgg-{clear-,}verify): Extract signature info from errors - buffer. - - * pgg.el (pgg-verify-region): Use it. - - * pgg-def.el (pgg-query-keyserver): New variable. - - * pgg.el (pgg-decrypt-region): Bind pgg-default-user-id to - key-identifier in packet. Is this a good idea? - - * mml.el (mml-mode-map): Add security commands that operates on - MIME parts. - (mml-menu): And menu items for them. - - * mml1991.el (mml1991-pgg-encrypt): Remove headers. - - * mml.el (mml-parse-1): Support sender in #secure tags. - - * mml1991.el (mml1991-pgg-sign): Only use message-sender if it is - defined. - - * mml-sec.el (mml-smime-encrypt-buffer): Warn about combined signing. - (mml-pgp-encrypt-buffer): Support combined signing. - - * mml1991.el (mml1991-mailcrypt-encrypt): Support combined signing. - (mml1991-gpg-encrypt): Ditto. - (mml1991-pgg-encrypt): Ditto. - (mml1991-encrypt): Pass sign parameter. - - * mml-sec.el (mml-signencrypt-style-alist): Defcustom. - (mml-signencrypt-style): Mention the variable. - -2002-10-09 Simon Josefsson - - * mml1991.el (mml1991-pgg-sign): Bind pgg-default-user-id, not - pgg-gpg-user-id. - - * pgg.el (pgg-insert-url-with-w3): Ignore errors. - (pgg-fetch-key-function): Nil if w3 is not installed. - -2002-10-08 Kai Gro,A_(Bjohann - - * gnus-agent.el (gnus-agent-fetch-selected-article): Bind - gnus-agent-current-history. - -2002-10-06 Simon Josefsson - - * imap.el (imap-parse-status): Don't use read to read token. - -2002-10-05 Kai Gro,A_(Bjohann - - * gnus-agent.el (gnus-agent-fetch-selected-article): Do nothing - for methods not covered by the agent, and when unplugged. - -2002-10-05 Simon Josefsson - - * pgg-gpg.el (pgg-gpg-encrypt-region): Query passphrase when - signing. - - * gnus-agent.el (gnus-agent-read-servers): If getting method from - a named server fails, ignore the server. - - * mml1991.el (mml1991-pgg-sign): Do QP. - - * pgg-gpg.el (pgg-gpg-encrypt-region): Make signencrypt really - work. - -2002-10-04 Simon Josefsson - - * pgg-gpg.el (pgg-gpg-encrypt-region): Make signencrypt work. - - * pgg-pgp.el (pgg-pgp-verify-region): Inline - binary-write-decoded-region from MEL. - - * pgg.el (pgg-encrypt-region): Support sign. - - * pgg-gpg.el (pgg-gpg-encrypt-region): Ditto. - - * mml2015.el (mml2015-pgg-encrypt): Ditto. - - * pgg.el, pgg-def.el, pgg-parse.el, pgg-gpg.el, pgg-pgp5.el, - pgg-pgp6.el: Moved from ../pgg/. Modifications compared to EMIKO - branch where PGG was taken from in the ChangeLog entries below. - -2002-10-01 Simon Josefsson - - * pgg-pgp.el: Don't require mel. Don't use luna. - (pgg-scheme-pgp-instance, pgg-make-scheme-pgp): Remove. - (pgg-pgp-process-region): Use expand-file-name instead of concat. - (pgg-pgp-process-region): Don't use binary-funcall. - - * pgg-pgp5.el (pgg-pgp5-process-region): Don't use binary-funcall. - - * pgg-gpg.el (pgg-gpg-process-region): Use expand-file-name - instead of concat. - - * pgg-pgp5.el (pgg-pgp5-process-region): Ditto. - -2002-09-29 Simon Josefsson - - * pgg-parse.el (pgg-char-int, pgg-string-as-unibyte): Prevent byte - compile warnings. - - * pgg.el (pgg-decrypt-region): Don't parse packet. - - * pgg.el, pgg-gpg.el, pgg-pgp5.el: Don't depend on luna.el. - -2002-09-29 Daiki Ueno - - * pgg.el: Remove dependency on calist.el. - -2002-09-28 Simon Josefsson - - * pgg.el (pgg-temporary-file-directory): New variable. - (pgg-verify-region): Don't assume set-buffer-multibyte exists. - - * pgg-pgp5.el (pgg-pgp5-process-region, pgg-scheme-verify-region) - (pgg-scheme-snarf-keys-region): Use pgg-temporary-file-directory. - - * pgg-parse.el (pgg-char-int): Defalias. - (pgg-format-key-identifier, pgg-byte-after, pgg-read-byte) - (pgg-read-bytes, pgg-read-body): Use it. - (pgg-decode-packets): Don't use MEL, use base64-*. - (pgg-parse-armor): Don't assume set-buffer-multibyte exists. - (pgg-string-as-unibyte): Defalias. - (pgg-parse-armor-region): Use it. - - * pgg-gpg.el (pgg-gpg-process-region): Use - pgg-temporary-file-directory. - - * luna.el: Don't def-edebug. - - * pgg-pgp5.el (pgg-scheme-verify-region): Inline - binary-write-decoded-region from MEL. - - * pgg-pgp5.el, pgg-gpg.el: Don't require mel. - - * alist.el, calist.el: Don't require product/APEL. - - * pgg-parse.el (top-level): Remove dependency on static.el, - pccl.el, mel.el. - (pgg-parse-crc24, pgg-parse-crc24-string): Only define if - `define-ccl-program' is boundp, instead of using broken. - -2002-10-01 Simon Josefsson - - * message.el (message-required-mail-headers): Remove Lines:. - -2002-10-03 Jesper Harder - - * gnus-group.el (gnus-group-fetch-charter, - gnus-group-fetch-control): Prompt for group if given a prefix - argument. - * gnus-sum.el: Add gnus-group-fetch-charter and - gnus-group-fetch-control to summary key map and menu. - -2002-10-03 Paul Jarc - - * nnmaildir.el (nnmaildir--group-maxnum-art): fix maximum article - number when there are no articles. - -2002-10-03 Kai Gro,A_(Bjohann - - * gnus-agent.el (gnus-agent-summary-fetch-group): Optional prefix - arg ALL means to fetch all articles, not only downloadable ones. - (gnus-agent-fetch-selected-article): New function for - gnus-select-article-hook or gnus-mark-article-hook. - -2002-10-02 Peter von der Ahe - - * gnus-ems.el (gnus-x-splash): Set coding-system-for-read to - raw-text. - -2002-09-30 Ted Zlatanov - - * spam.el: merged changes from pinard@iro.umontreal.ca (Fran,Ag(Bois - Pinard). - Major revamp of the code, documentation is in comments in the file - for now. - -2002-09-30 Simon Josefsson - - * mml2015.el (mml2015-pgg-clear-verify): Verifying in a unibyte - buffer seem to be needed? - -2002-09-29 Simon Josefsson - - * mml1991.el (pgg-output-buffer, pgg-errors-buffer): Prevent byte - compile warnings. - - * mml1991.el (mml1991-function-alist): Add pgg. - (mml1991-pgg-sign, mml1991-pgg-encrypt): New functions. - (mml1991-pgg-encrypt): Fix recipients querying. - -2002-09-28 (tiny change) - - * mml2015.el (autoload): Autoload correct files. - -2002-09-28 Simon Josefsson - - (mml2015-pgg-decrypt, mml2015-pgg-verify): Make sure either nil or - handle is returned. - -2002-09-27 Katsumi Yamaoka - - * gnus-start.el (gnus-fixup-nnimap-unread-after-getting-new-news): - Protect against non-existent of `nnimap-mailbox-info'. - -2002-09-27 Simon Josefsson - - * gnus-start.el (gnus-fixup-nnimap-unread-after-getting-new-news): New. - (gnus-setup-news-hook): Use it. - (gnus-after-getting-new-news-hook): Ditto. - - * nnimap.el (nnimap-fixup-unread-after-getting-new-news): Remove. - -2002-09-27 Mats Lidell - - * gnus-art.el (gnus-article-mode-syntax-table): Replace "-" to " ". - -2002-09-27 TSUCHIYA Masatoshi - - * gnus-sum.el (gnus-nov-parse-line): When an error is signaled in - the part to decode encoded words, use raw words instead of decoded - words. - -2002-09-26 ShengHuo ZHU - - * nnimap.el (nnimap-update-unseen): Use gnus-gethash-safe. - - * mm-view.el (mm-w3m-mode-ignored-keys): New variable. - (mm-setup-w3m): Use it. - -2002-09-27 Simon Josefsson - - * gnus-art.el (gnus-article-mode-syntax-table): Make M-. work in - article buffers. - - * nnimap.el (nnimap-fixup-unread-after-getting-new-news): Autoload - it just in case. - (nnimap-update-unseen): New function; update unseen count in - `n-m-info'. - (nnimap-close-group): Call it. - - * gnus-start.el (gnus-setup-news-hook): Add n-f-u-a-g-n-n. - (gnus-after-getting-new-news-hook): Ditto. - - * nnimap.el (nnimap-retrieve-groups): Move the quick mail check - message into verboselevel 9. Change slow mail check message. - (nnimap-retrieve-groups): Use prefixed names in n-mailbox-info. - (nnimap-fixup-unread-after-getting-new-news): New function, to be - used as a hook after getting new mail. - -2002-09-26 Simon Josefsson - - * imap.el (imap-parse-resp-text-code): The UNSEEN value in - SELECT/EXAMINE is first unseen article, not number of unseen - articles. Make them distinct by renaming the former to - `first-unseen' instead of `unseen'. - - * nnimap.el (nnimap-retrieve-groups): Get uidvalidity and unseen - too. - (nnimap-retrieve-groups): Don't used cached data if uidvalidity - changed. - (nnimap-retrieve-groups): Store uidvalidity and unseen data too. - - * gnus-int.el (gnus-server-unopen-status): Defcustom. - - * mml-sec.el (mml-signencrypt-style): Docstring to font-lock - better. - - * mml2015.el (mml2015-pgg-decrypt): Only add security information - if dissecting resulting buffer actually had any information. - -2002-09-26 Katsumi Yamaoka - - * gnus-group.el (gnus-group-sort-by-method): Remove `symbol-name' - because the function `string<' allows symbols. - - * gnus-sum.el (gnus-summary-make-menu-bar): Ditto. - -2002-09-25 ShengHuo ZHU - - * message.el (message-forward-make-body): Revert an early change - because 8-bit utf-8 emails. - -2002-09-25 Bj,Av(Brn Torkelsson - - * gnus-agent.el (gnus-category-line-format): Doc fixes (mostly added - links to Info) - * gnus-art.el (gnus-treat-highlight-signature): - * gnus-art.el (gnus-treat-buttonize): - * gnus-art.el (gnus-treat-buttonize-head): - * gnus-art.el (gnus-treat-emphasize): - * gnus-art.el (gnus-treat-strip-cr): - * gnus-art.el (gnus-treat-unsplit-urls): - * gnus-art.el (gnus-treat-leading-whitespace): - * gnus-art.el (gnus-treat-hide-headers): - * gnus-art.el (gnus-treat-hide-boring-headers): - * gnus-art.el (gnus-treat-hide-signature): - * gnus-art.el (gnus-treat-fill-article): - * gnus-art.el (gnus-treat-hide-citation): - * gnus-art.el (gnus-treat-hide-citation-maybe): - * gnus-art.el (gnus-treat-strip-list-identifiers): - * gnus-art.el (gnus-treat-strip-pgp): - * gnus-art.el (gnus-treat-strip-pem): - * gnus-art.el (gnus-treat-strip-banner): - * gnus-art.el (gnus-treat-highlight-headers): - * gnus-art.el (gnus-treat-highlight-citation): - * gnus-art.el (gnus-treat-date-ut): - * gnus-art.el (gnus-treat-date-local): - * gnus-art.el (gnus-treat-date-english): - * gnus-art.el (gnus-treat-date-lapsed): - * gnus-art.el (gnus-treat-date-original): - * gnus-art.el (gnus-treat-date-iso8601): - * gnus-art.el (gnus-treat-date-user-defined): - * gnus-art.el (gnus-treat-strip-headers-in-body): - * gnus-art.el (gnus-treat-strip-trailing-blank-lines): - * gnus-art.el (gnus-treat-strip-leading-blank-lines): - * gnus-art.el (gnus-treat-strip-multiple-blank-lines): - * gnus-art.el (gnus-treat-unfold-headers): - * gnus-art.el (gnus-treat-fold-headers): - * gnus-art.el (gnus-treat-fold-newsgroups): - * gnus-art.el (gnus-treat-overstrike): - * gnus-art.el (gnus-treat-display-xface): - * gnus-art.el (gnus-treat-display-smileys): - * gnus-art.el (gnus-treat-from-picon): - * gnus-art.el (gnus-treat-mail-picon): - * gnus-art.el (gnus-treat-newsgroups-picon): - * gnus-art.el (gnus-treat-body-boundary): - * gnus-art.el (gnus-treat-capitalize-sentences): - * gnus-art.el (gnus-treat-fill-long-lines): - * gnus-art.el (gnus-treat-play-sounds): - * gnus-art.el (gnus-treat-translate): - * gnus-art.el (gnus-treat-x-pgp-sig): - * gnus-art.el (gnus-mime-button-line-format): - * gnus-art.el (gnus-button-man-level): - * gnus-art.el (gnus-button-emacs-level): - * gnus-cus.el (gnus-group-parameters): - * gnus-gl.el (bbb-build-mid-scores-alist): - * gnus-group.el (gnus-group-line-format): - * gnus-mlspl.el (gnus-group-split-setup): - * gnus-mlspl.el (gnus-group-split): - * gnus-msg.el (gnus-mailing-list-groups): - * gnus-msg.el (gnus-posting-styles): - * gnus-nocem.el (gnus-nocem-issuers): - * gnus-score.el (gnus-score-regexp-bad-p): - * gnus-srvr.el (gnus-server-line-format): - * gnus-topic.el (gnus-topic-line-format): - * gnus.el (gnus-summary-line-format): - * mail-source.el (mail-sources): - * message.el (message-subscribed-address-file): - * nnmail.el (nnmail-split-fancy): - -2002-09-24 Evgeny Roubinchtein - - * mail-source.el(mail-source-run-script): use `functionp' to test - whether the argument `script' is in fact a function. - (mail-sources): adjust the defcustom to allow users to specify a - function or a string as the value of the `:prescript' and - `:postscript' arguments of the `file' and `pop3' mail sources. - -2002-09-25 Paul Jarc - - * nnmaildir.el (nnmaildir--grp-add-art): fix minimum article - number when article 1 does not exist. - -2002-09-25 Reiner Steib - - * gnus-art.el (gnus-button-handle-apropos-variable): Fall back to - apropos if apropos-variable does not exist. - (gnus-button-guessed-mid-regexp) - (gnus-button-handle-describe-prefix, gnus-button-alist): Better - regexes. - (gnus-button-handle-describe-function) - (gnus-button-handle-describe-variable): Doc fix. - (gnus-button-handle-describe-key, gnus-button-handle-apropos) - (gnus-button-handle-apropos-command): Doc fix. - -2002-09-25 Mark A. Hershberger (tiny change) - - * nnrss.el (nnrss-save-server-data): Save nnrss-group-alist in - the file. - -2002-09-24 ShengHuo ZHU - - * gnus-start.el (gnus-1): Create nndraft:queue, nndraft:drafts. - -2002-09-24 Simon Josefsson - - * mml2015.el (top-level): Require mm-util for mm-make-temp-file. - (mml2015-use): Prefer PGG if installed. - (mml2015-function-alist): Add PGG wrappers. - (mml2015-gpg-extract-signature-details): Check mml2015-use too. - (mml2015-gpg-extract-signature-details): PGG strips "gpg: " - prefix, make regexp optionally skip it. - (mml2015-pgg-decrypt, mml2015-pgg-clear-decrypt) - (mml2015-pgg-verify, mml2015-pgg-clear-verify, mml2015-pgg-sign) - (mml2015-pgg-encrypt): New functions. - (defvar, autoload): Prevent byte-compile warnings. - -2002-09-24 TSUCHIYA Masatoshi . - - * gnus-art.el (article-strip-banner): Check for the existence of - from header. - -2002-09-23 Reiner Steib - - * gnus-art.el (gnus-button-guessed-mid-regexp): Improved regexp. - (gnus-button-alist): Improved regexp for - gnus-button-handle-mid-or-mail (false positives), fixed - gnus-button-handle-man entries. - -2002-09-23 Josh Huber - - * nnmaildir.el (nnmaildir--update-nov): fix wrong-type error when - nnmail-extra-headers is non-nil. - -2002-09-23 Paul Jarc - - * nnmaildir.el: Store article numbers persistently. General - revision. - (nnmaildir-request-expire-articles): handle 'immediate and 'never - for nnmail-expiry-wait; delete instead of moving if 'force is - given. - -2002-09-23 Simon Josefsson - Trivial fix from beaker@iavmb.pl (Krzysztof J,Bj(Bdruczyk). - - * smime.el (smime-sign-buffer): Get key and extra certs. - (smime-get-key-with-certs-by-email): Utility function. - -2002-09-21 ShengHuo ZHU - Trivial patch from Micha Wiedenmann - - * gnus-soup.el (gnus-soup-add-article): Mark as read only when the - article exists. - -2002-09-20 ShengHuo ZHU - - * gnus-sum.el (gnus-summary-next-group): Switch to the summary buffer. - -2002-09-20 Reiner Steib - - * gnus-art.el (gnus-button-handle-custom, - gnus-button-handle-mid-or-mail, - gnus-button-handle-describe-{function,variable,key}, - gnus-button-handle-apropos{,command,variable}): New functions. - (gnus-button-prefer-mid-or-mail,gnus-button-guessed-mid-regexp, - gnus-button-{man,emacs,mail}-level): New variables. - (gnus-button-alist): Use the above to buttonize emacs and mail - related links. - -2002-09-18 Juanma Barranquero - - * gnus-int.el (gnus-status-message): Fix spacing. - - * imap.el (imap-continuation): Fix typos. - -2002-09-18 ShengHuo ZHU - - * gnus-msg.el (gnus-configure-posting-styles): Sort results. - - * gnus-art.el (gnus-article-reply-with-original): Correct - with-current-buffer scope. - - * message.el (message-completion-alist): Add Reply-To, From, etc. - -2002-09-18 Nevin Kapur - - * nnimap.el (nnimap-request-expire-articles): Make flag setting - conditional. - -2002-09-17 Simon Josefsson - - * nnimap.el (nnimap-expiry-target): Don't search for which - articles exists here. - (nnimap-request-expire-articles): Do it here instead. Only expire - when articles are found. Suggested by Nevin Kapur - . - -2002-09-17 Reiner Steib - - * message.el (message-strip-subject-trailing-was) - (message-change-subject, message-add-archive-header) - (message-xpost-fup2-header, message-xpost-insert-note) - (message-xpost-fup2, message-reduce-to-to-cc): New functions - adopted from message-utils.el. Add functions to the keymap, mode - describtion and menu. - (message-change-subject,message-xpost-fup2): Signal error if - current header is empty. - (message-xpost-insert-note): Changed insert position. - (message-archive-note): Ensure to insert note in message body (not - in head). - (message-archive-header, message-archive-note) - (message-xpost-default, message-xpost-note, message-fup2-note) - (message-xpost-note-function): New variables adopted from - message-utils.el. Changed some doc-strings. - (message-mark-insert-{begin,end}): Rename from - message-{begin,end}-inserted-text-mark (message-utils.el), changed - values. - (message-subject-trailing-was-query) - (message-subject-trailing-was-ask-regexp) - (message-subject-trailing-was-regexp): New variables. - (message-to-list-only): Added doc-string and menu entry. - - * message-utils.el: Removed. Functions are now in message.el. - -2002-09-16 ShengHuo ZHU - - * gnus-art.el (gnus-article-reply-with-original, - gnus-article-followup-with-original): Switch to - gnus-summary-buffer before reply/followup. - -2002-09-15 John Paul Wallington - - * gnus-sum.el (gnus-summary-toggle-header): The article window may - not exist. Toggle it anyway. - -2002-09-13 ShengHuo ZHU - - * gnus-msg.el (gnus-copy-article-buffer): Bind mail-header-separator. - - * gnus-art.el (article-fill-long-lines): Fill-paragraph properly. - Trivial patch from Urban Engberg . - - * rfc2047.el (message-posting-charset): Defvar it. - (rfc2047-charset-encoding-alist): Use B for iso-8859-7 and - iso-8859-8. Fix doc. Suggested by Dave Love . - - * mail-source.el (mail-source-fetch): Hide password. - - * gnus-sum.el (gnus-summary-next-group): Semi-exit only when needed. - -2002-09-12 John Paul Wallington . - - * gnus.el (gnus-visual, gnus-meta): Fix typo. - -2002-09-11 Katsumi Yamaoka - - * gnus-art.el (gnus-article-address-banner-alist): Doc fix. - -2002-09-11 Simon Josefsson - - * nnimap.el (nnimap-expiry-target): Only expiry-target existing articles. - (nnimap-split-rule): Doc fix. - (nnimap-request-expire-articles): Cleanup code. - -2002-09-11 TSUCHIYA Masatoshi . - - * gnus-art.el (gnus-article-address-banner-alist): New option. - (article-strip-banner): Refer the above option to split banners of - free mail servers, when no group parameter is specified. - -2002-09-10 Katsumi Yamaoka - - * nntp.el (nntp-wait-for-string): Check for a process in the - current buffer instead of `nntp-server-buffer'. - -2002-09-09 Simon Josefsson - - * gnus-art.el (gnus-button-man-handler): New variable. - (gnus-button-alist): Use g-b-handle-man. - (gnus-button-handle-man): New, call g-b-man-handler. - -2002-09-08 Simon Josefsson - - * gnus-art.el (gnus-button-alist): Buttonize man page links. - -2002-09-07 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-dumbquotes-map): Add \230. - -2002-09-06 Lars Magne Ingebrigtsen - - * gnus-srvr.el (gnus-browse-make-menu-bar): Add "d". - - * gnus-sum.el (gnus-summary-limit-to-unseen): New command and - keystroke. - - * gnus-srvr.el (gnus-browse-describe-group): New command and - keystroke. - -2002-09-06 Katsumi Yamaoka - - * gnus-art.el (gnus-article-treat-body-boundary): Don't quote a - value for gnus-decoration property. - -2002-09-06 Kai Gro,b_(Bjohann - - * nnmail.el (nnmail-cache-fetch-group): Don't return "" (empty - string) as group name in case we have a CRLF in the file. - -2002-09-04 Jesper Harder - - * rfc1843.el (rfc1843-decode-loosely): Move to mime customization - group. - (rfc1843-decode-hzp): do. - (rfc1843-newsgroups-regexp): do. - -2002-09-04 Simon Josefsson - - * message.el (message-canlock-generate): Make sure sha1 doesn't - call external programs. - -2002-09-03 Simon Josefsson - - * nntp.el (nntp-wait-for-string): Dont infloop if process died. - - * gnus-agent.el (gnus-agent-batch): Add doc. - -2002-09-03 Josh Huber - - * gnus-msg.el (gnus-summary-handle-replysign): Change the order we - check for signed and encrypted parts. - * mml.el (mml-parse-1): Correct small typo which preventing - setting recipients in a secure tag. - -2002-09-03 Katsumi Yamaoka - - * mm-util.el (mm-coding-system-priorities): Default to a list of - iso-2022-jp and others for the Japanese environment. - -2002-09-03 Katsumi Yamaoka - - * gnus-util.el (gnus-frame-or-window-display-name): Exclude - invalid display names. - -2002-08-30 Reiner Steib - - * gnus-group.el (gnus-group-fetch-control): Fix typo in last - commit. - -2002-08-26 Jesper Harder - - * gnus.el (gnus-group-charter-alist): New option. - (gnus-group-fetch-control-use-browse-url): New option. - - * gnus-group.el (gnus-group-fetch-charter): New function. - (gnus-group-fetch-control): New function. - Add them to the keymap and menu. Require mm-url. - -2002-08-30 Alex Schroeder . - - * gnus-mlspl.el (gnus-group-split-fancy): Doc fix. - -2002-08-29 Jesper Harder - - * gnus-group.el (gnus-group-make-menu-bar): Add ellipses to menu - items expecting user interaction. - - * gnus-topic.el (gnus-topic-make-menu-bar): do. - - * gnus-sum.el (gnus-summary-make-menu-bar): do. - - * gnus-srvr.el (gnus-server-make-menu-bar): do. - - * mml.el (mml-menu): do. - -2002-08-28 Katsumi Yamaoka - - * mail-source.el (mail-source-touch-pop): New function. - - * message.el (message-smtpmail-send-it): New function. - (message-send-mail-function): Add it for a candidate. - -2002-08-27 Simon Josefsson - - * gnus-msg.el (posting-charset-alist): Use - gnus-define-group-parameter instead of defcustom. - (gnus-put-message): Handle SPC in GCC. - (gnus-inews-insert-gcc): Ditto. - (gnus-inews-insert-archive-gcc): Ditto. - -2002-08-26 Simon Josefsson - - * gnus-agent.el (gnus-agent-auto-agentize-methods): New variable. - (gnus-agentize): Auto agentize all nntp and nnimap groups. - (gnus-agent-possibly-save-gcc): Autoload. - Suggested by (KOSEKI Yoshinori) . - -2002-08-26 Katsumi Yamaoka - - * gnus.el (gnus-other-frame-function): New user option. - (gnus-other-frame): Use it; add a doc-string; make it work with - the gnuclient program. - - * gnus-util.el (gnus-frame-or-window-display-name): New function. - - * lpath.el: Fbind `frame-parameter', `make-frame-on-display', - `device-connection' and `dfw-device'. - -2002-08-22 Jochen Hein (tiny change) - - * gnus-art.el (gnus-emphasis-alist): Strikethru had a lot of false - positives, make it stricter. - -2002-08-21 Katsumi Yamaoka - - * gnus.el (gnus-other-frame): Trivial fix. - -2002-08-21 Katsumi Yamaoka - - * gnus.el (gnus-other-frame-parameters): New user option. - (gnus-other-frame-object): New variable. - (gnus-other-frame): Make it search for existing Gnus frame; don't - read new news; delete frame on exit. - - * gnus-util.el (gnus-select-frame-set-input-focus): New function. - - * lpath.el: Fbind w32-focus-frame and x-focus-frame. - -2002-08-20 $B>.4X(B $B5HB'(B (KOSEKI Yoshinori) . - - * message.el (message-set-auto-save-file-name): Add support for - the Cygwin Emacs; the system-type is `cygwin'. - * nnheader.el (nnheader-file-name-translation-alist): Ditto. - -2002-08-20 ShengHuo ZHU - - * gnus-art.el (gnus-button-url-regexp): Use POSIX regexp if possible. - - * nnmh.el (nnmh-request-list-1): Use %.0f instead of %d to - avoid arithmetic errors. - -2002-08-20 Katsumi Yamaoka - - * gnus-art.el: Don't fbind `gnus-article-replace-with-quoted-text'. - -2002-08-19 Katsumi Yamaoka - - * message.el (message-ignored-supersedes-headers): Add X-Hashcash. - (message-ignored-resent-headers): Add envelope From. - -2002-08-18 Kai Gro,b_(Bjohann - - * gnus.el (gnus-summary-line-format): Document %k specifier. - -2002-08-17 Kai Gro,b_(Bjohann - - * gnus-sum.el (gnus-summary-line-message-size): New function. - (gnus-summary-line-format-alist): Use it. - -2002-08-15 Katsumi Yamaoka - - * gnus-art.el (article-make-date-line): Refer to the value for - `gnus-article-time-format' in the summary buffer. - - * message.el (message-cite-prefix-regexp): Exclude ":" and ",A;(B". - -2002-08-14 Simon Josefsson - - * gnus-art.el (gnus-button-alist): Use ' not ` for default value - quoting. - (gnus-button-alist): Fix doc. - (gnus-header-button-alist): Use ' not ` for default value quoting. - (gnus-header-button-alist): Don't inline gnus-button-url-regexp, - rationale similar to 2002-05-01 change. - (gnus-article-add-buttons-to-head): Evaluate expression. - - * gnus-sum.el (gnus-summary-make-menu-bar): Add MIME button option. - -2002-08-14 Katsumi Yamaoka - - * message.el (message-font-lock-keywords): Refer to the value for - `message-cite-prefix-regexp' dynamically. - -2002-08-13 Katsumi Yamaoka - - * gnus-art.el (gnus-decode-header-methods): Doc fix. - -2002-08-12 Simon Josefsson - - * imap.el (imap-shell-open): Allow non-list `imap-shell-program'. - (imap-shell-open): Skip initial junk before IMAP greeting. - -2002-08-11 Reiner Steib - - * message-utils.el (message-xpost-default) - (message-xpost-fup2-header, message-xpost-fup2): Fixed Typos. - -2002-08-09 Simon Josefsson - - * message.el (message-canlock-password): Set - canlock-password-for-verify to newly generated canlock-password. - When Emacs is restarted, Custom makes sure this is set, but during - the same session we must set it manually. - -2002-08-07 Jesper Harder - - * yenc.el: New file. - - * mm-uu.el (mm-uu-yenc-decode-function): New variable. - (mm-uu-type-alist): Add yenc. - (mm-uu-yenc-filename): New function. - (mm-uu-yenc-extract): New function. - - * mm-bodies.el (mm-decode-content-transfer-encoding): Add yenc. - -2002-08-06 ShengHuo ZHU - - * dgnushack.el (merge): Don't use coerce. - -2002-05-27 Jesper Harder - - * mailcap.el (mailcap-mime-data): Test window-system rather than - mm-device-type. - (mailcap-mime-data): Call xdvi and gv with "-safer". - - * mm-util.el: Don't define mm-device-type. - -2002-08-05 Simon Josefsson - - * mm-util.el (mm-coding-system-priorities): coding-system type not - supported everywhere. - -2002-08-04 Lars Magne Ingebrigtsen - - * gnus.el (gnus-version-number): Bumped version number. - -2002-08-04 01:48:57 Lars Magne Ingebrigtsen - - * gnus.el: Oort Gnus v0.07 is released. - -2002-08-04 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-thread-sort-functions): Doc fix. - (gnus-article-sort-functions): Doc fix. - (t): New keystroke. - (gnus-article-sort-by-random): New function. - (gnus-thread-sort-by-random): New function. - -2002-08-02 Scott A Crosby - - * gnus-logic.el (gnus-advanced-integer): Swap arguments in - funcall. - -2002-07-31 Danny Siu - - * nnimap.el (nnimap-split-articles): do not call nnmail-fetch-field - when splitting malformed messages without message-id - -2002-07-28 Niklas Morberg . - - * nnweb.el (nnweb-type, nnweb-type-definition) - (nnweb-gmane-create-mapping, nnweb-gmane-wash-article) - (nnweb-gmane-search, nnweb-gmane-identity): Added gmane - functionality. - * nnweb.el: Removed old non-functioning search engines. - -2002-07-27 Simon Josefsson - - * message.el (message-forward-make-body): Don't use - `message-forward-ignored-headers' when doing a "raw" followup (it - is important to preserve e.g. CTE). - - * flow-fill.el (fill-flowed): Disable filladapt-mode. - - * gnus-sieve.el (gnus-sieve-guess-rule-for-article): Don't - regexp-quote, Cyrus Sieve is fixed. - - * sieve-manage.el (sieve-manage-deletescript): New function. - - * sieve.el (sieve-manage-mode-map): Fix down-mouse-2 and down-mouse-3. - (sieve-manage-mode): Fix menubar. - (sieve-activate): Change some messages. - (sieve-deactivate-all): New function. - (sieve-deactivate): New alias. - (sieve-remove): New function. - (sieve-help): Fix help. - All suggested by Ned Ludd. - -2002-07-24 Katsumi Yamaoka - - * mm-decode.el (mm-inline-text-html-with-images): Doc fix. - (mm-w3m-safe-url-regexp): New user option. - - * mm-view.el (mm-inline-text-html-render-with-w3m): Use - `mm-w3m-safe-url-regexp' to bind `w3m-safe-url-regexp'. - -2002-07-23 Karl Kleinpaste - - * gnus-sum.el (gnus-summary-delete-article): Force - nnmail-expiry-target to 'delete, so that absolute deletion - happens when absolute deletion is requested. - -2002-07-21 Nevin Kapur . - - * nnmail.el (nnmail-fancy-expiry-target): Treat nonexisting - headers as empty headers. - -2002-07-21 Jochen Hein . - - * gnus-art.el (gnus-emphasis-alist): Add strikethrough and - correct typo. - (gnus-emphasis-strikethru): New face. - -2002-07-20 Jason Merrill . - - * nnfolder.el (nnfolder-retrieve-headers): Avoid searching the - entire file for each of a sequence of missing articles. - - * gnus-salt.el (gnus-binary-display-article): Respect an existing - value for gnus-view-pseudos. - - * gnus-sum.el (gnus-summary-insert-new-articles): Count down to - avoid nreverse. - -2002-07-14 Ted Zlatanov - - * gnus-sum.el (gnus-auto-expirable-marks): Remove `spam'. - (gnus-summary-mode-line-format-alist): Add %h for number of - spams. - (gnus-newsgroup-spam-marked): New variable. - (gnus-summary-local-variables): Add gnus-newsgroup-spam-marked. - (gnus-article-read-p, gnus-article-mark) - (gnus-set-global-variables, gnus-set-global-variables) - (gnus-article-marked-p, gnus-summary-mark-article-as-read) - (gnus-summary-mark-article-as-unread) - (gnus-summary-mark-article-as-unread, gnus-summary-mark-article) - (gnus-mark-article-as-read, gnus-mark-article-as-unread) - (gnus-mark-article-as-unread, gnus-summary-catchup): Grok spam. - -2002-07-10 KANEMATSU Daiji - - * nnimap.el (nnimap-split-to-groups): Allow group string to be a - function. - -2002-07-09 Nevin Kapur - - * gnus-sum.el (gnus-summary-delete-article): Respect group - parameters while expiring. - -2002-07-08 Henrik Enberg - - * gnus-art.el (article-make-date-line): Fix string. - -2002-07-08 Niklas Morberg - - * gnus-art.el (article-unsplit-urls): Only display MIME when this - function is called interactively. - -2002-07-06 ShengHuo ZHU - - * gnus-topic.el (gnus-topic-indent, gnus-topic-unindent): Change - cdaar to cdar and car. - - * nnsoup.el (nnsoup-retrieve-headers, nnsoup-request-type) - (nnsoup-read-active-file, nnsoup-article-to-area): Ditto. - -2002-07-05 Katsumi Yamaoka - - * gnus-sum.el (gnus-summary-toggle-header): Show headers anyway; - don't break a narrowed article. - - * nntp.el (nntp-via-rlogin-command-switches): Doc fix. - (nntp-open-via-rlogin-and-telnet): Ditto. - -2002-07-02 Didier Verna - - * nnmail.el (nnmail-split-methods): fix custom type. - -2002-07-02 Niklas Morberg - - * gnus-art.el (article-unsplit-urls): Keep URL buttonized after - unsplitting. - -2002-07-01 Kai Gro,b_(Bjohann - - * gnus-msg.el (gnus-summary-resend-default-address): New user option. - (gnus-summary-resend-message): Use it. - -2002-06-28 Katsumi Yamaoka - - * nntp.el (nntp-via-rlogin-command-switches): New variable. - (nntp-open-via-rlogin-and-telnet): Re-revert; use the var above. - -2002-06-28 Katsumi Yamaoka - - * message.el (message-font-lock-keywords): Don't fontify - headers in the message body, only in the header. - (message-font-lock-make-header-matcher): New function, used by - message-font-lock-keywords. - -2002-06-28 Katsumi Yamaoka - - * nntp.el (nntp-open-via-rlogin-and-telnet): Revert last change. - -2002-06-28 Katsumi Yamaoka - - * nntp.el (nntp-open-via-rlogin-and-telnet): Hide commandline args. - -2002-06-26 Kai Gro,b_(Bjohann - - * message.el (message-font-lock-keywords): Revert 2002-06-22 - change. - -2002-06-24 Kai Gro,b_(Bjohann - - * message.el (message-font-lock-keywords): Put colon in header - name match. - -2002-06-22 Kai Gro,b_(Bjohann - - * message.el (message-font-lock-keywords): Don't use header faces - in the body. Thanks to Stefan Monnier for the hint on the - implementation. - -2002-05-09 Miles Bader - - * gnus-cite.el (gnus-cite-blank-line-after-header): New variable. - (gnus-article-hide-citation): Respect it. - -2002-04-12 Juanma Barranquero - - * pop3.el (pop3-open-server): Fix typo. - -2002-06-18 Josh Huber - - * gnus.el (gnus-find-subscribed-addresses): Use add-to-list - instead of push to ignore duplicate to-(list|address) values. - * nnmail.el (nnmail-cache-ignore-groups): New. - * nnmail.el (nnmail-cache-insert): Obey nnmail-cache-ignore-groups - -2002-06-18 Kai Gro,b_(Bjohann - - * gnus-delay.el (gnus-delay-send-queue): Delete the delay header - before sending. Suggested by Jan Rychter. - -2002-06-18 Katsumi Yamaoka - - * dgnushack.el (remove): New compiler macro. - (last, coerce, subseq): Remove compiler macros for those built-in - or unused functions. - -2002-06-17 Simon Josefsson - - * gnus-start.el (gnus-clear-system, gnus-read-newsrc-file): Make - sure to write byte-compiled versions of gnus-*-format-alist to - .newsrc.eld. - -2002-06-16 Bj,Ax(Brn Mork - - * gnus-agent.el (gnus-agent-read-servers) - (gnus-agent-write-servers): Put server name (string like - "nnchoke:frumple") in the file instead of a server specification - (Lisp expression like (nnchoke "frumple" ...parameters...)). - -2002-06-16 Reiner Steib - - * gnus-cache.el (gnus-cache-remove-article): n is &optional. - -2002-06-15 ShengHuo ZHU - - * nnheader.el (nnheader-file-name-translation-alist): Set the - default value for MS Windows systems. - - * gnus-ems.el (nnheader-file-name-translation-alist): Removed. - -2002-06-14 Katsumi Yamaoka - - * message.el (message-beginning-of-line): Keep the region active - in XEmacs. Suggested by TAKAHASHI Kaoru . - -2002-06-13 Josh Huber - - * gnus-msg.el (gnus-summary-followup): Use g-s-handle-replysign. - * gnus-msg.el (gnus-summary-reply): Ditto. - * gnus-msg.el (gnus-summary-handle-replysign): New. - -2002-06-12 Katsumi Yamaoka - - * message.el (message-send-mail-with-sendmail): Kill errbuf even - if sending failed. - -2002-06-11 Josh Huber - - * gnus-start.el (gnus-dribble-enter): Don't call set-window-point anymore - * mml2015.el (mml2015-mailcrypt-encrypt): Accept optional argument - to sign while encrypting. - -2002-06-11 Simon Josefsson - - * gnus-int.el (gnus-request-move-article): Agent expire article if - successfuly moved. - -2002-06-11 Niklas Morberg - - * nnweb.el (nnweb-google-create-mapping): Honors the value of - nnweb-max-hits. - -2002-06-10 Simon Josefsson - - * gnus-int.el (gnus-request-expire-articles): Fix last change? - -2002-06-09 Simon Josefsson - - * gnus-sum.el (gnus-summary-delete-article): Don't agent expire here. - - * gnus-int.el (gnus-request-expire-articles): Do it here instead. - -2002-06-08 ShengHuo ZHU - - * flow-fill.el (fill-flowed): Ignore errors. - -2002-06-06 Simon Josefsson - - * message.el (message-send-mail-with-sendmail): Improve error message. - -2002-06-06 Kai Gro,b_(Bjohann - - * message.el (message-interactive): Change default from nil to t. - Better to be safe than to be fast. - -2002-06-05 Kai Gro,b_(Bjohann - - * message.el (message-send-mail-with-sendmail): Check return value - from call-process-region. - -2002-06-04 Simon Josefsson - - * gnus-msg.el (gnus-group-mail, gnus-group-news) - (gnus-group-post-news, gnus-summary-mail-other-window) - (gnus-summary-news-other-window, gnus-summary-post-news): Bind - gnus-article-copy to nil, thereby inhibiting the `header' posting - style match to use data from last viewed article. - Suggested by Hrvoje Niksic. - -2002-06-04 Katsumi Yamaoka - - * spam.el (spam-point-at-eol): New alias. - (spam-parse-whitelist): Use it. - -2002-06-03 Simon Josefsson - - * nnmail.el (nnmail-mail-splitting-decodes): New variable. - (nnmail-article-group): Use it. - -2002-05-30 Jesper Harder - - * gnus-msg.el (gnus-inews-yank-articles): Merge split header lines - so that code reading them won't be surprised. - -2002-05-29 Simon Josefsson - - * gnus-sum.el (gnus-summary-delete-article): Agent expire deleted - articles. - - * gnus.el (gnus-agent-cache): Doc fix. - (gnus-agent): Change default to t. - - * gnus-agent.el (gnus-agent-expire): Make it accept optional - ARTICLES, GROUP and FORCE parameters. - -2002-05-28 Simon Josefsson - - * gnus-group.el (gnus-group-line-format): Doc fix. - -2002-05-28 Jesper Harder - - * gnus-msg.el (gnus-inews-yank-articles): Unfold headers of - original article before yanking. - -2002-05-26 Simon Josefsson - - * gnus-sum.el (gnus-summary-menu-split): New function. - (gnus-summary-make-menu-bar): Split charset submenu. - (gnus-summary-menu-maxlen): New variable. - (gnus-summary-menu-split): Use it. - -2002-05-25 Simon Josefsson - - * mml.el (mml-preview): Generate some headers. - - * gnus.el (gnus-large-newsgroup): Fix :type. - - * nnimap.el (nnimap-nov-is-evil): Change default to t (because the - Agent cache NOV's by default now). - (nnimap-nov-is-evil): Make it default to `gnus-agent' instead. - -2002-05-18 Jesper Harder - - * gnus-sum.el (gnus-dependencies-add-header): Avoid one unecessary - call to gnus-parent-id when we check for References loops. - (gnus-summary-prepare-threads): Avoid simplifying every Subject - twice by saving the simplified subject string in simp-subject. - -2002-05-23 Benjamin Rutt (tiny change) - - * gnus-msg.el (gnus-confirm-mail-reply-to-news): Typo. - -2002-05-23 Niklas Morberg (tiny change) - - * nnweb.el (nnweb-type): Remove dejanewsold. - -2002-05-22 Simon Josefsson - - * sieve.el (sieve-change-region): Define it before it is used. - -2002-05-22 Benjamin Rutt - - * gnus-msg.el (gnus-confirm-mail-reply-to-news) - (gnus-summary-reply): Ask for confirmation when replying to news. - Defaults to not ask. - - * nnimap.el (nnimap-nov-is-evil): Improve doc. - -2002-05-21 Simon Josefsson - - * sieve-mode.el (sieve-manage): Fix autoloads. - - * sieve-manage.el (sieve-manage-cram-md5-auth): Just send the SASL - name (makes it work with recent Cyrus timsieved). - -2002-05-20 Jason - Trivial patch. - - * gnus-art.el (gnus-request-article-this-buffer): Try - reconnecting if you don't get the message. - -2002-05-20 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-enter-digest-group): Only get - Reply-To headers from the headers. - -2002-05-18 Lars Magne Ingebrigtsen - - * mm-url.el (mm-url-insert): Remove junk message. - -2002-05-17 Lars Magne Ingebrigtsen - - * nnslashdot.el (nnslashdot-request-list): Parse new html. - (nnslashdot-use-front-page): New variable. - (nnslashdot-request-list): Use it. - - * mm-url.el (mm-url-timeout): New variable. - (mm-url-retries): Ditto. - (mm-url-insert): Use it. - -2002-05-16 Simon Josefsson - - * gnus-sum.el (gnus-simplify-all-whitespace): New function. - (gnus-simplify-subject-functions): Mention g-s-a-w. - -2002-05-15 Josh Huber - - * nnbabyl.el (nnbabyl-request-accept-article): Pass group to - nnmail-cache-insert. - * nndiary.el (nndiary-request-accept-article): Ditto. - * nnfolder.el (nnfolder-request-accept-article): Ditto. - * nnimap.el (nnimap-request-accept-article): Ditto. - * nnmail.el (nnmail-process-unix-mail-format): Ditto. - * nnmail.el (nnmail-check-duplication): Ditto. (from gnus-art) - * nnmbox.el (nnmbox-request-accept-article): Ditto. - * nnmh.el (nnmh-request-accept-article): Ditto. - * nnmail.el (nnmail-cache-insert): Change group to required, - removed code which tried to figure out the group. - -2002-05-13 Hans de Graaff - - * mml.el (mml-generate-mime-1): Fix mml generation for signed only - messages. - -2002-05-13 Josh Huber - - * nnml.el (nnml-request-accept-article): Pass in the group name to - nnmail-cache-insert, since it's available. - -2002-05-10 ShengHuo ZHU - - * nndoc.el (nndoc-mime-digest-type-p): Set proper file-end. - -2002-05-08 Florian Weimer - - * gnus.el (subscribed): New group parameter. - (gnus-find-subscribed-addresses): Use it. - -2002-05-08 Josh Huber - - * mml-sec.el (mml-signencrypt-style-alist): Rename. Also, changed - the default for pgpmime to support pgp v2. - * mml-sec.el (mml-signencrypt-style): New accessor function to - allow users to get/set the signencrypt style more easily without - frobbing the alist directly. - * mml.el (mml-generate-mime-1): Use accessor function. - -2002-05-08 Kai Gro,b_(Bjohann - - * gnus-art.el (gnus-article-mode-syntax-table): Specify matching - parenthesis for "<" and ">". Suggested by Andreas Schwab - . - -2002-05-07 Josh Huber - - * nnmail.el (nnmail-cache-insert): Prefer group-art over group - when intuiting the group the message is written to. - -2002-05-06 Matt Armstrong - - * gnus-topic.el (gnus-group-topic-parameters): Work when group - buffer doesn't show group. - -2002-05-06 Josh Huber - - * mml2015.el (mml2015-gpg-encrypt): Changed name of optional - argument, and fixed compiler warning. (added autoload for - gpg-encrypt). - -2002-05-04 Simon Josefsson - - * mml1991.el (mml1991-function-alist): Doc fix. - - * mml.el (mml-preview): Bind gnus-newsrc-hashtb temporarily if it - doesn't exist (for previewing messages without having Gnus - started). - - * mm-util.el (mm-coding-system-priorities): Defcustom. - - * mm-encode.el (mm-content-transfer-encoding-defaults): Defcustom. - -2002-05-01 Josh Huber - - * gnus-msg.el (gnus-message-replysignencrypted): enabled by - default. - * mml-sec.el: - * mml-sec.el (mml-signencrypt-style): New. - * mml-sec.el (mml-pgpmime-encrypt-buffer): Accept optional - argument `sign'. - * mml-sec.el (mml-secure-message-encrypt-pgp): Changed default to - signencrypt. - * mml-sec.el (mml-secure-message-encrypt-pgpmime): Ditto. - * mml.el (mml-generate-mime-1): Changed logic so a part which is - both signed & encryped is processed in one operation. (rather than - two separate ops: sign, then encrypt) - * mml2015.el (mml2015-gpg-extract-signature-details): Give some - indication if a message is signed by an expired key. - * mml2015.el (mml2015-gpg-encrypt): Accept optional argument which - enables combined sign & encrypt operation. (this was always on - before). - * mml2015.el (mml2015-encrypt): Accept optional argument `sign'. - -2002-05-01 Simon Josefsson - - * nnimap.el (nnimap-retrieve-groups): Use separate data for each - server. - (nnimap-mailbox-info): defvar instead of defvoo. - -2002-05-01 20:09:21 Lars Magne Ingebrigtsen - - * gnus.el: Oort Gnus v0.06 is released. - -2002-05-01 Lars Magne Ingebrigtsen - - * lpath.el: Bind url-package-version. - -2002-05-01 Simon Josefsson - - * nnfolder.el (nnfolder-request-delete-group): Figure out nov/mrk - filename before deleting the group itself, because the presence of - a group filename decides if long filenames are used or not. - - * gnus-art.el (gnus-button-alist): Don't inline - gnus-button-url-regexp. This makes it possible to change g-b-u-r - without also modifying g-button-alist. - (gnus-button-alist): Fix type to allow variable as well as regexp. - (gnus-article-add-buttons): Evaluate regexp. Strings evaluate to - themselves, variables to its contents. - (gnus-button-entry): Ditto. - -2002-05-01 Simon Josefsson - - * imap.el (imap-parse-resp-text-code, imap-parse-status): Treat - UIDNEXT as a string. - - * nnimap.el (nnimap-string-lessp-numerical): New function. - (nnimap-retrieve-groups): Compare UIDNEXT as strings instead of - integers. - -2002-04-29 Simon Josefsson - - * nnmail.el (nnmail-cache-insert): Accept optional group - parameter. - - * nnimap.el (nnimap-retrieve-groups): Don't send STATUS when - n-r-g-a is disabled. - -2002-04-29 Simon Josefsson - - * nnimap.el (nnimap-split-fancy): Fix doc. - (nnimap-split-fancy): Fix doc. - - * nnimap.el (nnimap-retrieve-groups-asynchronous): New variable. - (nnimap-mailbox-info): New internal variable. - (nnimap-retrieve-groups): Implement faster new mail check. - - * nnimap.el (nnimap-split-articles): Support - nnmail-cache-accepted-message-ids. - (nnimap-request-accept-article): Ditto. - - * imap.el (imap-mailbox-status-asynch): New command. - -2002-04-29 Nevin Kapur - - * gnus.el (gnus-find-subscribed-addresses): Return nil when there - are no subscribed mail groups. - - Strip quoted names when comparing addresses - -2002-04-28 Jesper Harder - - * mm-decode.el (mm-text-html-renderer): Change customize type to - const. - - * gnus-msg.el (gnus-discouraged-post-methods): Fix typo. - (gnus-debug-exclude-variables): do. - -2002-04-27 ShengHuo ZHU - - * gnus-msg.el (gnus-article-mail): Use gnus-msg-mail instead. - Trivial change from Karl Pfl,Ad(Bsterer . - -2002-04-27 Katsumi Yamaoka - - * dns.el (dns-make-network-process): New macro. - (query-dns): Use it. - -2002-04-27 ShengHuo ZHU - - * gnus-msg.el (gnus-summary-reply): Remove unbound variable - article-buffer. - - * mm-url.el (mm-url-package-name): New variable. - (mm-url-package-version): New variable. - (mm-url-insert-file-contents): Bind url-package-name and - url-package-version here. - * nnrss.el (nnrss-insert-w3): Move the bindings. - - * nnrss.el (nnrss-insert-w3): Bind url-package-name and - url-package-version. Trivial change from Andrew J Cosgriff - - - * mm-decode.el (mm-save-part): Fill in file name when GUI saving - attachments. Trivial change from Peter 'Luna' Runestig - . - -2002-04-19 Jesper Harder - - * nnkiboze.el (nnkiboze-request-scan): Call - nnkiboze-possibly-change-group. - (nnkiboze-generate-group): Use mm-with-unibyte to avoid encoding - problems. - (nnkiboze-generate-group): Set newsrc to the *highest* article - number kibozed, not the lowest. - -2002-04-15 Jesper Harder - - * gnus-art.el (article-unsplit-urls): Allow trailing SPC. - -2002-04-24 Dan Christensen - - * nndoc.el (nndoc-type-alist, nndoc-lanl-gov-announce-type-p) - (nndoc-transform-lanl-gov-announce, nndoc-generate-lanl-gov-head): - Recognize math postings. Extract Date (now ignores "(15kb)"). - Extract email address using gnus-extract-address-components - instead of just taking the first word. Create Date and From - headers for message which are missing these headers. Get rid - of spurious \\ lines (purely cosmetic). Extend body-end and - file-end regexps, to exclude more garbage from the message. - Make URL rephrasing regexp more flexible, to match current - format. - -2002-04-23 Simon Josefsson - - * netrc.el: New file, functions copied from gnus-util.el by Ted - Zlatanov . - - * gnus-util.el: Require netrc. - (gnus-netrc-get, gnus-netrc-machine, gnus-parse-netrc): Aliased to - new code in netrc.el. - -2002-04-23 Matthieu Moy - - * gnus-msg.el (gnus-summary-resend-message-edit): Remove - message-ignored-resent-headers, too. - -2002-04-22 Bj,Av(Brn Torkelsson - - * gnus-srvr.el (gnus-server-browse-in-group-buffer): it is a - boolean not a string - * gnus-group.el (gnus-group-line-format): add description of %C - * gnus-group.el (gnus-group-line-format-alist): add gnus-tmp-comment - as %C - * gnus-group.el (gnus-group-insert-group-line): add gnus-tmp-comment - -2002-04-22 Paul Jarc - - * nnmaildir.el (nnmaildir-request-scan): typo: set - nnmaildir-get-new-mail, not nnmaildir-new-mail. Don't call - nnmail-get-new-mail for 'find-new-groups. - -2002-04-21 Paul Jarc - - * nnmaildir.el (nnmaildir-request-update-info, - nnmaildir-request-group, nnmaildir-retrieve-groups): remove - unnecessary calls to nnmaildir-request-scan. - -2002-04-20 Josh Huber - - * gnus-msg.el: - * gnus-msg.el (gnus-message-replysign): New. - * gnus-msg.el (gnus-message-replyencrypt): New. - * gnus-msg.el (gnus-message-replysignencrypted): New. - * gnus-msg.el (gnus-summary-reply): Use the three new variables - (above) to automatically encrypt/sign to encrypted/signed - messages. - * message.el: - * message.el (message-mode-map): Add keybinding for - `message-to-list-only' - * message.el (message-mode): Add description for - `message-to-list-only' - * message.el (message-to-list-only): New. - * message.el (message-make-mft): Changed to use the cl loop macro, - and added optional flag to return only the matched list. (for use - in new message-to-list-only function) - -2002-04-20 Josh Huber - - * gnus-msg.el: - * gnus-msg.el (gnus-message-replysign): - * gnus-msg.el (gnus-replysign): New. - * gnus-msg.el (gnus-replyencrypt): New. - * gnus-msg.el (gnus-replysignencrypted): New. - * gnus-msg.el (gnus-summary-reply): - * message.el: - * message.el (message-mode-map): - * message.el (message-mode): - * message.el (message-to-list-only): New. - * message.el (message-make-mft): - -2002-04-19 ShengHuo ZHU - - * gnus-win.el (gnus-configure-windows-hook): Fix typo. - -2002-04-18 Josh Huber - - * message.el (message-gen-unsubscribed-mft): accept a prefix - argument so CC can be included with C-u C-c C-f C-a - -2002-04-17 Ted Zlatanov - - * spam.el (spam-whitelist, spam-blacklist, spam-enter-whitelist): - Improve docstring. - (spam-enter-blacklist): New command. - - * gnus-sum.el (gnus-spam-mark): New mark. - (gnus-auto-expirable-marks): Add gnus-spam-mark. - (gnus-summary-make-tool-bar): Correct conditional. - (gnus-summary-limit-to-unread): Add gnus-spam-mark. - (gnus-summary-mark-as-spam): New command. - -2002-04-13 Josh Huber - - * mml-sec.el (mml-secure-message): changed to support arbritrary - modes. - * mml-sec.el (mml-secure-message-encrypt-(smime|pgp|pgpmime)): - changed to support "signencrypt" mode. - * mml.el (mml-parse-1): changed to support different secure modes - more easily. (for signencrypt) - -2002-04-11 Stefan Monnier - - * gnus-sum.el (gnus-update-summary-mark-positions) - (gnus-summary-toggle-header): - * gnus-uu.el (gnus-uu-binhex-article, gnus-uu-reginize-string) - (gnus-uu-expand-numbers, gnus-uu-post-make-mime) - (gnus-uu-post-encoded): - * nnfolder.el (nnfolder-possibly-change-group): - * nnimap.el (nnimap-retrieve-headers): - * nnmbox.el (nnmbox-create-mbox): Don't assume point-min == 1. - -2002-04-08 Stefan Monnier - - * nnml.el (nnml-save-nov, nnml-generate-nov-file): - * pop3.el (pop3-md5): Don't hardcode point-min == 1. - -2002-04-12 Daiki Ueno - - * gnus-srvr.el (gnus-server-set-info): Clear - `gnus-server-method-cache' when `gnus-server-alist' is changed. - -2002-04-11 Simon Josefsson - - * gnus-sum.el (gnus-summary-force-verify-and-decrypt): Force - viewing of security buttons. Thanks to Nicolas Kowalski - . - - * smime.el (smime-CA-directory): Fix doc. Thanks to Arne - J,Ax(Brgensen . - (smime-sign-buffer): Work in XEmacs. Thanks to Nicolas Kowalski - . - (smime-decrypt-buffer): Ditto. - -2002-04-11 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-prepare): Place point on the emtpy - header line. - -2002-04-11 Per Abrahamsen - - * gnus.el (gnus-refer-article-method): Change `dejanews' to `google'. - -2002-04-08 ShengHuo ZHU - - * gnus-sum.el (gnus-summary-delete-marked-with): Fix typo. - -2002-04-07 ShengHuo ZHU - - * mm-view.el (mm-inline-text-html-render-with-w3): Don't ignore - errors when debug. - -2002-04-07 Josh Huber - - * message.el (message-make-mft): Changed MFT code from using - message-recipients (which included Bcc) to use only the To and CC - headers. - -2002-04-05 Per Abrahamsen - - * gnus-art.el (gnus-treat-from-picon): Add to gnus-picon group and - add link. - (gnus-treat-mail-picon): Ditto. - (gnus-treat-newsgroups-picon): Ditto. - (gnus-picon-databases): Fix custom type. - (gnus-picon-databases): Add link. - (gnus-article-x-face-command): Add to gnus-picon group. - -2002-04-01 Jesper Harder - - * message.el (message-buffer-naming-style): Remove. - -2002-04-02 ShengHuo ZHU - - * gnus-group.el (gnus-group-make-tool-bar): Load tool-bar first. - - * message.el (message-tool-bar-map): Ditto. - - * gnus-sum.el (gnus-summary-make-tool-bar): Ditto. - -2002-04-01 ShengHuo ZHU - - * nnwarchive.el (nnwarchive-mail-archive-article): Fix typo. - -2002-04-01 Paul Jarc - - * nnmaildir.el: fixed some buggy invocations of nnmaildir--pgname. - -2002-03-31 Andrew Cohen - Trivial patch. - - * dns.el: open-network-stream under XEmacs does udp. - -2002-03-31 Lars Magne Ingebrigtsen - - * spam.el (spam-enter-whitelist): New function. - (spam-parse-whitelist): Ditto. - (spam-refresh-list-cache): Ditto. - (spam-address-whitelisted-p): New function. - - * dns.el (query-dns): Use TCP when make-network-process isn't - available. - (dns-servers): New variable. - (dns-parse-resolv-conf): New function. - (query-dns): Use it. - - * spam.el: New file. - - * dns.el (query-dns): Test. - -2002-03-31 Lars Magne Ingebrigtsen - - * lpath.el (featurep): Bind make-network-process. - -2002-03-31 Paul Jarc - - * nnmaildir.el: Use defstruct. Use a single copy of - nnmail-extra-headers to save memory. Store server's group name - prefix instead of each group's prefixed name. - * nnnil.el (nnnil-retrieve-headers, nnnil-request-list): Erase - nntp-server-buffer. - -2002-03-31 Lars Magne Ingebrigtsen - - * dns.el: New file. - -2002-03-28 Simon Josefsson - - * gnus-sum.el (gnus-summary-dummy-line-format): - * gnus.el (gnus-summary-line-format): Fixing links to Info. - Trivial change from Bj,Av(Brn Torkelsson . - -2002-03-29 Kai Gro,b_(Bjohann - - * gnus-sum.el (gnus-summary-move-article) - (gnus-summary-copy-article): Mention `gnus-move-split-methods' in - the doc string. - -2002-03-28 Simon Josefsson - - * mml-sec.el (mml-secure-message): Search after - mail-header-separator from top of message. - -2002-03-28 Paul Jarc - - * nnmaildir.el: Cosmetic changes. - (nnmaildir--with-nntp-buffer, nnmaildir--with-work-buffer, - nnmaildir--with-nov-buffer, nnmaildir--with-move-buffer, - nnmaildir--group-ls): New macros/functions. Use them. - (nnmaildir--unlink): Evalutate argument only once. - -2002-03-27 Jesper Harder - - * gnus-sum.el (gnus-summary-highlight): Use `eq' when comparing - symbols. - (gnus-summary-highlight-line): Use `gnus-point-at-bol' and - `gnus-point-at-eol'. - -2002-03-27 Paul Jarc - - * nnmaildir.el (nnmaildir--subdir, nnmaildir--nov-dir, - nnmaildir--marks-dir): New macros. Use them. - Use inhibit-quit for atomicity instead of in-memory journaling. - (nnmaildir--edit-prep): New function. - (Local Variables): Use it. - -2002-03-26 Pavel@Janik.cz (Pavel Jan,Am(Bk) - - * gnus-sum.el (gnus-summary-make-menu-bar): Fix typo. - -2002-03-25 Simon Josefsson - - * message.el (message-mode): Fix doc. - -2002-03-25 Matthieu Moy - - * message.el (message-subject-re-regexp): Skip Re[42]: junk. - -2002-03-24 Jesper Harder - - * mml-sec.el (mml-unsecure-message): Add docstring. - -2002-03-23 Andre Srinivasan (tiny change) - - * nnmail.el (nnmail-large-newsgroup): Fix doc, allow non-numeric - value. - -2002-03-22 Josh Huber - - * mml.el (mml-mode-map): Added a keybinding for - `mml-unsecure-message'. Also, added a menu entry for said - function in the Attachments menu. - -2002-03-22 Katsumi Yamaoka - - * canlock.el (canlock-version): Remove. - (canlock-sha1-with-openssl): Don't use `canlock-string-as-unibyte' - here; simplify \x insertions. - (canlock-sha1): New function, always return a unibyte string. - (canlock-make-cancel-key): Use `canlock-sha1'; simplify truncation - of a password. - (canlock-insert-header): Use `canlock-sha1'. - (canlock-verify): Ditto. - -2002-03-21 ShengHuo ZHU - - * message.el (message-fix-before-sending): Add an option that - ignores illegible text. - Trivial change from Mark Milhollan - - * message.el (message-font-lock-keywords): Support multi-line MML - tags. - -2002-03-21 L,Bu(Brentey K,Ba(Broly - - * gnus-sum.el (gnus-print-buffer): Remove gnus-decoration. - -2002-03-20 Katsumi Yamaoka - - * gnus-sum.el (gnus-summary-make-menu-bar): Use intern'ed function - symbols for "View as different encoding" submenu. - -2002-03-19 Simon Josefsson - - * gnus-sum.el (gnus-summary-make-menu-bar): Add "View as different - encoding" submenu. - -2002-03-19 ShengHuo ZHU - - * gnus-group.el (gnus-group-process-prefix): Make sure there is a mark. - -2002-03-19 Kai Gro,b_(Bjohann - - * gnus-sum.el (gnus-sum-thread-tree-root) - (gnus-sum-thread-tree-single-indent) - (gnus-sum-thread-tree-vertical, gnus-sum-thread-tree-indent) - (gnus-sum-thread-tree-leaf-with-other) - (gnus-sum-thread-tree-single-leaf): Make customizable. - -2002-03-16 Francis Litterio - - * gnus-util.el (gnus-extract-address-components): Don't break on - names such as James "Kibo" Parry. - -2002-03-13 Pavel Jan,Am(Bk - - * pop3.el (pop3-open-server): Revert multibyte change. - - * message.el (message-send-mail-with-qmail): Make it work. - -2002-03-13 Josh Huber - - * message.el (message-make-mft): Set case-fold-search while - generating the MFT. Also, a little cleanup in the MFT code. - -2002-03-12 Faried Nawaz (tiny change) - - * message.el (message-qmail-inject-args): May be function. Adjust - doc string and custom type. - (message-send-mail-with-qmail): Call function if m-q-i-a is a - function. - -2002-03-12 ShengHuo ZHU - - * message.el (message-abbrevs-loaded): Remove. - (mailabbrev): Require it. - - * nnslashdot.el (nnslashdot-request-article): Remove IFRAME. - -2002-03-12 Katsumi Yamaoka - - * pop3.el (pop3-open-server): Set process buffer unibyte. - -2002-03-10 Lars Magne Ingebrigtsen - - * gnus-fun.el (gnus-subscribe-to-mailing-list): New function. - -2002-03-10 ShengHuo ZHU - - * nnslashdot.el (nnslashdot-request-article): Remove javascript - too. - -2002-03-09 Andre Srinivasan (tiny change) - - * gnus-sum.el (gnus-summary-save-parts-default-mime): Remove - duplication. - (gnus-summary-save-parts-type-history): Ditto. - (gnus-summary-save-parts-last-directory): Ditto. - -2002-03-09 Paul Jarc - - * gnus-start.el (gnus-auto-subscribed-groups): Include nnmaildir. - -2002-03-06 Matthieu Moy - - * gnus-msg.el (gnus-summary-resend-message-edit): New function. - -2002-03-06 ShengHuo ZHU - - * nnslashdot.el (nnslashdot-request-article): Use "" as the end of the first article. - - * message.el (message-add-action): Use add-to-list. - (message-delete-action): New function. - - * nndoc.el (nndoc-mail-in-mail-type-p): Break a long regexp into - pieces. - -2002-03-05 Paul Jarc - - * nnnil.el: New file. - * gnus.el (gnus-valid-select-methods): Include nnnil. - -2002-03-05 ShengHuo ZHU - - * message.el (message-syntax-checks): Because canlock is - supported, we disable sender syntax check. - (message-shoot-gnksa-feet): Add cancel-messages option doc. - - * gnus-draft.el (gnus-draft-send): If interactive, use its default - value of message-syntax-checks. - - * qp.el (quoted-printable-decode-region): Doc addition. - From: Eli Zaretskii - - * mail-source.el (make-source-make-complex-temp-name): Use - make-temp-file. - - * mm-util.el (mm-make-temp-file): New function. - * nneething.el (nneething-file-name): Use it. - * mml-smime.el (mml-smime-encrypt): Ditto. - * mm-view.el (mm-inline-wash-with-file): Ditto. - * mm-decode.el (mm-display-external, mm-create-image-xemacs): Ditto. - * gnus-uu.el (gnus-uu-decode-binhex, gnus-uu-decode-binhex-view) - (gnus-uu-digest-mail-forward, gnus-uu-initialize): Ditto. - * gnus-start.el (gnus-slave-save-newsrc): Ditto. - * gnus-fun.el (gnus-convert-image-to-gray-x-face): Ditto. - * gnus-art.el (gnus-mime-print-part): Ditto. - -2002-03-04 Paul Jarc - - * message.el (nnmaildir-article-number-to-base-name): New - function. - (nnmaildir-base-name-to-article-number): New function. - -2002-03-04 Katsumi Yamaoka - - * smime.el (smime-make-temp-file): Don't quote - `temporary-file-directory'. - -2002-03-04 Simon Josefsson - - * smime.el (smime-sign-region): Rename argument keyfiles to - keyfile. You only sign something with one key. - (smime-sign-buffer): Better completing-read prompt. - (smime-decrypt-buffer): Ditto. - - * smime.el (smime-make-temp-file): Make it work under XEmacs. - - * mm-view.el (mm-view-pkcs7-decrypt): Better prompt for - completing-read. - (mm-view-pkcs7-decrypt): CRLF->LF. - -2002-03-04 Teodor Zlatanov - - * message.el (message-hierarchical-addresses): New variable. - (message-get-reply-headers): Use it. - -2002-03-03 Geoff Greene (tiny change) - - * message.el (message-mode): If buffer-file-name, don't set auto - save file name. - -2002-03-02 ShengHuo ZHU - - * gnus-util.el (gnus-multiple-choice): Use message. XEmacs only - takes one argument in read-char. - - * message.el (message-fix-before-sending): Forward a char. - Check mmu-multibyte-p, add control-1. - -2002-03-01 ShengHuo ZHU - - * gnus-start.el (gnus-read-init-file): Ditto. - - * gnus-agent.el (gnus-agent-fetch-session): Ditto. - - * dgnushack.el (dgnushack-make-load): Ditto. - - * mail-source.el (mail-source-fetch): Extract the right error - code. - - * message.el (message-fix-before-sending): Check illegible text. - - * gnus-util.el (gnus-multiple-choice): New function. - - * gnus-kill.el (gnus-score-insert-help): Removed, because it is - also defined in gnus-score.el. - -2002-03-01 Paul Jarc - - * message.el (message-get-reply-headers): downcase email addresses - for comaparisons for duplicate removal. - -2002-03-01 ShengHuo ZHU - - * mm-view.el (mm-view-pkcs7-verify): New function. A bogus - implementation of PKCS#7, which just allows users read the - message. - (mm-view-pkcs7): Use it. - -2002-02-27 ShengHuo ZHU - - * gnus.el (large-newsgroup-initial): New parameter. - - * gnus-sum.el (gnus-articles-to-read): Use large-newsgroup-initial. - (gnus-summary-insert-old-articles): Ditto. - -2002-02-26 TSUCHIYA Masatoshi - - * gnus-sum.el (gnus-articles-to-read): `gnus-large-newsgroup' is - used as the default answer of the question, "How many articles?". - -2002-02-26 ShengHuo ZHU - - * nnagent.el (nnagent-retrieve-headers): Remove articles with - small numbers. - -2002-02-24 ShengHuo ZHU - - * deuglify.el: Fix comments. - -2002-02-23 Andre Srinivasan (tiny change) - - * mml.el (mml-generate-mime-1): Add cdr. - -2002-02-23 ShengHuo ZHU - - * html2text.el (html2text-clean-anchor): If there is no HREF, - insert nothing. - - * mm-view.el (mm-text-html-renderer-alist): Add html2text. - (mm-text-html-washer-alist): Ditto. - - * mm-decode.el (mm-text-html-renderer): Add html2text. - - * html2text.el: Face lift. - - * html2text.el: New file from Joakim Hove . - -2002-02-22 ShengHuo ZHU - - * gnus-sum.el: Add gnus-article-outlook-deuglify-article. - - * deuglify.el: Change copy right. Add autoload. Add coding-system. - -2002-02-22 Raymond Scholz - - * deuglify.el: New file. The original file name is - gnus-outlook-deuglify.el. - -2002-02-22 Andre Srinivasan (tiny change) - - * mm-decode.el (mm-display-external): Use - mm-file-name-rewrite-functions. - -2002-02-22 Paul Jarc - - * nnmaildir.el (nnmaildir-request-list): Report the highest - article number, not the total number of articles. - -2002-02-21 ShengHuo ZHU - - * gnus-sum.el: Move uu key map here. - (gnus-summary-make-menu-bar): Add gnus-summary-save-parts. - -2002-02-21 Paul Jarc - - * nnmaildir.el (nnmaildir-request-expire-articles): Use - nnmail-expiry-wait* if expire-age parameter is not set. - -2002-02-21 ShengHuo ZHU - - * gnus-group.el (gnus-group-sort-groups-by-real-name): New - function. - (gnus-group-sort-selected-groups-by-real-name): New function. - (gnus-group-make-menu-bar): Add sort by real name. - - * gnus-sum.el (gnus-dependencies-add-header): If replaced, don't - rebuild. - (gnus-summary-edit-article-done): Gnus-get-newsgroup-headers takes - nil as dependencies as well. - -2002-02-20 ShengHuo ZHU - - * nndoc.el (nndoc-dissect-mime-parts-sub): Fix MIME-Version header - for mime-parts. - - * gnus-art.el (gnus-article-edit-done): Widen the buffer. - - * message.el (message-send-mail): Be talkative. - -2002-02-20 TSUCHIYA Masatoshi - - * gnus-group.el (gnus-group-name-decode): Don't test - multibyte-string, because it breaks XEmacs. - -2002-02-20 Reiner Steib - - * mm-decode.el (mm-inlined-types): Add application/x-emacs-lisp. - (mm-automatic-display): Ditto. - - * mailcap.el (mailcap-mime-data): Ditto. - -2002-02-20 Katsumi Yamaoka - - * many files: Remove trailing whitespaces, replace spc+tab with - tab, replace leading whitespaces with tabs. - -2002-02-19 Paul Jarc - - * gnus-sum.el (gnus-summary-toggle-header): Fix handling of - articles with no body and no blank line after the header. - -2002-02-19 ShengHuo ZHU - - * mm-decode.el (mm-dissect-multipart): Consider the case of empty - parts. - - * ietf-drums.el (ietf-drums-syntax-table): Modify syntax of - non-ascii chars. - - * rfc2231.el (rfc2231-parse-string): Support non-ascii chars. - - * gnus-art.el (gnus-article-wash-html-with-w3): Remove - w3-delay-image-loads. - * mm-view.el (mm-inline-text-html-render-with-w3): Ditto. - (mm-w3-prepare-buffer): Ditto. - - * mail-source.el (mail-source-fetch-directory): Run scripts. - -2002-02-19 Lars Magne Ingebrigtsen - - * gnus-fun.el (gnus-respond-to-confirmation): Do the right thing - for Majordomo confirmations. - -2002-02-18 Lars Magne Ingebrigtsen - - * gnus-fun.el (gnus-respond-to-confirmation): New command. - -2002-02-11 Lars Magne Ingebrigtsen - - * nnultimate.el (nnultimate-retrieve-headers): Clean up. - -2002-02-18 Mark Thomas - - * gnus-util.el (gnus-parent-id): Ignore trailing whitespace in the - References header field. - -2002-02-18 ShengHuo ZHU - - * mm-view.el (mm-inline-render-with-file): With unibyte buffer. - (mm-inline-render-with-stdin): Ditto. - (mm-inline-render-with-function): Ditto. - (mm-inline-wash-with-file): Bind coding-system-for-write. - (mm-inline-wash-with-stdin): Ditto. - -2002-02-18 ShengHuo ZHU - - Suggested by Felix Natter - - * gnus-art.el (gnus-mime-view-part-externally): Rename from - gnus-mime-externalize-view. - (gnus-mime-view-part-internally): Rename from - gnus-mime-internalize-view. - (gnus-article-view-part-externally): Rename from - gnus-article-externalize-part. - (gnus-mime-action-alist): Change correspondingly. - (gnus-mime-button-commands): Ditto. - (gnus-mime-action-alist): Remove duplication. - - * gnus-sum.el (gnus-summary-mime-map): Change correspondingly. - -2002-02-18 ShengHuo ZHU - - * mm-decode.el (mm-dissect-buffer): Add loose-mime parameter. - - * gnus-art.el (gnus-display-mime): Use it. - - * mm-partial.el (mm-partial-find-parts): Use it. - - * gnus-sum.el (gnus-article-loose-mime): Rename from - gnus-article-no-strict-mime. - (gnus-summary-save-parts): Use it. - -2002-02-18 Katsumi Yamaoka - - * gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Remove unused - local variable. - - * gnus-art.el (article-display-x-face): Don't sort multiple - X-Faces. - -2002-02-18 Katsumi Yamaoka - - * gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Improved to speed - up. Suggested by Yuuichi Teranishi . - - * gnus-art.el (article-display-x-face): Sort gray X-Faces. - -2002-02-17 ShengHuo ZHU - - Some ideas is inspired by code from Hrvoje Niksic - - - * gnus-art.el (gnus-article-wash-function): Set the default to - nil, so that we use mm-text-html-renderer instead. - (article-wash-html): Use mm-text-html-renderer. - - * mm-decode.el (mm-inline-media-tests): Use mm-inline-text-*. - (mm-text-html-renderer): New variable. - (mm-inline-text-html-renderer): Set the default to nil, so that we - use mm-text-html-renderer instead. - - * mm-view.el (mm-inline-text-html): New function. - (mm-text-html-renderer-alist): New variable. - (mm-inline-text-vcard): New function. - (mm-inline-text): Split. - (mm-links-remove-leading-blank): New function. - (mm-inline-render-with-file): New function. - (mm-inline-render-with-stdin): New function. - (mm-inline-render-with-function): New function. - (mm-text-html-washer-alist): New variable. - (mm-inline-wash-with-file): New function. - (mm-inline-wash-with-stdin): New function. - -2002-02-17 Reiner Steib - - * message-utils.el: Fix installation doc. - -2002-02-16 ShengHuo ZHU - - * gnus-msg.el (gnus-discouraged-post-methods): New variable. - (gnus-post-method): Use it. - (gnus-summary-cancel-article): Find the correct post-method. - - * gnus-soup.el (gnus-soup-send-packet): Via ... using ... - * message.el (message-send-news): Ditto. - Suggested by Lloyd Zusman and IPmonger - - - * gnus.el (gnus-select-method): Fix doc. - (gnus-server-string): Use 'using nntp'. - - * gnus-agent.el (gnus-slave-unplugged): New command. - From: Felix Natter - -2002-02-15 ShengHuo ZHU - - * gnus-art.el (gnus-article-edit-done): Kill-all-local-variables. - Call edit-done-function first, then change the window - configuration. - (gnus-article-edit-mode-map): Add message key bindings. Add menu. - (gnus-article-edit-mode): mml-mode. - - * gnus-util.el (gnus-byte-compile): Work around a bug in XEmacs - 21.4. Suggested by Russ Allbery . - - * message-utils.el: Adopt the file. - -2002-02-15 Holger Schauer - - * message-utils.el: New file. - -2002-02-14 ShengHuo ZHU - - * gnus-sum.el (gnus-summary-move-article): Select-article only - when gnus-move-split-methods is non-nil. And we don't render or - mark the article. - - * gnus-fun.el (gnus-shell-command-to-string): New function. - (gnus-shell-command-on-region): New function. - (gnus-random-x-face): Use them. - (gnus-x-face-from-file): Ditto. - (gnus-convert-image-to-gray-x-face): Ditto. - (gnus-convert-gray-x-face-to-xpm): Ditto. - (gnus-convert-image-to-x-face-command): Don't use 2>/dev/null. - -2002-02-14 Katsumi Yamaoka - - * gnus-art.el (gnus-treat-display-xface): Don't use - `shell-command-to-string' when compiling. - (gnus-treat-display-grey-xface): Ditto. - -2002-02-13 Paul Jarc - - * nnmaildir.el (nnmaildir--article-count): If the group is - completely empty, report minimum article number as 1 instead of 0. - -2002-02-13 ShengHuo ZHU - - * gnus-agent.el (gnus-get-predicate): Use nconc. - - * gnus-sum.el (gnus-summary-display-make-predicate): Use - gnus-summary-display-cache as cache. - - * nndoc.el (nndoc-type-alist): Add mail-in-mail type. - (nndoc-mail-in-mail-type-p): New function. - (nndoc-mail-in-mail-article-begin): New function. - -2002-02-12 ShengHuo ZHU - - * mailcap.el (mailcap-mime-data): Use enriched-decode. - - * gnus-cite.el (gnus-article-fill-cited-article): Bind - use-hard-newlines to nil. - - * gnus-xmas.el (gnus-xmas-image-type-available-p): Assume that - image is not available if window-system is not available. - - * gnus-sum.el (gnus-summary-display-make-predicate): Add unread. - -2002-02-11 ShengHuo ZHU - - * gnus.el (gnus-article-unpropagated-mark-lists): Don't propagate - bookmark, because update-mark doesn't handle it correctly. - -2002-02-09 ShengHuo ZHU - - * gnus-soup.el (gnus-soup-send-packet): Send news and mail - directly instead of calling message-send-mail. - - * gnus-start.el (gnus-read-descriptions-file): Use - gnus-default-charset. - - * mm-util.el (mm-guess-mime-charset): New function. - - * gnus.el (gnus-default-charset): Use it. - (gnus-group-charset-alist): Remove .*, Let gnus-default-charset be - the default. - -2002-02-08 ShengHuo ZHU - - * gnus-art.el (gnus-treat-display-grey-xface): New variable. - (article-display-x-face): Use it. Disable grey xface, if - uncompface is not found. - - * message.el (message-mode): Don't enable multibyte on an indirect - buffer. - - * nnrss.el (nnrss-content-function): New variable. - (nnrss-request-article): Use it. - -2002-02-08 ShengHuo ZHU - - * gnus.el: Add article-unsplit-urls. - * gnus-sum.el: Ditto. - * gnus-art.el (gnus-treat-strip-cr): New variable. - (gnus-treatment-function-alist): Use it. - (article-unsplit-urls): New function. - (gnus-article-make-menu-bar): Use it. - From: Michael Cook - -2002-02-08 ShengHuo ZHU - - * gnus-agent.el (gnus-agent-braid-nov): Find the first article to - copy. - -2002-02-07 Paul Jarc - - * gnus-util.el (gnus-split-references): Allow (broken) Message-IDs - with internal whitespace. - (gnus-parent-id): Ditto. - -2002-02-07 ShengHuo ZHU - - * gnus-art.el (gnus-article-treat-body-boundary): Add - gnus-decoration property. - * gnus-msg.el (gnus-copy-article-buffer): Remove gnus-decoration. - - * gnus-art.el (gnus-article-treat-unfold-headers): Don't remove - too many spaces. - - * rfc2047.el (rfc2047-unfold-region): Ditto. - (rfc2047-decode-region): Don't unfold. Let - gnus-article-treat-unfold-headers do it. - -2002-02-07 Matt Armstrong . - - * message.el (message-mode): Set local-abbrev-table. - -2002-02-07 Jesper Harder - - * gnus-sum.el (gnus-dependencies-add-header): Fix typo. - -2002-02-06 Lars Magne Ingebrigtsen - - * gnus-msg.el (gnus-posting-styles): Add x-face-file. - (gnus-configure-posting-styles): Use it. - (gnus-configure-posting-styles): Remove trailing newspaces. - -2002-02-06 ShengHuo ZHU - - * gnus-sum.el (gnus-articles-to-read): Fetch all if the predicate - is non-nil. - - * mm-util.el (mm-use-find-coding-systems-region): Add doc. - - * gnus.el (gnus-server-to-method): Switch position with - gnus-server-get-method. - (gnus-agent): Add doc. - - * gnus-sum.el (gnus-article-no-strict-mime): New variable. - (gnus-summary-save-parts): Use it. - - * gnus-art.el (gnus-display-mime): Use it. - * mm-partial.el (mm-partial-find-parts): Use it. - - * nnweb.el (nnweb-google-parse-1): Use a correct format of date. - - * nnagent.el (nnagent-request-expire-articles): Don't delete - files. - -2002-02-06 Stefan Reich,Av(Br - - * gnus-agent.el (gnus-agent-summary-make-menu-bar): Fix typo. - -2002-02-05 Sriram Karra - - * message.el (message-gen-unsubscribed-mft): New function. - -2002-02-05 ShengHuo ZHU - - * gnus.el (gnus-article-unpropagated-mark-lists): Backslash the - open parenthesis. - - * mm-view.el (mm-w3-prepare-buffer): Bind url-gateway-unplugged. - (mm-inline-text-html-render-with-w3): Ditto. - * gnus-art.el (gnus-article-wash-html-with-w3): Ditto. - Suggested by Dave Love . - - * mm-url.el (mm-url-load-url): Require w3-vars for old versions. - - * nntp.el (nntp-send-command-and-decode): Check PROCESS. - * nntp.el (nntp-send-command): Ditto. - * nntp.el (nntp-send-command-nodelete): Ditto. - -2002-02-04 ShengHuo ZHU - - * mm-url.el (mm-url-load-url): New function. - (mm-url-insert-file-contents): Use it. - - * gnus-msg.el (gnus-summary-mail-forward): Use gnus-article-charset. - - * message.el (message-forward-make-body): Correctly copy - forward-buffer. - - * rfc2047.el (rfc2047-decode-region): Don't decode us-ascii characters. - -2002-02-04 Simon Josefsson - - * gnus-art.el (gnus-article-followup-with-original): Mark with - force, prevent errors when following up from article buffer. - (gnus-article-reply-with-original): Ditto. - - * binhex.el (binhex-decoder-switches): Fix doc. From - Pavel@Janik.cz (Pavel Jan,Am(Bk). - -2002-02-04 ShengHuo ZHU - - * gnus-art.el (gnus-treatment-function-alist): Move hide-citation, - highlight-citation after emphasize. - -2002-02-04 David Edmondson - - * nnfolder.el (nnfolder-open-marks): Message when done. - - * nnml.el (nnml-open-marks): Ditto. - -2002-02-03 Steinar Bang - - * imap.el (imap-anonymous-auth): Fix typo. - -2002-02-03 ShengHuo ZHU - - * gnus-cache.el (gnus-cache-braid-nov): Use set-buffer instead of - save-excursion. - (gnus-cache-braid-heads): Ditto. - - * gnus-agent.el (gnus-agent-copy-nov-line): Move to the correct - line, because there are extra articles in the overview buffer. - - * nntp.el (nntp-retrieve-groups): Check whether BUF is live. - - * message.el (message-forward-rmail-make-body): Directly use - rmail-msg-restore-non-pruned-header to avoid calling - vertical-motion. - -2002-02-02 ShengHuo ZHU - - * gnus-cache.el (gnus-summary-insert-cached-articles): - (gnus-summary-limit-include-cached): gnus-newsgroup-cached is sorted. - - * gnus-group.el (gnus-group-mark-article-read): Nreverse - gnus-newsgroups-unselected. - - * gnus-agent.el (gnus-summary-set-agent-mark): Use - gnus-add-to-sorted-list. - - * gnus-sum.el (gnus-summary-update-info): gnus-newsgroup-unreads - gnus-newsgroup-unselected are sorted. Use gnus-sorted-union. - (gnus-build-all-threads): Use gnus-add-to-sorted-list. - (gnus-update-read-articles): UNREAD is sorted. - (gnus-newsgroup-unreads, gnus-newsgroup-unselected) - (gnus-newsgroup-marked, gnus-newsgroup-cached) - (gnus-newsgroup-expirable, gnus-newsgroup-downloadable) - (gnus-newsgroup-dormant): Require sorted. - - * gnus-dired.el (gnus-dired-find-file-mailcap): Correctly handle - directories. - (gnus-dired-print): New function. - - * gnus-art.el (gnus-mime-print-part): Add argument filename. Call - ps-despool. - -2002-02-02 Simon Josefsson - - * gnus-dired.el (turn-on-gnus-dired-mode): Autoload. Make defun. - -2002-02-02 ShengHuo ZHU - - * gnus-start.el (gnus-1): Call gnus-agentize if gnus-agent is - t. This makes gnus-agent customizable without putting - gnus-agentize into .gnus. - - * gnus.el (gnus-agent): Make it customizable. - - * gnus-cache.el (gnus-cache-articles-in-group): Remove from active - if no article. - (gnus-cache-possibly-remove-article): Ditto. - (gnus-cache-possibly-enter-article): Use gnus-add-to-sorted-list. - -2002-02-02 Benjamin Rutt - - * gnus-dired.el: New file. - -2002-02-01 Simon Josefsson - - * gnus-int.el (gnus-request-accept-article): Use gnus-get-function. - -2002-02-01 Katsumi Yamaoka - - * mm-view.el (mm-w3m-mode-dont-bind-keys): New variable. - (mm-setup-w3m): Don't bind keys listed in the above. - -2002-02-01 Katsumi Yamaoka - - * mm-view.el (mm-inline-text-html-render-with-w3m): Bind - `w3m-safe-url-regexp' with nil if `mm-inline-text-html-with-images' - is non-nil; bind `w3m-force-redisplay' with nil. - - * gnus-art.el (gnus-article-wash-html-with-w3m): Ditto. - - * mm-decode.el (mm-inline-text-html-with-images): Supplement docs. - -2002-01-31 ShengHuo ZHU - - * nnfolder.el (nnfolder-request-replace-article): Unfold. Don't - use mail-header-unfold-field. - - * gnus-cache.el (gnus-summary-insert-cached-articles): Use - gnus-summary-limit. - - * gnus-range.el (gnus-add-to-sorted-list): New function. - * gnus-sum.el (gnus-mark-article-as-read): Use it. - (gnus-mark-article-as-unread): Ditto. - (gnus-summary-mark-article-as-unread): Ditto. - (gnus-build-get-header): Ditto. - (gnus-summary-prepare-threads): Ditto. - (gnus-summary-insert-pseudos): Ditto. - (gnus-articles-to-read): Use gnus-sorted-union and gnus-sorted-nunion. - (gnus-summary-insert-new-articles): Use gnus-sorted-nunion. - (gnus-summary-insert-old-articles): Ditto. - - * gnus-msg.el (gnus-posting-styles): Add new format of header. - (gnus-configure-posting-styles): Support the new format. - - * mail-source.el (mail-source-bind, mail-source-bind-common): Set - edebug-form-spec to (sexp body). - Suggested by Joe Wells . - - * message.el (message-reply-headers): Add doc. - -2002-01-30 ShengHuo ZHU - - * gnus-group.el (gnus-group-delete-group): Nix the entry in - gnus-cache-active-hashtb. - - * gnus-agent.el (gnus-agent-mark-unread-afer-downloaded): New variable. - (gnus-agent-summary-fetch-group): Use it. - - * gnus-msg.el (gnus-debug-files): New variable. - (gnus-debug-exclude-variables): New variable. - (gnus-debug): Use them. - - * gnus-range.el (gnus-range-length): Don't use gnus-uncompress-range. - -2002-01-30 ShengHuo ZHU - - * message.el (message-cite-prefix-regexp): Use text-mode-syntax-table. - (message-mode-syntax-table): Move back the previous position. - - * nnagent.el (nnagent-retrieve-headers): Use gnus-sorted-difference. - - * gnus-agent.el (gnus-agent-retrieve-headers): Use - gnus-sorted-difference. - - * nnsoup.el (nnsoup-request-expire-articles): Use - gnus-sorted-difference. - - * nnheader.el: Autoload gnus-sorted-difference. - - * nnfolder.el (nnfolder-request-expire-articles): Use - gnus-sorted-difference. - - * gnus-cache.el (gnus-cache-retrieve-headers): Use - gnus-sorted-difference. - - * gnus-range.el: Autoload cookies. - (gnus-sorted-difference): New function. - (gnus-sorted-ndifference): New function. - (gnus-sorted-nintersection): Rename from - gnus-set-sorted-intersection. - (gnus-sorted-nunion): Rename from gnus-set-sorted-union. - (gnus-list-range-difference): Rename from - gnus-inverse-list-range-intersection. - (gnus-inverse-list-range-intersection): Use defalias. - - * gnus-sum.el (gnus-select-newsgroup): Use gnus-sorted-difference, - gnus-sorted-ndifference, and gnus-sorted-nintersection. - (gnus-articles-to-read): Use gnus-sorted-difference. - (gnus-summary-limit-mark-excluded-as-read): Use - gnus-sorted-intersection and gnus-sorted-ndifference. - (gnus-list-of-read-articles): Use gnus-list-range-difference. - (gnus-summary-insert-articles): Use gnus-sorted-difference. - - * gnus-sum.el (gnus-summary-update-info): Use gnus-sorted-union. - -2002-01-30 Katsumi Yamaoka - - * gnus-art.el (gnus-article-wash-html-with-w3m): Add keymap - property to the buffer for using emacs-w3m command keys. - - * mm-decode.el (mm-inline-text-html-with-w3m-keymap): New user - option. - - * mm-view.el (mm-w3m-mode-map): New variable. - (mm-w3m-mode-command-alist): New variable. - (mm-w3m-minor-mode): Removed. - (mm-setup-w3m): Setup `mm-w3m-mode-map'; don't add minor mode. - (mm-inline-text-html-render-with-w3m): Add keymap property to the - buffer for using emacs-w3m command keys. - -2002-01-29 ShengHuo ZHU - - * message.el (message-mode-syntax-table): Move forward. - (message-cite-prefix-regexp): Auto detect non word constituents. - (message-cite-prefix-regexp): Don't use with-syntax-table. - - * gnus-sum.el (gnus-summary-update-info): Use - gnus-list-range-intersection. - - * gnus-agent.el (gnus-agent-fetch-headers): Use - gnus-list-range-intersection. - - * gnus-range.el (gnus-range-normalize): Use correct predicate. - (gnus-list-range-intersection): Use it. - (gnus-inverse-list-range-intersection): Ditto. - (gnus-sorted-intersection): Add doc. - (gnus-set-sorted-intersection): Add doc. - (gnus-sorted-union): New function. - (gnus-set-sorted-union): New function. - - * gnus-range.el (gnus-list-range-intersection): Correct the logic. - (gnus-inverse-list-range-intersection): Ditto. - -2002-01-29 Karl Kleinpaste - - * mm-uu.el (mm-uu-type-alist): Add optional leading `0'. - - * gnus-uu.el (gnus-uu-shar-name-marker): Add optional leading `0' - and permit `:' and `\' in order to handle full Windows pathnames. - (gnus-uu-begin-string): Add optional leading `0'. Leading `0' is - technically not correct per standard, but seems to have common use. - -2002-01-29 ShengHuo ZHU - - * gnus-uu.el (gnus-uu-expand-numbers): Ignore errors when - replacing numbers. - -2002-01-28 ShengHuo ZHU - - * gnus-art.el (gnus-article-followup-with-original): Use (mark). - - * gnus-score.el (gnus-score-insert-help): Move to (point-min). - Don't split when the window is small, e.g. when a small *BBDB* - window is the lowest one. - - * gnus-agent.el (gnus-agent-retrieve-headers): Use - nnheader-find-nov-line to speed up. Use nreverse, because it is - sorted. Use nnheader-insert-nov-file. - -2002-01-28 Katsumi Yamaoka - - * mm-decode.el (mm-inline-text-html-with-images): New user option. - - * mm-view.el (mm-inline-text-html-render-with-w3m): Bind the value - of `w3m-display-inline-images' with the value of - `mm-inline-text-html-with-images'. - From: TSUCHIYA Masatoshi . - - * gnus-art.el (gnus-article-wash-html-with-w3m): Ditto. - -2002-01-27 Richard M. Stallman - - * time-date.el: Add autoload cookies. Many doc fixes. - (time-add): New function. - (time-subtract): Renamed from subtract-time. - (subtract-time): New alias for time-subtract. - -2002-01-28 Katsumi Yamaoka - - * gnus-art.el (gnus-article-wash-html-with-w3m): Replace w3m to - emacs-w3m in doc-string. - - * lpath.el: Bind `w3m-cid-retrieve-function-alist' and - `w3m-current-buffer'. - -2002-01-27 TSUCHIYA Masatoshi - - * gnus-art.el (gnus-article-wash-html-with-w3m): Handle cid: URLs. - - * mm-view.el (mm-setup-w3m): Add `mm-w3m-cid-retrieve' to - `w3m-cid-retrieve-function-alist' for `gnus-article-mode'. - (mm-w3m-cid-retrieve): New function. - (mm-inline-text-html-render-with-w3m): Handle cid: URLs. - -2002-01-27 ShengHuo ZHU - - * gnus-agent.el (gnus-agent-fetch-articles): Don't save empty articles. - -2002-01-27 Lars Magne Ingebrigtsen - - * gnus-util.el (gnus-cache-file-contents): Don't use equalp. - -2002-01-26 Lars Magne Ingebrigtsen - - * nnheader.el (nnheader-insert-nov-file): Increased cutoff to - 32K. - - * gnus-sum.el (gnus-summary-expire-articles): Clean up. - - * nnmail.el (nnmail-article-group): Decode headers before running - split rules over them. - (nnmail-mail-splitting-charset): New variable. - - * smiley.el: Replaced with smiley-ems.el. - -2002-01-26 ShengHuo ZHU - - * mm-url.el (mm-url-predefined-programs): Add w3m. - (mm-url-program): Ditto. - -2002-01-26 Lars Magne Ingebrigtsen - - * nnml.el (nnml-use-compressed-files): New variable. - (nnml-filenames-are-evil): Removed. - (nnml-current-group-article-to-file-alist): Don't use. - (nnml-update-file-alist): Inhibit. - (nnml-article-to-file): Use new var. - -2002-01-26 ShengHuo ZHU - - * gnus-util.el (gnus-parse-without-error): Add edebug-form-spec. - - * nnagent.el (nnagent-retrieve-headers): loop until eobp. - -2002-01-26 Lars Magne Ingebrigtsen - - * gnus-agent.el (gnus-agent-load-alist): Use new caching - function. - - * gnus-util.el (gnus-cache-file-contents): New function. - - * gnus-agent.el (gnus-agent-file-loading-cache): New variable. - (gnus-agent-load-alist): Use it. - - * nnagent.el (nnagent-retrieve-headers): Use optimized function. - - * nnheader.el (nnheader-insert-nov-file): New function. - - * gnus-util.el (gnus-parse-without-error): Correct the loop. - - * gnus-sum.el (gnus-dependencies-add-header): Use in-reply-to if - there are no references. - (gnus-extract-message-id-from-in-reply-to): New function. - (gnus-nov-parse-line): Use in-reply-to if there are no - references. - -2002-01-25 Lars Magne Ingebrigtsen - - * nnagent.el (nnagent-retrieve-headers): Use new macro. - - * gnus-util.el (gnus-parse-without-error): New macro. - -2002-01-25 ShengHuo ZHU - - * gnus-art.el (gnus-article-wash-html-with-w3m): Call w3m-region. - (gnus-article-wash-function): use locate-library to decide which - to use. - -2002-01-25 Simon Josefsson - - * pop3.el (pop3-munge-message-separator): Work if no date. - Trivial patch from Marius Vollmer . - -2002-01-25 Lars Magne Ingebrigtsen - - * gnus-agent.el (gnus-agent-save-alist): Fix. - - * nnagent.el (nnagent-retrieve-headers): Must have cut too much by - mistake. Reinstated lost code. - -2002-01-25 Josh Huber - - * mml2015.el (mml2015-mailcrypt-decrypt): Display a signature if - one exists in the case of an encrypted message with an internal - signature. - -2002-01-25 Lars Magne Ingebrigtsen - - * gnus-agent.el (gnus-agent-save-alist): Optimized. - -2002-01-25 Katsumi Yamaoka - - * dgnushack.el: Commented out the experimental code. - -2002-01-25 Lars Magne Ingebrigtsen - - * gnus-range.el (gnus-inverse-list-range-intersection): Off-by-one - error. - - * gnus.el (gnus-server-to-method): Made into subst. - (gnus-server-method-cache): New variable. - (gnus-server-to-method): Use it. - (gnus-group-method-cache): New variable. - (gnus-find-method-for-group-1): Renamed. - (gnus-find-method-for-group): New function. - (gnus-group-method-cache): Removed. - - * gnus-sum.el (gnus-compute-unseen-list): Use new optimized - function. - - * gnus-range.el (gnus-members-of-range): New function. - (gnus-list-range-intersection): Renamed. - (gnus-inverse-list-range-intersection): New function. - - * gnus-sum.el (gnus-compute-unseen-list): Made into own function. - - * nnagent.el (nnagent-retrieve-headers): New implementation. - - * gnus-agent.el (gnus-agent-get-undownloaded-list): New, faster - implementation. - -2002-01-25 Katsumi Yamaoka - - * lpath.el: Fbind `w3m-charset-to-coding-system'; bind - `w3m-meta-content-type-charset-regexp'. - - * mm-view.el (mm-inline-text-html-render-with-w3m): Decode - charset-encoded html contents. - -2002-01-24 ShengHuo ZHU - - * gnus-agent.el (gnus-agent-request-article): Make sure it is not - an empty file. - - * nnweb.el (url): Ignore errors when request url. - - * nnrss.el: Clean up the comments. - -2002-01-24 Katsumi Yamaoka - - * lpath.el: Fbind `w3m-region'; bind `w3m-mode-map'. - - * mm-decode.el (mm-inline-text-html-renderer): New user option. - (mm-inline-media-tests): Test whether the value of - `mm-inline-text-html-renderer' is a function for text/html. - - * mm-view.el (mm-inline-text-html-render-with-w3): New function - separated from `mm-inline-text'. - (mm-w3m-minor-mode): New variable. - (mm-w3m-setup): New variable. - (mm-setup-w3m): New function. - (mm-inline-text-html-render-with-w3m): New function. - (mm-inline-text): Funcall `mm-inline-text-html-renderer' for - text/html. - -2002-01-23 Paul Jarc - - * lpath.el: fbind make-symbolic-link and unix-sync for nnmaildir. - -2002-01-23 Katsumi Yamaoka - - * gnus-xmas.el (gnus-xmas-redefine): Quote `gnus-completing-read' - and `gnus-xmas-completing-read'. - -2002-01-19 TSUCHIYA Masatoshi - - * nneething.el (nneething-message-id-number): Abolished. - (nneething-encode-file-name): Not encode numerical characters. - (nneething-make-head): `nneething-message-id-number' is not - used to generate message IDs. - -2002-01-23 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-emphasis-alist): Include !? as sentence-ending - characters. - -2002-01-22 Lars Magne Ingebrigtsen - - * gnus-xmas.el (gnus-xmas-completing-read): New function. - (gnus-xmas-redefine): Redefine conditionally. - -2002-01-22 Josh Huber - - * mml.el (mml-parse-1): Fixed usage of recipients in the secure - tag. - -2002-01-22 Josh Huber - - * message.el (message-font-lock-keywords): Added the secure tag. - * mml-sec.el: Added functions to generate/modify/remove the secure - tag while in message mode. - * mml-sec.el (mml-secure-message): New. - * mml-sec.el (mml-unsecure-message): New. - * mml-sec.el (mml-secure-message-sign-smime): New. - * mml-sec.el (mml-secure-message-sign-pgp): New. - * mml-sec.el (mml-secure-message-sign-pgpmime): New. - * mml-sec.el (mml-secure-message-encrypt-smime): New. - * mml-sec.el (mml-secure-message-encrypt-pgp): New. - * mml-sec.el (mml-secure-message-encrypt-pgpmime): New. - * mml.el (mml-parse-1): Added code to recognise the secure tag and - convert it to either a part or multipart depending on if there are - other parts in the message. - * mml.el (mml-mode-map): Changed default sign/encrypt keybindings - to use the secure tag, rather than the part tag. - * mml.el (mml-preview): Added a save-excursion to keep cursor - position after doing an MML preview. - -2002-01-22 Lars Magne Ingebrigtsen - - * nnheader.el (nnheader-parse-overview-file): New function. - (nnheader-write-overview-file): New function. - -2002-01-21 Lars Magne Ingebrigtsen - - * gnus.el (gnus-group-fast-parameter): Check better if expansion - in wanted. - - * nnweb.el (nnweb-type-definition): Clean up. - -2002-01-21 Alastair Burt - Trivial patch. - - * gnus-art.el (gnus-mm-display-part): Make sure that the summary - buffer exists before jumping to it. - -2002-01-21 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-wash-html-with-w3): Made into own - function. - (article-wash-html): Use it. - (gnus-article-wash-function): New variable. - (gnus-article-wash-html-with-w3m): New function. - -2002-01-20 Bj,Av(Brn Torkelsson - - * dgnushack.el (dgnushack-compile): Compile smiley-ems for - XEmacs. - -2002-01-20 John H. Palmieri - - * gnus-fun.el (gnus-convert-image-to-gray-x-face): More standard - command line. - -2002-01-21 Simon Josefsson - - * canlock.el (base64-encode-string): Autoload it from base64. - (canlock-make-cancel-key): Base64 encode unibyte string. - -2002-01-20 Lars Magne Ingebrigtsen - - * nnfolder.el (nnfolder-request-accept-article): Unfold - x-from-line. - (nnfolder-request-replace-article): Ditto. - -2002-01-20 Nevin Kapur - - * gnus-group.el (gnus-group-best-unread-group): Use the right - positioning function. - -2002-01-20 Lars Magne Ingebrigtsen - - * smiley-ems.el (smiley-region): Use new function. - (smiley-update-cache): Use general image functions. - (smiley-region): Use general functions. - - * gnus-util.el (gnus-graphic-display-p): New function. - - * nnmail.el (nnmail-article-group): Allow outputting traces of - non-strings. - - * nndoc.el (nndoc-type-alist): Rules for exim bounces. - (nndoc-exim-bounce-type-p): New function. - - * message.el (message-dont-send): Doc fix. - - * gnus-util.el (gnus-completing-read): Remove - inherit-input-method. - - * gnus-art.el (gnus-treat-smiley): Doc fix. - - * gnus-agent.el (gnus-agent-fetch-headers): Ignore seen and recent - articles. - -2002-01-19 Simon Josefsson - - * imap.el (imap-gssapi-open): Don't wait for logout to complete. - (imap-kerberos4-open): Ditto. - (imap-open): Set port correctly, don't set auth. - -2002-01-20 Lars Magne Ingebrigtsen - - * gnus.el (gnus-version-number): Bump version number. - -2002-01-20 05:33:30 Lars Magne Ingebrigtsen - - * gnus.el: Oort Gnus v0.05 is released. - -2002-01-20 Lars Magne Ingebrigtsen - - * nnkiboze.el (nnkiboze-generate-group): Make sure the directory - exists. - - * gnus-spec.el (gnus-string-width-function): New function. - (gnus-tilde-cut-form): Use it. - (gnus-tilde-max-form): Ditto. - (gnus-use-correct-string-widths): Default to (featurep 'xemacs). - (gnus-substring-function): Use it. - (gnus-tilde-cut-form): Ditto. - (gnus-substring-function): New function. - - * message.el (message-check-news-header-syntax): New message. - - * gnus.el (gnus-slave-no-server): Doc fix. - - * gnus-spec.el (gnus-use-correct-string-widths): Default to t. - -2002-01-15 Katsumi Yamaoka - - * gnus-sum.el (gnus-adjust-marked-articles): Fix the record for - `seen' if it looks like (seen NUM1 . NUM2). It should be - (seen (NUM1 . NUM2)). - -2002-01-20 Lars Magne Ingebrigtsen - - * gnus-topic.el (gnus-topic-catchup-articles): Update article - number in closed topics. - -2002-01-19 Daniel Pittman - - * gnus-sum.el (gnus-summary-first-unseen-or-unread-subject): New - functions. - -2002-01-19 Lars Magne Ingebrigtsen - - * gnus.el (gnus-group-find-parameter): Clean up. - - * gnus-sum.el (gnus-summary-goto-subject): Error on non-numerical - articles. - - * gnus-util.el (gnus-completing-read-with-default): Renamed. - - * nnmail.el (nnmail-article-group): Clean up. - -2002-01-19 Paul Stodghill - - * gnus-agent.el (gnus-category-name): Intern the category name. - -2002-01-19 Lars Magne Ingebrigtsen - - * gnus-topic.el (gnus-topic-move-group): Use gnus-topic-history. - - * gnus-util.el (gnus-completing-read): New function. - -2002-01-19 ShengHuo ZHU - - * gnus-art.el (gnus-add-wash-type): Use add-to-list. - - * smiley-ems.el (smiley-region): Register smiley. - (smiley-toggle-buffer): Rewrite the function. - (smiley-active): Removed. - -2002-01-19 Simon Josefsson - - * gnus-util.el (gnus-parent-id): Optimize null n case. From - Jesper Harder . - -2002-01-18 TSUCHIYA Masatoshi - - * gnus-art.el (gnus-request-article-this-buffer): Call - `nneething-get-file-name' to extract the file name from the - message id. - - * nneething.el (nneething-encode-file-name): New function. - (nneething-decode-file-name): Ditto. - (nneething-get-file-name): Ditto. - (nneething-make-head): Encode the file name and encapsulate it - into the field of the message id. - -2002-01-18 Simon Josefsson - - * nnml.el (nnml-request-update-info): Don't erase flags that isn't - stored in .marks. - - * nnfolder.el (nnfolder-request-update-info): Ditto. - -2002-01-18 ShengHuo ZHU - - * gnus-art.el (gnus-url-parse-query-string): Allow new line in value. - -2002-01-18 Simon Josefsson - - * imap.el (imap-starttls-p): Don't check for binary. - (imap-gssapi-auth-p): Ditto. - (imap-kerberos4-auth-p): Ditto. - (imap-open): Change logic. Iterate through all possible streams, - instead of bailing out after first failure. Move authenticator - decision to `imap-authenticate'. - (imap-authenticate): Change logic, now finds the authenticator to - use, was previously in `imap-open'. - (imap-open): Return nil on failure. - (imap-open): Setup temp buffer correctly. - (imap-open): Return buffer only on success. - (imap-interactive-login, imap-interactive-login): Tell the user - which stream/authenticator is used for the queried - username/password. - (imap-open, imap-authenticate): Set variables. - (imap-gssapi-auth-p, imap-kerberos4-auth-p): Fix typo. - (imap-open): Don't assume how `with-temp-buffer' is implemented. - -2002-01-17 Lars Magne Ingebrigtsen - - * gnus-fun.el (gnus-grab-cam-x-face): New function. - -2002-01-16 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-emphasis-alist): Allow matching "*this*.)". - -2002-01-17 ShengHuo ZHU - - * gnus-agent.el (gnus-agent-toggle-group-plugged): New function. - (gnus-agent-group-mode-map): Bind it to "Jo". - (gnus-agent-group-make-menu-bar): Add it into menu bar. - -2002-01-17 Karl Kleinpaste - - * gnus-xmas.el (gnus-group-toolbar): Add .newsrc save button. - (gnus-summary-mail-toolbar): Add mail article deletion button. - - * smiley.el (smiley-deformed-regexp-alist): Eliminate noseless - false positives for lines of "^^^^". - - * gnus-picon.el (gnus-picon-find-face): faces database is all - lowercase. - -2002-01-17 ShengHuo ZHU - - * gnus-agent.el (gnus-agent-retrieve-headers): Use correct buffer. - (gnus-agent-braid-nov): Switch back to nntp-server-buffer. Remove - duplications. - (gnus-agent-batch): Bind gnus-agent-confirmation-function. - -2002-01-16 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-initial-limit): Inline - gnus-summary-limit-children. - (gnus-summary-initial-limit): Don't limit if - gnus-newsgroup-display is nil. - (gnus-summary-initial-limit): No, don't. - - * gnus-util.el - (gnus-put-text-property-excluding-characters-with-faces): Inline - gnus-put-text-property. - - * gnus-spec.el (gnus-default-format-specs): New variable. - - * gnus-start.el (gnus-read-newsrc-file): Don't clear - gnus-format-specs. - (gnus-read-newsrc-el-file): Default to gnus-default-format-specs. - - * gnus-spec.el (gnus-update-format-specifications): Really check - the Gnus version of the .newsrc.eld file. - (gnus-format-specs): Save the new default summary format. - - * gnus-util.el (gnus-parent-id): Check whether references is empty - before splitting. - - * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Inline some - functions. - (gnus-gather-threads-by-references): Inline - `gnus-split-references'. - - * gnus-spec.el (gnus-summary-line-format-spec): New, optimized - default value of gnus-summary-line-format-spec. - -2002-01-15 ShengHuo ZHU - - * nnslashdot.el (nnslashdot-retrieve-headers-1): A better error - message. - (nnslashdot-request-list): Ditto. - (nnslashdot-sid-strip): Removed. - -2002-01-15 Simon Josefsson - - * nnimap.el (nnimap-close-asynchronous): Enable. - (nnimap-close-group): Expunge. - -2002-01-15 ShengHuo ZHU - - * gnus-util.el (gnus-user-date-format-alist): Typo. - From: Frank Schmitt - -2002-01-15 TSUCHIYA Masatoshi - - * nneething.el (nneething-request-article): Set - `nnmail-file-coding-system' to `binary' locally, in order to read - files without any conversion. - -2002-01-15 ShengHuo ZHU - - * gnus-agent.el (gnus-agent-retrieve-headers): Use - nnheader-file-coding-system and nnmail-active-file-coding-system. - (gnus-agent-regenerate-group): Ditto. - (gnus-agent-regenerate): Ditto. - (gnus-agent-write-active): Ditto. - Suggested by Katsumi Yamaoka - -2002-01-14 ShengHuo ZHU - - * gnus-art.el (gnus-button-alist): Don't highlight - -2002-01-14 ShengHuo ZHU - - * gnus.el: We don't need gnus-article-show-all-headers. - - * gnus-art.el (article-show-all, gnus-article-show-all-header): - Ditto. - - * gnus-sum.el (gnus-summary-select-article): Don't call - show-all-headers, because hidden headers are not hidden text any - more. - -2002-01-13 Simon Josefsson - - * message.el (message-newline-and-reformat): Use `newline' instead - of inserting \n, so that the newline is marked as hard. - -2002-01-13 Jesper Harder - - * gnus-spec.el (gnus-pad-form): Don't evaluate EL multiple times. - -2002-01-12 ShengHuo ZHU - - * imap.el (imap-close): Keep going if quit. - - * gnus-agent.el (gnus-agent-retrieve-headers): Erase - nntp-server-buffer. - -2002-01-12 Lars Magne Ingebrigtsen - - * mm-view.el (mm-display-inline-fontify): Require font-lock to - avoid unbinding shadowed variables. - - * gnus-art.el (gnus-picon-databases): Moved here. - (gnus-picons-installed-p): Moved here. - (gnus-article-reply-with-original): Use `mark'. - - * gnus.el (gnus-picon): Moved here and renamed. - - * gnus-art.el (gnus-treat-from-picon): Only be on if picons are - installed. - (gnus-treat-mail-picon): Ditto. - (gnus-treat-newsgroups-picon): Ditto. - - * gnus-picon.el (gnus-picons-installed-p): New function. - -2002-01-12 ShengHuo ZHU - - * gnus-agent.el (gnus-agent-go-online): Fix doc. - -2002-01-12 Simon Josefsson - - * nnimap.el (nnimap-need-unselect-to-notice-new-mail) - (nnimap-before-find-minmax-bugworkaround): Use it. - (nnimap-find-minmax-uid): Don't reselect current mailbox. - (nnimap-dont-close): New variable. - (nnimap-close-group): Use it. - -2002-01-12 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-reply-with-original): Use - `mark-active'. - - * gnus-msg.el (gnus-summary-reply): Don't bug out on regions. - - * gnus-logic.el (gnus-advanced-score-rule): Thinko fix. - (gnus-score-advanced): Clean up. - (gnus-score-advanced): Accept a multiple of the score. - -2002-01-12 Simon Josefsson - - * flow-fill.el (fill-flowed-display-column) - (fill-flowed-encode-columnq): New variables. Suggested by - Kai.Grossjohann@CS.Uni-Dortmund.DE (Kai Gro,b_(Bjohann). - (fill-flowed-encode, fill-flowed): Use them. - - * message.el (message-send-news, message-send-mail): Use - m-b-s-n-p-e-h-n. - - * mml.el (autoload): Autoload fill-flowed-encode. - (mml-buffer-substring-no-properties-except-hard-newlines): New - function. - (mml-read-part): Use it. - (mml-generate-mime-1): Encode format=flowed if appropriate. - (mml-insert-mime-headers): Insert format=flowed. - - * flow-fill.el (fill-flowed-encode): New function. - (fill-flowed): Bind fill-column to window width. - -2002-01-12 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-buffer-name): Return the dead name if - it exists. - (gnus-summary-setup-buffer): Wake up dead summary buffers. - (gnus-summary-buffer-name): Don't return the dead name after all. - (gnus-summary-setup-buffer): Kill the dead buffer. - - * gnus-art.el (gnus-article-followup-with-original): Store the - value of the mark before deactivating it. - -2002-01-11 ShengHuo ZHU - - * gnus-fun.el (gnus-display-x-face-in-from): Fake it. - From: Karl Kleinpaste - - * gnus-art.el (article-display-x-face): Ditto. - (gnus-article-reply-with-original): Use gnus-region-active-p. - (gnus-article-followup-with-original): Ditto. - - * gnus-sum.el (gnus-summary-read-group-1): Don't select - downloadable article either. - -2002-01-11 ShengHuo ZHU - - * gnus-art.el (article-display-x-face): Insert From:. - - * gnus-sum.el (gnus-summary-move-article): Don't draw the - article. Bind gnus-display-mime-function and - gnus-article-prepare-hook. - - * gnus-agent.el (gnus-agent-retrieve-headers): Load agentview. - (gnus-agent-toggle-plugged): Use gnus-agent-go-online. Move - gnus-agent-possibly-synchronize-flags to the last. - (gnus-agent-go-online): New function. New variable. - -2002-01-11 ShengHuo ZHU - - * gnus-agent.el (gnus-agent-regenerate-group): Add clean option. - (gnus-agent-regenerate): Ditto. - -2002-01-11 ShengHuo ZHU - - * message.el (message-ignored-news-headers) - (message-ignored-mail-headers): Add X-Gnus-Agent-Meta-Information:. - Suggested by ARISAWA Akihiro - - * gnus.el (gnus-gethash-safe): New macro. - - * gnus-agent.el (gnus-agent-regenerate-history): New function. - (gnus-agent-regenerate): Show messages. - -2002-01-11 ShengHuo ZHU - - * gnus-agent.el (gnus-agent-regenerate-group): New function. - (gnus-agent-regenerate): New function. - (gnus-agent-save-alist): Sort. - (gnus-agent-copy-nov-line): Test eobp. - (gnus-agent-retrieve-headers): Erase buffer. - -2002-01-10 ShengHuo ZHU - - * mm-util.el (mm-charset-to-coding-system): Change charset to cs. - From: Torsten Hilbrich - - * gnus.el (gnus-agent-covered-methods): Move here. - (gnus-online): New function. - (gnus-agent-method-p): Move here. - - * nnagent.el (nnagent-retrieve-headers): Check whether arts is - nil. Remove articles-alist. - - * gnus-start.el (gnus-get-unread-articles): Check online. - (gnus-groups-to-gnus-format): Ditto. - (gnus-active-to-gnus-format): Ditto. - - * gnus-agent.el (gnus-agent-get-function): Use it. - (gnus-agent-get-undownloaded-list): Ditto. - (gnus-agent-fetch-session): Only fetch online methods. - - * gnus-srvr.el (gnus-server-make-menu-bar): Add offline. - (gnus-server-mode-map): Ditto. - (gnus-server-offline-face): New face. - (gnus-server-offline-face): New variable. - (gnus-server-font-lock-keywords): Add offline. - (gnus-server-insert-server-line): Ditto. - (gnus-server-offline-server): New function. - - * gnus-int.el (gnus-open-server): Turn to offline. - (gnus-server-unopen-status): New variable. - -2002-01-10 ShengHuo ZHU - - * nnkiboze.el (nnkiboze-request-article): Use - gnus-agent-request-article. - - * nnagent.el (nnagent-retrieve-headers): Don't use nnml - function. Insert undownloaded NOV. - - * gnus-agent.el (gnus-agent-retrieve-headers): New function. - (gnus-agent-request-article): New function. - - * gnus.el (gnus-agent-cache): New variable. - - * gnus-int.el (gnus-retrieve-headers): Use - gnus-agent-retrieve-headers. - (gnus-request-head): Use gnus-agent-request-article. - (gnus-request-body): Ditto. - - * gnus-art.el (gnus-request-article-this-buffer): Use - gnus-agent-request-article. - - * gnus-sum.el (gnus-summary-read-group-1): Don't show the first - article if it is undownloaded. - -2002-01-10 Katsumi Yamaoka - - * gnus-spec.el (gnus-spec-tab): Deal with wide characters. - -2002-01-09 Katsumi Yamaoka - - * canlock.el (canlock-string-as-unibyte): New macro. - (canlock-sha1-with-openssl): Return a unibyte string. - (canlock-make-cancel-key): Treat Message-ID as a unibyte string. - -2002-01-09 ShengHuo ZHU - - * gnus.el (gnus-expand-group-parameters): Match \N or \& only. - -2002-01-08 ShengHuo ZHU - - * mm-encode.el (mm-content-transfer-encoding-defaults): Add - application/x-emacs-lisp. - - * gnus-msg.el (gnus-bug): Use application/emacs-lisp. - - * nntp.el (nntp-request-article): Add group parameter. - (nntp-request-head): Ditto. - (nntp-find-group-and-number): Add parameter group. Figure out - number if the status line doesn't give (e.g. quimby.gnus.org). - -2002-01-08 Simon Josefsson - - * mml.el (mml-generate-mime-1): Set recipient correctly. - -2002-01-08 ShengHuo ZHU - - * message.el (message-read-from-minibuffer): Add parameter - initial-contents. - * gnus-msg.el (gnus-summary-resend-message): Use it. - - * gnus-group.el (gnus-group-read-ephemeral-group): Restore the old - behavior of quit-config. - -2002-01-08 Bj,Ax(Brn Mork (tiny change) - - * message.el (message-make-from): Don't quote fullname. - -2002-01-08 Andre Srinivasan (tiny change) - - * gnus-group.el (gnus-group-suspend): Don't kill message buffers. - -2002-01-07 ShengHuo ZHU - - * gnus-group.el (gnus-group-mark-article-read): Typo. Increase n. - - * gnus-art.el (gnus-header-button-alist): Handle mailto. - - * mml.el (mml-preview): Bind gnus-original-article-buffer because - article-decode-group-name uses it. Bind gnus-article-prepare-hook - because bbdb may use it. - -2002-01-07 TSUCHIYA Masatoshi - - * nneething.el (nneething-request-article): When a non-text file - is converted to an article, its data is encoded in base64. Call - `nneething-make-head' with options to specify MIME types. - (nneething-make-head): Add optional arguments to specify MIME - types. - -2002-01-06 ShengHuo ZHU - - * gnus-fun.el (gnus-display-x-face-in-from): Fake a "From: " - header if there is not. - - * gnus-xmas.el (gnus-xmas-put-image): Insert " " if bobp. - - * gnus-msg.el (gnus-gcc-mark-as-read): New variable. - (gnus-inews-mark-gcc-as-read): Obsolete variable. - (gnus-inews-do-gcc): Use them. - - * gnus-group.el (gnus-group-mark-article-read): Put holes into - gnus-newsgroup-unselected. - -2002-01-06 Simon Josefsson - - * imap.el (imap-ssl-open, imap-ssl-open, imap-parse-fetch): Use - condition-case, not ignore-errors. - -2002-01-06 ShengHuo ZHU - - * gnus-sum.el (gnus-summary-insert-old-articles): Bind - gnus-fetch-old-headers. - - * gnus-art.el (article-display-x-face): Use the current buffer - unless `W f'. Otherwise, X-Face may be shown in the header of a - forwarded part. - (gnus-treatment-function-alist): Treat xface before hiding - headers. - -2002-01-06 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-read-ephemeral-group): Fix - parameters. - -2002-01-06 ShengHuo ZHU - - * mm-util.el (mm-multibyte-p): Define conditionally when load. - (mm-guess-charset): New function. - (mm-charset-after): Use it. - (mm-detect-coding-region): New function. - (mm-detect-mime-charset-region): New function. - - * gnus-sum.el (gnus-summary-show-article): Use - mm-detect-coding-region. - -2002-01-06 Lars Magne Ingebrigtsen - - * message.el (message-make-fqdn): Be less violent. - - * gnus.el (gnus-logo-color-style): Compute custom form - automatically. - - * gnus-sum.el (gnus-summary-enter-digest-group): Feed the adaptive - score file of the parent to the document group. - - * gnus-group.el (gnus-group-read-ephemeral-group): Add an optional - parameters parameter. - - * gnus-score.el (gnus-score-load-file): Clean up. - -2002-01-06 ShengHuo ZHU - - * gnus-sum.el (gnus-thread-sort-by-most-recent-number): Fix typo. - From: Damien Wyart - - * gnus-util.el (gnus-local-map-property): In Emacs 21, use keymap. - -2002-01-05 ShengHuo ZHU - - * gnus-sum.el (gnus-select-group-hook): Typo. - - * rfc2047.el (rfc2047-decode-string): Return immediately if there - is no quoted-printable-encoded STRING. - From: Jesper Harder - - (rfc2047-decode-string): Decode it. - -2002-01-05 Lars Magne Ingebrigtsen - - * gnus.el (gnus-logo-color-alist): Added more colors from Luis. - -2002-01-05 Keiichi Suzuki - Trivial patch. - - * nntp.el (nntp-possibly-change-group): Erase contents of nntp - buffer to get rid of junk line. - -2002-01-05 Simon Josefsson - - * message.el (message-mode-map): Bind message-goto-from to C-c C-f - C-o. - (message-mode-map): Bind message-insert-or-toggle-importance to - C-c C-u. - (message-mode-map): Bind message-disposition-notification-to to - C-c M-n. - (message-mode-menu): Add m-d-n-t. - (message-mode-field-menu): Add m-goto-from. - (message-mode): Doc fix. - (message-goto-from): New function. - (message-insert-disposition-notification-to): New function. - (message-tool-bar-map): Add receipt button. - -2002-01-05 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-thread-latest-date): New function. - (gnus-thread-sort-by-most-recent-number): Renamed. - (gnus-thread-sort-functions): Doc fix. - (gnus-select-group-hook): Don't use setq on a hook. - (gnus-thread-latest-date): Use date, not number - - * gnus-agent.el (gnus-agent-expire-days): Doc fix. - (gnus-agent-expire): Allow regexp of expire-days. - - * gnus-art.el (gnus-article-reply-with-original): Deactivate - region. - (gnus-article-followup-with-original): Ditto. - - * gnus-sum.el (gnus-thread-highest-number): Doc fix. - - * gnus-art.el (gnus-mime-display-alternative): Use - gnus-local-map-property. - (gnus-mime-display-alternative): Ditto. - (gnus-insert-mime-security-button): Ditto. - (gnus-insert-next-page-button): Ditto. - (gnus-button-prev-page): Take optional args. - (gnus-insert-prev-page-button): widget-convert. - - * gnus-util.el (gnus-local-map-property): New function. - - * gnus-art.el (gnus-prev-page-map): Use parent map. - (gnus-next-page-map): Ditto. - - * gnus-spec.el (gnus-parse-format): Clean up. - (gnus-parse-format): Do complex formatting for %=. - - * gnus-fun.el (gnus-display-x-face-in-from): Add the string - "X-Face: " to the data in the built-in scenario. - - * gnus-spec.el (gnus-parse-simple-format): Use gnus-pad-form. - (gnus-correct-pad-form): Renamed. - (gnus-tilde-max-form): Clean up. - (gnus-pad-form): Use gnus-use-correct-string-widths. - - * gnus-fun.el (gnus-display-x-face-in-from): Use native xface - support if that is available. - - * gnus-sum.el (gnus-thread-highest-number): New function. - (gnus-thread-sort-by-most-recent-thread): New function. - (gnus-thread-sort-functions): Doc fix. - -2002-01-04 ShengHuo ZHU - - * gnus-sum.el (gnus-summary-select-article): Disable multibyte in - all cases. - (gnus-summary-mode): Enable it in all cases. - (gnus-summary-display-article): Ditto. - (gnus-summary-edit-article): Ditto. - - * gnus-ems.el (gnus-put-image): Really return glyph. - - * gnus-art.el (gnus-article-x-face-command): Fix :type. - (gnus-treat-smiley): Don't take "P" in the interactive form. - -2002-01-04 Lars Magne Ingebrigtsen - - * compface.el (uncompface): XEmacs and Emacs have differing - capabilities. - - * gnus-fun.el (gnus-display-x-face-in-from): Use face. - - * gnus-ems.el (gnus-article-xface-ring-internal): Removed. - (gnus-article-xface-ring-size): Removed. - (gnus-article-display-xface): Removed. - (gnus-remove-image): Cleaned up. - - * gnus-xmas.el (gnus-xmas-create-image): Convert pbm to xbm. - (gnus-xmas-create-image): Take pbm files. - (gnus-x-face): Removed. - (gnus-xmas-article-display-xface): Removed. - - * gnus-fun.el (gnus-display-x-face-in-from): Bind - default-enable-multibyte-characters. - - * compface.el (uncompface): Doc fix. - - * gnus-art.el (gnus-article-x-face-command): Use - gnus-display-x-face-in-from. - - * gnus-xmas.el (gnus-xmas-put-image): Return the image. - - * gnus-ems.el (gnus-put-image): Return the image. - - * gnus-fun.el (gnus-display-x-face-in-from): New function. - (gnus-x-face): Moved here. - -2002-01-04 ShengHuo ZHU - - * gnus-xmas.el (gnus-xmas-put-image): Don't insert SPC or make - invisible if string is nil. - (gnus-xmas-article-display-xface): Use it. - - * gnus-ems.el (gnus-put-image): Explicitly use SPC, and add text - property when string is nil. - (gnus-article-display-xface): Use it. - -2002-01-04 Lars Magne Ingebrigtsen - - * gnus-art.el (article-display-x-face): Check whether valid grey - face was returned. - (article-display-x-face): Place image in the right spot. - - * gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Get rid of - stderr. - (gnus-convert-gray-x-face-to-xpm): Check whether output is valid. - -2002-01-03 Lars Magne Ingebrigtsen - - * gnus-xmas.el (gnus-xmas-create-image): Take optional - parameters. - (gnus-xmas-put-image): Allow non-strings to be passed. - - * gnus-art.el (article-display-x-face): Use optional parameters. - - * gnus-ems.el (gnus-create-image): Take optional parameters. - - * gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Use uncompface. - - * compface.el (compface-xbm-p): Removed. - - * gnus-ems.el (gnus-article-compface-xbm): Removed. - (gnus-article-display-xface): Use compface. - - * compface.el: New file. - - * gnus-fun.el (gnus-convert-pbm-to-x-face-command): Remove quotes. - (gnus-convert-image-to-x-face-command): Ditto. - (gnus-random-x-face): Quote argument. - (gnus-x-face-from-file): Ditto. - -2002-01-03 Paul Jarc - - * nnmaildir.el (nnmaildir-request-expire-articles): evaluate - the expire-group parameter once per article rather than once - per group; bind `nnmaildir-article-file-name' and `article' - for convenience. Leave article alone when expire-group - specifies the current group. - (nnmaildir--update-nov): be more concurrency-friendly with - temp file names. - -2002-01-03 Lars Magne Ingebrigtsen - - * gnus-start.el (gnus-read-init-file): Cleaned up. - -2002-01-03 Dave Love - - * gnus-start.el (gnus-startup-file-coding-system): Removed. - (gnus-read-init-file): Don't use it. - -2002-01-03 Lars Magne Ingebrigtsen - - * gnus-agent.el (gnus-agent-fetch-session): Run hook. - -2002-01-03 Dave Love - - * gnus-start.el (gnus-read-init-file): Don't force coding system - for ~/.gnus. - -2002-01-03 ShengHuo ZHU - - * nntp.el (nntp-send-buffer): Use mm-with-unibyte-current-buffer. - * nnspool.el (nnspool-request-post): Ditto. - - * mm-util.el (mm-use-find-coding-systems-region): New variable. - (mm-find-mime-charset-region): Use it. - -2002-01-03 Per Abrahamsen - - * gnus.el (gnus-summary-line-format): Added :link. - * gnus-topic.el (gnus-topic-line-format): Ditto. - * gnus-sum.el (gnus-summary-dummy-line-format): Ditto. - * gnus-srvr.el (gnus-server-line-format): Ditto. - * gnus-group.el (gnus-group-line-format): Ditto. - - * gnus-sum.el (gnus-summary-make-menu-bar): Use correct syntax for - :keys, it works on both Emacsen. - -2002-01-03 ShengHuo ZHU - - * mm-util.el (mm-charset-to-coding-system): Don't setq charset. - -2002-01-03 Lars Magne Ingebrigtsen - - * gnus-msg.el (gnus-summary-send-map): Fix binding for very-wide. - -2002-01-03 Reiner Steib - - * gnus-sum.el (gnus-summary-make-menu-bar): Menu bar entries for - very wide reply. - -2002-01-03 Lars Magne Ingebrigtsen - - * gnus-picon.el (gnus-picon-transform-address): Cache stuff. - (gnus-picon-cache): New variable. - (gnus-picon-transform-newsgroups): Cache stuff. - - * gnus-art.el (gnus-article-reply-with-original): New command. - (gnus-article-followup-with-original): New command. - - * gnus-msg.el (gnus-copy-article-buffer): Take optional BEG and - END parameters. - (gnus-summary-followup): Take a list of list of articles. - (gnus-inews-yank-articles): Allow lists of article/regions. - - * gnus-art.el (gnus-article-read-summary-keys): `R' and `F' are no - longer the usual commands. - - * gnus-fun.el (gnus-convert-image-to-gray-x-face): Use pnmnoraw. - (gnus-convert-gray-x-face-to-xpm): Don't use six parameters to - shell-command-on-region. - -2002-01-02 ShengHuo ZHU - - * gnus-picon.el (gnus-picon-transform-newsgroups): Fix for the case - "Newsgroups: rec.music.beatles.moderated, rec.music.beatles". - -2002-01-03 Steve Youngs - - * gnus-sum.el (gnus-summary-make-menu-bar): XEmacs doesn't - understand ':keys', wrap it in an featurep 'xemacs. - -2002-01-02 ShengHuo ZHU - - * gnus-ems.el (gnus-article-display-xface): Show xface in the - order of headers (Actually, it is called in a reversed order). Add - 'gnus-image-text-deletable property. - (gnus-remove-image): Remove text with such a property. - - * gnus-xmas.el (gnus-xmas-article-display-xface): Don't use - gnus-put-image. - - * gnus-art.el (gnus-article-treat-fold-newsgroups): Replace ", *" - with ", " - -2002-01-02 Lars Magne Ingebrigtsen - - * gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Renamed. - - * gnus-art.el (gnus-ignored-headers): Hide all X-Faces. - (article-display-x-face): Display grey X-Faces. - - * gnus-fun.el (gnus-convert-gray-x-face-region): New function. - (gnus-convert-gray-x-face-to-ppm): Ditto. - (gnus-convert-image-to-gray-x-face): Ditto. - - * gnus-sum.el (gnus-summary-make-menu-bar): Add a :keys to - gnus-summary-show-raw-article. - -2002-01-02 ShengHuo ZHU - - Display picons in XEmacs without showing text. - - * gnus-xmas.el (gnus-xmas-create-image): Don't use - mm-create-image-xemacs to create xbm glyph, because it deletes - temporary files. - (gnus-xmas-put-image): Use end-glyph. Make text invisible. - (gnus-xmas-remove-image): Make text visible, remove glyph. - - * gnus-picon.el (gnus-picon-transform-newsgroups) - (gnus-picon-transform-address): Insert spec backward, due to the - incompatibility of gnus-xmas-put-image. - -2002-01-02 Pavel Jan,Am(Bk - - * gnus-fun.el (gnus-convert-pbm-to-x-face-command): Doc fix. - -2002-01-02 Lars Magne Ingebrigtsen - - * gnus.el: Doc fix. - - * gnus-art.el: Doc fix. - - * gnus-agent.el: Doc fix. - -2002-01-01 ShengHuo ZHU - - * gnus-diary.el, gnus-delay.el: Fix copyright lines. - -2002-01-01 Paul Jarc - - * nnmaildir.el (nnmaildir--update-nov): automatically parse - NOV data out of the message again if nnmail-extra-headers has - changed. - -2002-01-02 Lars Magne Ingebrigtsen - - * gnus-fun.el: New file. - (gnus-convert-image-to-x-face-command): New variable. - (gnus-insert-x-face): New function. - (gnus-random-x-face): Renamed. - (gnus-x-face-from-file): Renamed. - - * gnus-art.el (gnus-body-boundary-delimiter): Changed default to - "_". - (gnus-body-boundary-delimiter): Typo fix. - -2002-01-02 Simon Josefsson - - * gnus-art.el (gnus-article-treat-body-boundary): Handle nil. - (gnus-body-boundary-delimiter): Fix type. - -2002-01-01 Simon Josefsson - - * gnus-art.el (gnus-treat-buttonize, gnus-treat-buttonize-head) - (gnus-treat-emphasize, gnus-treat-strip-cr) - (gnus-treat-leading-whitespace, gnus-treat-hide-headers) - (gnus-treat-hide-boring-headers, gnus-treat-hide-signature) - (gnus-treat-fill-article, gnus-treat-hide-citation) - (gnus-treat-hide-citation-maybe) - (gnus-treat-strip-list-identifiers, gnus-treat-strip-pgp) - (gnus-treat-strip-pem, gnus-treat-strip-banner) - (gnus-treat-highlight-headers, gnus-treat-highlight-citation) - (gnus-treat-date-ut, gnus-treat-date-local) - (gnus-treat-date-english, gnus-treat-date-lapsed) - (gnus-treat-date-original, gnus-treat-date-iso8601) - (gnus-treat-date-user-defined, gnus-treat-strip-headers-in-body) - (gnus-treat-strip-trailing-blank-lines) - (gnus-treat-strip-leading-blank-lines) - (gnus-treat-strip-multiple-blank-lines) - (gnus-treat-unfold-headers, gnus-treat-fold-headers) - (gnus-treat-fold-newsgroups, gnus-treat-overstrike) - (gnus-treat-display-xface, gnus-treat-display-smileys) - (gnus-treat-from-picon, gnus-treat-mail-picon) - (gnus-treat-newsgroups-picon, gnus-treat-body-boundary) - (gnus-treat-capitalize-sentences, gnus-treat-fill-long-lines) - (gnus-treat-play-sounds, gnus-treat-translate) - (gnus-treat-x-pgp-sig): Doc fix, add link to manual. - - * gnus-art.el (gnus-body-boundary-delimiter): New variable. - (gnus-article-treat-body-boundary): Use it. - - * message.el (message-mode): Fix doc. - (message-mode-menu): Fix names. - -2002-01-01 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-first-subject): Really go to unseen - articles. - - * gnus-picon.el (gnus-picon-find-face): Search MISC for all types. - (gnus-picon-transform-address): Search for unknown faces as well. - (gnus-picon-find-face): Don't search "news" for MISC. - (gnus-picon-user-directories): Changed default back to exclude - "unknown". - - * gnus-sum.el (gnus-summary-hide-all-threads): Reversed logic. - - * gnus-picon.el (gnus-picon-find-face): Search through all - databases. - (gnus-picon-find-face): New implementation. - - * gnus-topic.el (gnus-topic-goto-previous-topic): New command and - keystroke. - (gnus-topic-goto-next-topic): Ditto. - - * gnus.el (gnus-summary-line-format): Changed default. - - * nnmail.el (nnmail-extra-headers): Change default. - - * gnus-sum.el (gnus-extra-headers): Change default. - - * message.el (message-news-other-window): Changed "news" to - "posting". - (message-news-other-frame): Ditto. - (message-do-send-housekeeping): Ditto. - - * gnus-sum.el (gnus-summary-maybe-hide-threads): Use predicate - function. - (gnus-article-unread-p): New function. - (gnus-article-unseen-p): New function. - (gnus-dead-summary-mode-map): Typo. - - * gnus-util.el (gnus-make-predicate): New function. - (gnus-make-predicate-1): New function. - - * gnus-sum.el: New function. - (gnus-map-articles): New function. - - * gnus-art.el (gnus-treat-fold-headers): New variable. - (gnus-article-treat-fold-headers): New command and keystroke. - - * gnus-sum.el (gnus-dead-summary-mode-map): Clean up. - (gnus-dead-summary-mode-map): Bind q to bury-buffer. - -2002-01-01 ShengHuo ZHU - - * message.el (message-fcc-externalize-attachments): New variable. - (message-do-fcc): Use it. - - * gnus-msg.el (gnus-gcc-externalize-attachments): New variable. - (gnus-inews-do-gcc): Use it. - - * mml.el (mml-tweak-sexp-alist): New variable. - (mml-externalize-attachments): New variable. - (mml-tweak-part): Use mml-tweak-sexp-alist. - (mml-tweak-externalize-attachments): New function. - -2002-01-01 Steve Youngs - - * gnus-xmas.el (gnus-xmas-article-display-xface): Uncomment - 'set-glyph-face' so x-face back/foreground can be set. - -2001-12-31 ShengHuo ZHU - - * message.el (message-fix-before-sending): Fix a typo. - -2002-01-01 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-treat-smiley): Renamed command. - (gnus-article-remove-images): New command and keystroke. - - * gnus-sum.el (gnus-summary-toggle-smiley): Removed. - - * smiley-ems.el (gnus-smiley-display): Removed. - - * gnus.el (gnus-version-number): Update version. - - * message.el (message-text-with-property): Renamed and moved - here. - (message-fix-before-sending): Highlight invisible text and place - point there. - -2002-01-01 02:32:53 Lars Magne Ingebrigtsen - - * gnus.el: Oort Gnus v0.04 is released. - -2002-01-01 Lars Magne Ingebrigtsen - - * gnus-delay.el (gnus-delay-send-queue): Renamed. - - * gnus-art.el (gnus-ignored-headers): More headers, - - * ietf-drums.el (ietf-drums-parse-addresses): Use `error' instead - of `scan-error', since XEmacs doesn't seem to support that. - -2001-12-31 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-best-unread-article): Take a prefix - arg. - (gnus-summary-best-unread-subject): Ditto. - (gnus-summary-best-unread-subject): No, don't. - (gnus-summary-better-unread-subject): New command. - - * gnus-xmas.el (gnus-xmas-put-image): Insert the string itself. - - * lpath.el ((featurep 'xemacs)): fbind url function. - - * gnus-xmas.el (gnus-xmas-article-display-xface): Use data, not - buffer. - (gnus-xmas-remove-image): Implementation that does something. - (gnus-xmas-article-display-xface): Mark images properly. - - * gnus-art.el (gnus-mime-print-part): Use mm-temp-directory. - -2001-12-31 Florian Weimer - - * gnus.el (gnus): Warn if trying to run Gnus un-byte-compiled. - -2001-12-31 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-line-format): Added %O to the default - value. - - * gnus-util.el (gnus-text-with-property): The smallest point is - point-min. - - * smiley-ems.el (smiley-region): Return images. - (gnus-smiley-display): Allow toggling. - (smiley-region): Use text properties, not overlays. - - * gnus-xmas.el (gnus-xmas-remove-image): New function, not - implemented yet. - - * smiley-ems.el (smiley-update-cache): Check for valid types. - - * gnus-art.el (gnus-with-article-buffer): New macro. - - * gnus-picon.el (gnus-picon-transform-newsgroups): Keep the - strings as well as the glyphs. - (gnus-picon-transform-address): Ditto. - (gnus-picon-insert-glyph): Ditto. - (gnus-picon-transform-newsgroups): Toggle. - (gnus-picon-transform-address): Toggle. - - * gnus-ems.el (gnus-remove-image): New function. - (gnus-put-image): Take an optional string. - - * gnus-util.el (gnus-text-with-property): New function. - - * gnus-art.el (gnus-delete-images): New function. - - * gnus-ems.el (gnus-article-display-xface): Mark and store image. - - * gnus-art.el (gnus-article-wash-status-entry): Renamed. - (gnus-article-wash-status): Use it. - (gnus-signature-toggle): Clean up. - (gnus-add-wash-status): New function. - (gnus-delete-wash-status): New function. - (gnus-article-hide-text-type): Use them throughout. - (gnus-add-image): New function. - - * gnus-ems.el (gnus-article-display-xface): Use new interface. - - * gnus-xmas.el (gnus-xmas-article-display-xface): Use new - interface. - - * gnus-art.el (article-display-x-face): Cleaned up. - - * rfc2047.el (rfc2047-field-value): New function. - - * mail-parse.el (mail-header-field-value): New alias. - - * gnus-art.el (gnus-mime-print-part): Fix typos. - - * smiley-ems.el (gnus-smiley-file-types): New variable. - (smiley-update-cache): Use it. - (smiley-regexp-alist): Suffix-less smiley names. - (smiley-regexp-alist): Added more smileys. - - * gnus-sum.el (gnus-print-buffer): Made into own function. - (gnus-summary-print-article): Use it. - - * mailcap.el (mailcap-mime-info): Actually return the bit that we - looked for when REQUEST is a string. - - * gnus-art.el (gnus-mime-button-commands): Add printing - keystroke. - (gnus-mime-copy-part): Doc fix. - (gnus-mime-print-part): New command. - -2001-12-31 Simon Josefsson - - * imap.el (imap-parse-fetch): Notice empty flags responses. From - Nic Ferrier . - -2001-12-30 ShengHuo ZHU - - * gnus-picon.el (gnus-treat-from-picon): Autoload. - (picon): Fix doc. - - * gnus-win.el (gnus-window-to-buffer): gnus-picon-buffer-name no - longer exists. Remove those codes. - * gnus.el (gnus-use-picons): Ditto. - -2001-12-30 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-treat-fold-newsgroups): Don't - infloop. - - * gnus-sum.el (t): New `W D' map. - - * gnus-art.el (gnus-treat-fold-newsgroups): New variable. - (gnus-article-treat-body-boundary): Clean up. - (gnus-body-boundary-face): Removed. - (gnus-article-goto-header): Moved here. - (gnus-article-goto-header): Allow better regexps. - (gnus-article-treat-fold-newsgroups): New command. - - * gnus-sum.el (gnus-summary-move-article): We have to select an - article to give `gnus-read-move-group-name' an opportunity to - suggest an appropriate default. - - * rfc2047.el (rfc2047-fold-line): New function. - (rfc2047-unfold-line): Ditto. - (rfc2047-fold-region): Don't fold just after the header name. - - * mail-parse.el (mail-header-fold-line): New alias. - (mail-header-unfold-line): Ditto. - - * gnus-art.el (gnus-body-boundary-face): Renamed. - (gnus-article-treat-body-boundary): Use it. - (gnus-article-treat-body-boundary): Use an invisible header and a - line of underline characters. - -2001-12-30 ShengHuo ZHU - - * ietf-drums.el (ietf-drums-parse-addresses): Recover from errors. - - * gnus-picon.el (gnus-picon-transform-address): Skip bad addresses. - (gnus-picon-split-address): New function. - (gnus-picon-find-face): Use it. - (gnus-picon-transform-address): Use it. Set first to t for each - address. - - * gnus-art.el (gnus-with-article-headers): Move to here. Define - the macro then use it. - (gnus-treatment-function-alist): Treat picons earlier. - -2001-12-30 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-body-separator-face): New variable. - (gnus-article-treat-body-boundary): Use a blank, colored line. - - * gnus-picon.el (gnus-picon-find-face): Look into misc/MISC as - well. - - * gnus-art.el (gnus-treat-body-boundary): New variable. - (gnus-article-treat-unfold-headers): Use helper macro. - (gnus-article-treat-body-boundary): New command. - - * gnus.el (gnus-logo-color-style): Change the default color. - (gnus-splash-face): Gray, gray. - - * gnus-xmas.el (gnus-xmas-group-startup-message): Use general - colors. - - * gnus.el (gnus-logo-color-alist): Moved here and renamed. - (gnus-logo-color-style): Ditto. - (gnus-logo-colors): Ditto. - - * gnus-picon.el (gnus-picon-create-glyph): Cache glyphs. - - * gnus-art.el (gnus-treat-newsgroups-picon): New variable. - - * gnus-picon.el (gnus-treat-newsgroups-picon): New function. - (gnus-picon-transform-newsgroups): New function. - - * ietf-drums.el (ietf-drums-parse-addresses): Accept a nil - string. - - * gnus-picon.el (gnus-treat-mail-picon): Renamed. - - * gnus-art.el (gnus-treat-cc-picon): New variable. - (gnus-treat-mail-picon): Renamed. - - * gnus-picon.el: New implementation. - (gnus-picon-find-face): Renamed. - (gnus-treat-from-picon): Use it. - (gnus-picon-transform-address): Renamed. - (gnus-treat-from-picon): Use it. - (gnus-picon-create-glyph): Renamed. - (gnus-picon-transform-address): Use it. - (gnus-treat-cc-picon): New command. - - * mm-decode.el (mm-create-image-xemacs): Separated out into - function. - (mm-get-image): Use it. - - * gnus-art.el (gnus-treat-display-picons): Simplify. - (gnus-treat-from-picon): Renamed. - - * gnus-ems.el (gnus-create-image): New function. - (gnus-put-image): New function. - - * gnus-art.el (gnus-article-treat-unfold-headers): Doc fix. - (gnus-with-article-headers): New macro. - (gnus-article-goto-header): New function. - - * gnus-xmas.el (gnus-image-type-available-p): New function. - - * gnus-ems.el (gnus-image-type-available-p): New function. - -2001-12-30 ShengHuo ZHU - - * nnrss.el (nnrss-check-group): Find the correct tag, because - xml.el is changed. - -2001-12-30 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-treat-unfold-headers): Only fold when - lines are shorter than the window width. - (gnus-ignored-headers): More headers. - -2001-12-29 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-treat-unfold-lines): New variable. - (gnus-treat-unfold-headers): Renamed. - (gnus-article-treat-unfold-headers): New command and keystroke. - - * rfc2047.el (rfc2047-encode-message-header): Clean up. - - * gnus-int.el (gnus-open-server): Mark quit-ed server as denied. - -2001-12-29 ShengHuo ZHU - - * sha1-el.el (sha1-use-external): New variable. - (sha1-region): Use it. - (sha1-string): Ditto. - - * dgnushack.el (dgnushack-compile): Compile gnus-picon for Emacs. - * gnus-picon.el: Less warnings when compile. - -2001-12-29 Lars Magne Ingebrigtsen - - * gnus-picon.el (gnus-picons-news-directories): Removed obsolete - alias. - (gnus-picons-database): Default to list. - (gnus-picons-lookup-internal): Use it. - - * nnmail.el (nnmail-article-group): Default nnmail-split-methods - to "bogus". - - * gnus-win.el (gnus-configure-windows-hook): New hook. - -2001-12-29 Sascha L,A|(Bdecke - - * gnus-win.el (gnus-configure-windows): Minimize tree buffer. - -2001-12-29 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-update-marks): Don't uncompress the seen - lists. - (gnus-select-newsgroup): Don't append; push. - (gnus-adjust-marked-articles): Remove obsolete ranges from - `seen'. - (gnus-update-marks): Clean up. - (gnus-select-newsgroup): Don't stomp gnus-newsgroup-seen. - -2001-12-29 Frank Schmitt - - * gnus-sum.el (gnus-summary-limit-to-age): Allow negative days. - -2001-12-29 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-auto-select-subject): New variable. - (gnus-summary-best-unread-subject): New function. - (gnus-summary-best-unread-article): Use it. - (gnus-summary-first-unseen-subject): New function and command. - - * gnus-art.el (gnus-treatment-function-alist): Emphasize after - other treatments. - - * gnus-util.el (gnus-put-overlay-excluding-newlines): New - function. - - * gnus-art.el (gnus-article-show-hidden-text): Remove the type - from the list of hidden types. - - * mm-view.el (mm-inline-text): Ditto. - (mm-inline-text): Ditto. - (mm-w3-prepare-buffer): Ditto. - - * gnus-art.el (article-wash-html): Inhibit more remote fetching. - -2001-12-29 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-ignored-headers): Added more headers. - -2001-12-29 Jesper Harder - - * gnus-srvr.el (gnus-browse-foreign-server): Compute the prefix - once. - -2001-12-29 Lars Magne Ingebrigtsen - - * gnus-srvr.el (gnus-server-browse-in-group-buffer): Doc fix. - -2001-12-28 Simon Josefsson - - * gnus-srvr.el (gnus-browse-foreign-server): Fix typo. From - Jesper Harder . - -2001-12-27 Simon Josefsson - - * gnus-sum.el (gnus-select-newsgroup): Make - `gnus-newsgroup-unseen' sorted. Make `gnus-newsgroup-unseen' - contain all articles (instead of none) when no seen marks have - been set for the group. - (gnus-update-marks): Use `gnus-range-add' on a uncompressed list - instead, it seems to result in shorter ranges. - -2001-12-26 11:00:00 Jesper Harder - - * mm-util.el (mm-iso-8859-x-to-15-region): Use - insert-before-markers. - -2001-12-26 Paul Jarc - - * nnmaildir.el (nnmaildir-save-mail): create the destination - groups if they do not exist. - -2001-12-26 Katsumi Yamaoka - - * canlock.el (canlock-sha1-with-openssl): Remove unused variable. - -2001-12-22 22:00:00 ShengHuo ZHU - - * gnus-group.el (gnus-group-read-ephemeral-group): Call - gnus-group-real-name. - - * gnus-sum.el (gnus-decode-encoded-word-methods): Backslash paren. - (gnus-newsgroup-variables): Ditto. - - * gnus.el (gnus-group-prefixed-name): If group name is prefixed, - return it. - -2001-12-21 Paul Jarc - - * gnus.el (gnus-valid-select-methods): Include nnmaildir. - * nnmaildir.el (top-level): Add commentary. - (nnmaildir-version): Indicate that nnmaildir is now a standard - part of Gnus, not separately released. - -2001-12-21 08:00:00 Pavel Jan,Am(Bk - - * gnus-art.el, gnus-picon.el, gnus-sieve.el, gnus-sum.el: - * gnus-xmas.el, imap.el, mailcap.el, mm-util.el, nnfolder.el: - * nnheader.el, nnmail.el: Nil/NIL vs. nil. - -2001-12-20 15:00:00 ShengHuo ZHU - - * nnmaildir.el: Copyright changes. Require cl only at compile time. - -2001-12-20 Simon Josefsson - - * nnimap.el (top-level): Don't require cl. Suggested by ShengHuo - ZHU . - (nnimap-close-group): Don't quote KEYLIST items. Suggested by - Brian P Templeton . - -2001-12-19 17:00:00 Paul Jarc - - * nnmaildir.el: New file. - -2001-12-19 16:00:00 ShengHuo ZHU - - * nndoc.el (nndoc-type-alist): Move forward to the end. - -2001-12-19 Katsumi Yamaoka - - * gnus.el (gnus-find-subscribed-addresses): Replace `mapc' with - `dolist'. - -2001-12-19 01:00:00 ShengHuo ZHU - - * gnus-win.el (gnus-frames-on-display-list): New function. - (gnus-get-buffer-window): Use it. - -2001-12-19 00:00:00 ShengHuo ZHU - - * nnwarchive.el (nnwarchive-mail-archive-xover): Fix the regexp. - -2001-12-18 11:00:00 ShengHuo ZHU - - * gnus-win.el (gnus-get-buffer-window): Use gnus-delete-if. - -2001-12-18 11:00:00 Harald Meland - - * gnus-win.el (gnus-get-buffer-window): New function. - (gnus-all-windows-visible-p): Use it. - - * gnus-util.el (gnus-horizontal-recenter) - (gnus-horizontal-recenter, gnus-horizontal-recenter) - (gnus-horizontal-recenter, gnus-set-window-start): Use it. - - * gnus-score.el (gnus-score-insert-help): Use it. - - * gnus-salt.el (gnus-tree-recenter, gnus-generate-tree) - (gnus-generate-tree, gnus-highlight-selected-tree) - (gnus-highlight-selected-tree, gnus-tree-highlight-article): Use - it. - - * gnus-art.el (gnus-article-set-window-start) - (gnus-mm-display-part, gnus-request-article-this-buffer) - (gnus-button-next-page, gnus-button-prev-page) - (gnus-article-button-next-page, gnus-article-button-prev-page): - Use it. - -2001-12-18 Josh Huber - - * ChangeLog, ChangeLog.1, nnwfm.el, smiley.el: - * gnus-cite.el, gnus-delay.el, gnus-spec.el, message.el: - * mml1991.el, nnultimate.el: Removed buffer-file-coding-system tag. - -2001-12-18 01:00:00 ShengHuo ZHU - - * ChangeLog, ChangeLog.1, nnwfm.el, gnus-smiley.el: - * gnus-cite.el, gnus-delay.el, gnus-spec.el, message.el: - * mml1991.el, nnultimate.el: Add `coding'. - -2001-12-17 Josh Huber - - * ChangeLog: changed coding to buffer-file-coding-system - * ChangeLog.1: same - * nnwfm.el: same - * gnus-smiley.el: same - * gnus-cite.el: moved -*- magic cookie -*- to Local Variables - * gnus-delay.el: same - * gnus-spec.el: same - * message.el: same - * mml1991.el: same - * nnultimate.el: same - -2001-12-16 Simon Josefsson - Inspired by code by Dirk Meyer . - - * gnus-sum.el (gnus-summary-muttprint-program): New variable. - (gnus-summary-save-map): Add muttprint. - (gnus-summary-make-menu-bar): Ditto. - (gnus-summary-muttprint): New function. - - * gnus-art.el (gnus-summary-pipe-to-muttprint): New function. - -2001-12-14 11:00:00 ShengHuo ZHU - - * uudecode.el (uudecode-decode-region-internal): Speedup by using - temporary list instead of buffer. - - * mm-url.el (executable-find): autoload. - -2001-12-12 Pavel Jan,Am(Bk - - * gnus-mlspl.el (gnus-group-split-fancy): Doc fix (add reference - to variable, follow doc-string conventions). - -2001-12-13 Josh Huber - - * gnus-cus.el (gnus-extra-topic-parameters): added topic parameter - subscribe-level - * gnus-topic.el (gnus-subscribe-topics): use it. - -2001-12-13 22:00:00 Sean Neakums (tiny change) - - * gnus-msg.el (gnus-summary-mail-forward): Forward all marked - messages. - - * gnus-uu.el (gnus-uu-grab-articles): Set gnus-current-article to - nil after shooting down the gnus-original-article-buffer. - -2001-12-13 20:00:00 ShengHuo ZHU - - * uudecode.el (uudecode-use-external): New variable. - (uudecode-decode-region): Automatically detect external program. - - * binhex.el (binhex-use-external): New variable. - (binhex-decode-region-internal): New function. - (binhex-decode-region): Automatically detect external program. - - * mm-uu.el (mm-uu-decode-function,mm-uu-binhex-decode-function): - Use them. - -2001-12-12 Simon Josefsson - - * nnvirtual.el (nnvirtual-always-rescan) - (nnvirtual-component-regexp): Fix doc. - - * nnoo.el (defvoo): Add doc to defvoo variables. - - * nnml.el (nnml-directory, nnml-active-file) - (nnml-newsgroups-file, nnml-get-new-mail, nnml-nov-is-evil) - (nnml-marks-is-evil, nnml-filenames-are-evil) - (nnml-prepare-save-mail-hook, nnml-inhibit-expiry): Fix doc. - - * nnmh.el (nnmh-directory, nnmh-get-new-mail) - (nnmh-prepare-save-mail-hook, nnmh-be-safe): Fix doc. - (nnmh-possibly-change-directory): Use `nnheader-report' instead of - `error'. - - * nnmbox.el (nnmbox-mbox-file, nnmbox-active-file) - (nnmbox-get-new-mail, nnmbox-prepare-save-mail-hook): - - * nnfolder.el (nnfolder-directory, nnfolder-active-file) - (nnfolder-newsgroups-file, nnfolder-get-new-mail) - (nnfolder-save-buffer-hook, nnfolder-inhibit-expiry) - (nnfolder-nov-is-evil, nnfolder-marks-is-evil): Fix doc. - - * nnbabyl.el (nnbabyl-mbox-file, nnbabyl-active-file) - (nnbabyl-get-new-mail, nnbabyl-prepare-save-mail-hook): Fix doc. - - * imap.el, nnimap.el: Fix indentation. - - * gnus-sieve.el (gnus-sieve-article-add-rule): Autoload it. - -2001-12-12 Didier Verna - - * gnus-msg.el (gnus-group-news): New function. - * gnus-group.el (gnus-group-mode-map): bind it to `i'. - * gnus-group.el (gnus-group-make-menu-bar): add a menu item for it. - * gnus-salt.el (gnus-carpal-group-buffer-buttons): add a button - for it. - * gnus-msg.el (gnus-summary-news-other-window): New function. - * gnus-msg.el ((gnus-summary-send-map "S" gnus-summary-mode-map)): - bind it to `i'. - * gnus-sum.el (gnus-summary-mode-map): bind it to `i'. - * gnus-sum.el (gnus-summary-make-menu-bar): add a menu item for it. - * gnus-salt.el (gnus-carpal-summary-buffer-buttons): add a button - for it (called with a prefix). - * gnus-msg.el (gnus-configure-posting-styles): add an optional - group-name argument. - * gnus-msg.el (gnus-setup-message): use it. - -2001-12-12 00:00:00 ShengHuo ZHU - - * gnus-sum.el (gnus-summary-show-article): Fix doc. - -2001-12-10 17:00:00 ShengHuo ZHU - - * mml.el (mime-to-mml): Remove Content-Disposition too. - -2001-12-09 08:00:00 TSUCHIYA Masatoshi - - * gnus-sum.el (gnus-summary-buffer-name): Decode group name. - * gnus-group.el (gnus-group-name-decode): Decode unibyte - strings only. - -2001-12-08 Nevin Kapur - - * nnmail.el (nnmail-fancy-expiry-targets): New variable. - (nnmail-fancy-expiry-target): Use it. - Suggestions from Simon Josefsson . - -2001-12-07 14:00:00 ShengHuo ZHU - - * gnus-sum.el (gnus-summary-show-article): Recount lines if not exist. - -2001-12-07 10:00:00 ShengHuo ZHU - - * nnwfm.el (nnwfm-create-mapping): Use gnus-url-unhex-string. - - * gnus-util.el (gnus-url-unhex-string): Move here. - -2001-12-07 09:00:00 ShengHuo ZHU - - * nnrss.el (nnrss-decode-entities-unibyte-string): Use - mm-url-decode-entities-nbsp. - - * nnlistserv.el, nnultimate.el, nnwarchive.el, nnweb.el: - * webmail.el, nnwfm.el: Use mm-url. - - * mm-url.el (mm-url-fetch-form): Move from nnweb. - (mm-url-remove-markup): Move from nnweb. - (mm-url-fetch-simple): Move from webmail. - - * nnslashdot.el (nnslashdot-request-post): Use mm-url-fetch-form. - -2001-12-07 01:00:00 ShengHuo ZHU - - * gnus-sum.el (gnus-summary-print-truncate-and-quote): New function. - (gnus-summary-print-article): Use it. - - * gnus-util.el (gnus-replace-in-string): Typo. - -2001-12-06 10:00:00 ShengHuo ZHU - - * nnweb.el (nnweb-replace-in-string): Removed. - - * gnus-util.el (gnus-replace-in-string): New function. - (gnus-mode-string-quote): Use it. - - * nnrss.el (nnrss-format-string): Use gnus-replace-in-string. - * nnwfm.el (nnwfm-create-mapping): Ditto. - -2001-12-06 01:00:00 ShengHuo ZHU - - * dgnushack.el (dgnushack-compile): nnrss.el and - nnslashdot.el don't depend on nnweb, url, w3. - - * nnrss.el: Use mm-url. - -2001-12-06 00:00:00 ShengHuo ZHU - - * mm-url.el (mm-url-insert-file-contents): Support file:. - -2001-12-05 14:00:00 ShengHuo ZHU - - * mm-view.el: Lower case for the description line. Sync from the - Emacs CVS. - -2001-12-05 12:00:00 ShengHuo ZHU - - * gnus-group.el (gnus-group-find-new-groups): Fix doc. - From: Stefan Monnier - -2001-12-05 Katsumi Yamaoka - - * mm-view.el (mm-inline-text): Decode a charset-encoded rich text. - -2001-12-04 08:00:00 ShengHuo ZHU - - * mm-url.el: Require executable. - Suggested by Katsumi Yamaoka . - -2001-12-03 11:00:00 ShengHuo ZHU - - * pop3.el (pop3-munge-message-separator): Only use valid date. - Trivial patch from Michael Welsh Duggan . - - * Makefile.in: gnus-load.elc may not be generated. - -2001-12-03 09:00:00 ShengHuo ZHU - - * mm-url.el: New file. - * nnslashdot.el: Use it. - * mm-extern.el (mm-extern-url): Use it. - -2001-12-01 15:00:00 ShengHuo ZHU - - * gnus-sum.el (gnus-summary-save-article): Nix - gnus-display-mime-function and gnus-article-prepare-hook. - - * gnus-spec.el (gnus-parse-complex-format): Properly handle %C at - the beginning of lines. - (gnus-complex-form-to-spec): Ditto. - -2001-12-01 08:00:00 Paul Jarc - - * message.el (message-make-mft): Fix the m-s-a-file regexp. - -2001-11-30 21:00:00 Paul Jarc - - * message.el: New variable message-subscribed-address-file; - use it in message-make-mft. - -2001-11-30 12:00:00 ShengHuo ZHU - - * message.el (message-tab-body-function): Set to nil. - (message-tab): Use text-mode-map or global-map. - Suggested by Kai Gro,b_(Bjohann . - -2001-11-30 Simon Josefsson - - * gnus-agent.el (gnus-agent-fetch-headers): Use gnus-range-add - instead of gnus-union, for speed. Suggested by Christoph Conrad - . - (gnus-agent-fetch-group-1): Add verbose message. - -2001-11-29 12:00:00 ShengHuo ZHU - - * gnus-agent.el (gnus-agent-write-active): Make sure sym is a cons - of integers. - -2001-11-29 Kai Gro,b_(Bjohann - - * message.el (message-newgroups-header-regexp) - (message-completion-alist, message-tab-body-function): Use - defcustom rather than defvar. - (message-tab): Mention `message-tab-body-function' in doc. - Suggested by Karl Eichwalder. - -2001-11-28 16:00:00 ShengHuo ZHU - - * gnus-uu.el (gnus-uu-save-article): Use #part instead of #mml. - -2001-11-28 12:00:00 ShengHuo ZHU - - * nnheader.el (nnheader-find-nov-line): Don't use macro - gnus-delete-line. - - * gnus-group.el (gnus-group-name-decode): Defun instead of defsubst. - (gnus-group-name-charset): Ditto. - - * gnus-util.el (gnus-buffer-live-p): Ditto. - -2001-11-28 11:00:00 ShengHuo ZHU - - * sieve-manage.el (sieve-manage-stream-alist): Backslash before - open parenthesis in doc. - (sieve-manage-authenticator-alist): Typo in doc. - * imap.el (imap-authenticator-alist): Typo in doc. - (imap-stream-alist): Backslash. - - * gnus-sum.el (gnus-summary-limit-to-author): Missing arguments. - Thanks to david.goldberg6@verizon.net (David S. Goldberg) - -2001-11-27 14:00:00 ShengHuo ZHU - - * gnus-topic.el (gnus-topic-mode): Add LOCAL for add-hook. - - * message.el (message-mode): make-local-hook is harmless in Emacs 21. - - * gnus-msg.el (gnus-configure-posting-styles): use - make-local-hook. Add LOCAL for add-hook. - -2001-11-27 Per Abrahamsen - - * message.el (message-mode): Use `make-local-hook' unless - obsolete. - Patch by Katsumi Yamaoka . - -2001-11-26 Katsumi Yamaoka - - * canlock.el: Remove sha1.el and base64.el stuff. - -2001-11-26 Didier Verna - - * nnmbox.el (nnmbox-create-mbox): create the mbox file directory - if needed. - -2001-11-21 Katsumi Yamaoka - - * message.el (message-tamago-not-in-use-p): New function. - (message-strip-forbidden-properties): Use it. - -2001-11-26 Didier Verna - - * gnus-start.el (gnus-check-first-time-used): only check for - existence of .el[d] files. - -2001-11-25 15:00:00 ShengHuo ZHU - - * mm-util.el (mm-coding-system-priorities): Add backslash in the doc. - - * message.el (message-setup-1): Clean up mc-*. - -2001-11-25 09:00:00 ShengHuo ZHU - - * gnus-util.el (gnus-directory-sep-char-regexp): New variable. - * gnus-score.el (gnus-score-find-bnews): Use it. - - * gnus-sum.el (gnus-summary-limit-to-subject): An exclusion version. - (gnus-summary-limit-to-author): Ditto. - (gnus-summary-limit-to-extra): Ditto. - (gnus-summary-find-matching): Support not-matching argument. - -2001-11-25 Kai Gro,b_(Bjohann - - * message.el (message-wash-subject): Use `insert' rather than - `insert-string', which is deprecated. - -2001-11-24 Simon Josefsson - - * mm-encode.el (mm-encode-content-transfer-encoding): Fix error - message. (Gnus does not "default" to using 8bit for the message, - it default to use 8bit encoding and the user-supplied CTE - value. Calling this behaviour "treating it as 8bit" is perhaps - better.) - - * mm-bodies.el (mm-body-encoding): Intern encoding if needed - (compare mm-charset-to-coding-system). - -2001-11-23 02:00:00 ShengHuo ZHU - - * canlock.el (canlock-sha1-with-openssl): Use unibyte - buffer. Correctly decode hex. - -2001-11-21 01:00:00 ShengHuo ZHU - - * gnus-agent.el (gnus-category-insert-line): Convert category - names to strings. - -2001-11-20 21:00:00 ShengHuo ZHU - - * message.el (sha1): eval-and-compile. - -2001-11-20 Paul Jarc - - * message.el (message-allow-no-recipients): New variable. - (message-send): Use it, customize the prompting when posting to - Gcc/Fcc alone. - -2001-11-20 09:00:00 ShengHuo ZHU - - * mm-util.el (mm-coding-system-priorities): New variable. - (mm-sort-coding-systems-predicate): New function. - (mm-find-mime-charset-region): Resort coding systems if needed. - Suggested by Katsumi Yamaoka . - -2001-11-20 Didier Verna - - * gnus-group.el (gnus-group-make-help-group): new optional - argument to control the error behavior. - * gnus-start.el (gnus-check-first-time-used): use it to avoid - erroring. - -2001-11-19 Simon Josefsson - - * message.el (message-mode-map): Use C-c C-f C-i for Importance: - instead of C-c C-u. Suggested by Per Abrahamsen - . - -2001-11-18 08:00:00 ShengHuo ZHU - - * nnfolder.el (nnfolder-read-folder): Use group instead of - nnfolder-current-group. - Suggested by K,Ba(Broly L,Bu(Brentey . - -2001-11-17 Simon Josefsson - - * message.el (message-send): Ask user if Fcc/Gcc should be - performed when no other sender was specified. - Suggested by prj@po.cwru.edu (Paul Jarc). - -2001-11-17 Simon Josefsson - - * message.el (message-mode, message-mode-map): Use C-c C-u for - Importance: instead of C-c C-p (used by SC). - -2001-11-16 Simon Josefsson - - * message.el (message-insert-importance-high) - (message-insert-importance-low): Save point. - - * mail-source.el (mail-source-fetch-imap): Fix BODY.PEEK return - value. - -2001-11-16 Per Abrahamsen - - * message.el (message-strip-special-text-properties): New option. - (message-strip-forbidden-properties): Obey it. - -2001-11-14 Sam Steingold - - * gnus-score.el: Fixed some doc strings to properly quote symbols. - -2001-11-15 Simon Josefsson - - Support "Importance:" header in Message. - - * message.el (message-mode-map): Bind C-c C-p to - `message-insert-or-toggle-importance' - (message-mode-menu): Add message-insert-importance-{high,low}. - (message-insert-importance-high, message-insert-importance-low) - (message-insert-or-toggle-importance): New functions. - (message-tool-bar-map): Add {un,}important. - (message-mode): Doc fix. - -2001-11-15 Simon Josefsson - - * message.el (message-tool-bar-map): Fix attach toolbar tooltip. - - * mml.el (mml-menu): Fix toolbar tooltip. - -2001-11-15 14:00:00 ShengHuo ZHU - - * nnfolder.el (nnfolder-save-marks): gnus-prin1 takes one argument. - * nnml.el (nnml-save-marks): Ditto. - - * gnus-sum.el (gnus-newsgroup-variables): Fix doc. - -2001-11-15 Simon Josefsson - - * nnml.el (nnml-save-marks): - * nnfolder.el (nnfolder-save-marks): Use `gnus-prin1'. - Suggested by Istvan Marko . - -2001-11-15 Per Abrahamsen - - * gnus-art.el (gnus-article-wash-status-strings): Use - `copy-sequence', not `copy-seq'. - -2001-11-15 Per Abrahamsen - - * gnus-art.el (gnus-article-wash-status-strings): New constant. - (gnus-gnus-article-wash-status-entry): New function. - (gnus-article-wash-status): Use it. - -2001-11-13 10:00:00 ShengHuo ZHU - - * mml1991.el: Add coding header. - -2001-11-12 Simon Josefsson - - * mml1991.el (mml1991-use, mml1991-function-alist): New variables. - (mml1991-gpg-sign, mml1991-gpg-encrypt): Renamed, from - `mml1991-sign' and `mml1991-encrypt'. - (mml1991-encrypt, mml1991-sign): New glue functions. - (mml1991-mailcrypt-sign, mml1991-mailcrypt-encrypt): New functions. - - * mml.el (mml-mode-map): `C-c RET o' map for PGP. - (mml-menu): Add PGP to menu. - - * mml-sec.el (top-level): Require mml1991. Don't require smime. - (mml-sign-alist, mml-encrypt-alist): Add "pgp". - (mml-pgp-sign-buffer, mml-pgp-encrypt-buffer) - (mml-secure-sign-pgp, mml-secure-encrypt-pgp): New glue functions. - - * mml2015.el: Mention RFC 3156. - -2001-11-12 Sascha L,A|(Bdecke - - * mml1991.el: New file. - -2001-11-12 13:00:00 ShengHuo ZHU - - * gnus-start.el (gnus-auto-subscribed-groups): Use ^nnml. - -2001-11-12 Michael Cook - - * gnus-sum.el (gnus-summary-move-article): Use number-to-string. - -2001-11-11 Simon Josefsson - - * message.el (top-level): Autoload sha1. - (message-canlock-generate): Use sha1 instead of md5 (sha1 used by - canlock, no need to require two different hash algs). Suggested - by Ferenc Wagner . - -2001-11-09 Pavel Jan,Am(Bk - - * gnus.el (gnus-local-domain): Fix doc. - -2001-11-09 Kai Gro,b_(Bjohann - - * message.el (message-point-in-header-p): New function. - (message-do-auto-fill): Use it. - (message-beginning-of-line): New function. Goes to beginning of - header value (i.e., end of header name), or to beginning of line - if already at beginning of value. Behaves like - `beginning-of-line' when in message body. - (message-mode-map): Bind it. - -2001-11-08 Simon Josefsson - - * gnus-msg.el (gnus-posting-styles): Add doc. - -2001-11-07 Simon Josefsson - - * gnus-sieve.el (gnus-sieve-generate): Don't invoke sieve-mode. - - * sieve-mode.el (sieve-control-commands-face) - (sieve-control-commands-face, sieve-action-commands-face) - (sieve-test-commands-face, sieve-tagged-arguments-face): New - faces. - (sieve-font-lock-keywords): Use them. - (sieve-mode): Only set font-lock-defaults in emacs. - - * gnus-art.el (gnus-default-article-saver): Add - gnus-summary-save-body-in-file. - (gnus-summary-write-to-file): Fix doc. - -2001-11-07 Simon Josefsson - - * gnus-art.el (gnus-treat-highlight-signature): Add cross - reference to the correct chapter in the manual. - - * mml.el (mml-mode): Add cross reference to Emacs MIME manual. - Suggested by "Golubev I. N." . - -2001-11-07 06:00:00 ShengHuo ZHU - - * mml.el (mml-preview): Bind mail-header-separator. - -2001-11-07 Katsumi Yamaoka - - * message.el: Always require canlock. - (message-ignored-supersedes-headers): Include Cancel-Lock and - Cancel-Key. - (message-insert-canlock): Don't require canlock. - (message-cancel-news): Don't check whether canlock is available. - (message-supersede): Support cancel-locks. - - * gnus-art.el: Don't autoload canlock. - -2001-11-06 18:00:00 ShengHuo ZHU - - * mail-source.el (mail-source-fetch-imap): ASYNC param. - From: - -2001-11-06 10:00:00 ShengHuo ZHU - - * many files: Fix copyright lines. - -2001-11-05 07:00:00 ShengHuo ZHU - - * mml.el (mml-generate-mime-1): Use mm-with-unibyte-current-buffer. - Suggested by Dave Love . - -2001-11-04 10:00:00 ShengHuo ZHU - - * message.el (message-kill-buffer): Remove auto-save file after - confirm. - - * message.el (message-send-mail): Call message-generate-headers - once. Suggested by Matt Armstrong . - - * gnus-topic.el (gnus-topic-rename): Initial-input. - Suggested by Katsuhiro Hermit Endo . - -2001-11-03 Per Abrahamsen - - * message.el (message-forbidden-properties): New constant. - (message-strip-forbidden-properties): New function. - (message-mode): Activate it. - -2001-11-02 17:00:00 ShengHuo ZHU - - * mm-util.el (mm-iso-8859-15-compatible): Fix doc. - (mm-hack-charsets): Fix doc. - -2001-11-02 Simon Josefsson - - * gnus-int.el (gnus-check-server): Message "...done" when done. - - * imap.el (imap-close): Don't message (imap-send-command-wait - returns if the connection is dropped). - (imap-wait-for-tag): Nix out message only when necessary. - - * gnus-sieve.el (gnus-sieve-script): Use "stop" instead of "elsif" - for non-crossposting. - (gnus-sieve-crosspost): Default to t to be consistent with other - parts of Gnus. - -2001-11-01 18:00:00 ShengHuo ZHU - - * mm-util.el (mm-iso-8859-15-compatible): Add inconvertible chars. - (mm-iso-8859-x-to-15-table): Ditto. - (mm-iso-8859-x-to-15-region): Ditto. - (mm-find-mime-charset-region): Ditto. - -2001-11-01 Simon Josefsson - - * nnimap.el (nnimap-close-asynchronous): New variable. - (nnimap-close-group): Use it. - (nnimap-expunge): Don't use it. - - * imap.el (imap-callbacks): New variable. - (imap-remassoc): Copied from `gnus-remassoc'. - (imap-add-callback): New function. - (imap-mailbox-expunge, imap-mailbox-close): Support asynchronous - behaviour. - (imap-parse-response): Call the callback. - - * message.el (message-insert-canlock): New variable. - (message-canlock-generate, message-canlock-password) - (message-insert-canlock): New functions. - (message-send-news): Call `message-insert-canlock'. - (top-level): Require canlock when compiling. - (message-insert-canlock): Require canlock before we need it. - -2001-11-01 13:00:00 ShengHuo ZHU - - * gnus-msg.el (gnus-copy-article-buffer): Copy sequence. - -2001-11-01 12:00:00 ShengHuo ZHU - - * dgnushack.el (dgnushack-make-load): A workaround for - custom-add-loads bug in some versions of XEmacs. - -2001-11-01 10:00:00 ShengHuo ZHU - - * mm-util.el (mm-charset-synonym-alist): Revert (some). - -2001-11-01 09:00:00 ShengHuo ZHU - - * mm-util.el (mm-iso-8859-x-to-15-region): New function. - (mm-hack-charsets): New variable. - (mm-iso-8859-15-compatible): New variable. - (mm-iso-8859-x-to-15-table): New variable. - (mm-find-mime-charset-region): Add parameter hack-charsets. - - * mm-bodies.el (mm-encode-body): Use it. - * mml.el (mml-parse-1): Ditto. - -2001-11-01 Simon Josefsson - - * gnus-group.el (gnus-group-make-menu-bar): Add Sieve. - -2001-11-01 08:00:00 ShengHuo ZHU - - * mm-util.el (mm-charset-to-coding-system): Return nil, if charset - is nil. - -2001-11-01 07:00:00 ShengHuo ZHU - - * smiley-ems.el (smiley-update-cache): Auto detect file type. - - * message.el (message-forward-rmail-make-body): Use - save-window-excursion. - (message-encode-message-body): Search with noerror. - (message-setup-1): Convert compose-mail send-actions to - message-send-actions. - -2001-11-01 Simon Josefsson - - * sieve.el: Don't require easy-mmode. Suggested by Katsumi Yamaoka - . - -2001-10-31 20:00:00 ShengHuo ZHU - - * sieve-manage.el (sieve-string-bytes): No complain. - -2001-11-01 Simon Josefsson - - * gnus-group.el (gnus-group-mode-map): Bind "D u" to - `gnus-sieve-update' and "D g" to `gnus-sieve-generate'. (Functions - has autoload cookies, so no `require' should be necessary.) - - * sieve.el, sieve-mode.el, sieve-manage.el, gnus-sieve.el: New - files. - -2001-10-31 Simon Josefsson - - * gnus-cus.el (gnus-group-parameters): Support integer `display' - parameter. - - * gnus-sum.el (gnus-select-newsgroup): If group parameter - `display' is a number (and C-u wasn't used to enter group), only - fetch that number of articles. - -2001-10-31 Matt Armstrong - - * gnus.el (gnus-find-subscribed-addresses): Doc fix: - not-subscribed -> subscribed. - -2001-10-31 08:00:00 ShengHuo ZHU - From: Josh Huber - - * message.el (message-subscribed-address-functions): New variable. - (message-subscribed-addresses): New variable. - (message-subscribed-regexps): New variable. - (message-goto-mail-followup-to): New function. - (message-send-mail): Add Mail-Followup-To. - (message-make-mft): New function. - - * gnus.el (gnus-find-subscribed-addresses): New function. - -2001-10-31 07:00:00 ShengHuo ZHU - - * mail-source.el (mail-source-fetch): If debug, don't regain signals. - (mail-source-fetch-pop): Ditto. - (mail-source-check-pop): Ditto. - - * gnus-start.el (gnus-read-init-file): Ditto. - (gnus-activate-group): Ditto. - (gnus-read-newsrc-el-file): Ditto. - -2001-10-30 23:00:00 ShengHuo ZHU - - * message.el (message-get-reply-headers): Make sure there is ", ". - - * mm-util.el (mm-mime-mule-charset-alist): Move down and call - mm-coding-system-p. Don't correct it only in XEmacs. - (mm-charset-to-coding-system): Use mm-coding-system-p and - mm-get-coding-system-list. - (mm-emacs-mule, mm-mule4-p): New variables. - (mm-enable-multibyte, mm-disable-multibyte, - mm-enable-multibyte-mule4, mm-disable-multibyte-mule4, - mm-with-unibyte-current-buffer, - mm-with-unibyte-current-buffer-mule4): Use them. - (mm-find-mime-charset-region): Treat iso-2022-jp. - -2001-10-30 Dave Love - - * mm-util.el (mm-mime-mule-charset-alist): Make it correct by - construction. - (mm-charset-synonym-alist): Remove windows-125[02]. Make other - entries conditional on not having a coding system defined for - them. - (mm-mule-charset-to-mime-charset): Use - find-coding-systems-for-charsets if defined. - (mm-charset-to-coding-system): Don't use - mm-get-coding-system-list. Look in mm-charset-synonym-alist - later. Add last resort search of coding systems. - (mm-enable-multibyte-mule4, mm-disable-multibyte-mule4) - (mm-with-unibyte-current-buffer-mule4): Just treat Mule 5 like - Mule 4. - (mm-find-mime-charset-region): Re-write. - (mm-with-unibyte-current-buffer): Restore buffer as well as - multibyteness. - -2001-10-30 21:00:00 ShengHuo ZHU - - * canlock.el, sha1-el.el, hex-util.el: Move from contrib - directory. Thanks to Katsumi Yamaoka and Shuhei - KOBAYASHI . - -2001-10-30 20:00:00 ShengHuo ZHU - - * gnus-art.el (article-display-x-face): Nix buffer-read-only - again. - - * mml2015.el (mml2015-gpg-verify): Convert to . - -2001-10-30 13:00:00 ShengHuo ZHU - - * gnus-spec.el (gnus-parse-simple-format): Use - buffer-substring-no-properties. - -2001-10-30 Katsumi Yamaoka - - * gnus-art.el (article-verify-cancel-lock): New function. - - * nnheader.el (nntp-process-response): New variable. - (nnheader-init-server-buffer): Make `nntp-process-response' - buffer-local in `nntp-server-buffer'. - - * nntp.el (nntp-prepare-post-hook): New hook. - (nntp-wait-for): Save a server's ID in `nntp-process-response'. - (nntp-async-trigger): Ditto. - (nntp-request-post): Insert a server's ID if there's no Message-ID - header; run `nntp-prepare-post-hook'. - -2001-10-30 04:00:00 ShengHuo ZHU - - * gnus-art.el (article-decode-group-name): Use nnmail-fetch-field - instead. - - * message.el (message-forward-subject-author-subject): Don't use - message-news-p, which widens the buffer. - (message-forward-make-body): New function. - (message-forward): Use it. - (message-insinuate-rmail): New function. - (message-forward-rmail-make-body): New function. - -2001-10-30 02:00:00 ShengHuo ZHU - - * mm-extern.el (mm-extern): Provide it. - - * mm-partial.el (mm-partial): Provide it. - -2001-10-28 16:00:00 ShengHuo ZHU - - * gnus-msg.el (gnus-setup-message): Call post-command-hook. - -2001-10-29 Jesper Harder - - * mml.el (mml-preview): Bind message-this-is-news if it is - news. - -2001-10-28 Simon Josefsson - - * gnus-sum.el (gnus-group-make-articles-read): Inline group. - -2001-10-29 Per Abrahamsen - - * smiley-ems.el (smiley-regexp-alist): Add support for sad and - ironic smilies. - -2001-10-27 Simon Josefsson - - * message.el (message-indent-citation): Don't add trailing - whitespace when citing text. - -2001-10-27 Jesper Harder - - * gnus.el (gnus-group-faq-directory): Fix. - -2001-10-26 14:00:00 ShengHuo ZHU - - * nnweb.el (nnweb-possibly-change-server): Create nnweb-hashtb if - not available. - (nnweb-request-scan): Nix nnweb-hashtb if ephemeral. - (nnweb-type-definition): Add google as alias of dejanews. - (nnweb-google-parse-1): Forward 1 line. - -2001-10-26 Kai Gro,b_(Bjohann - - * gnus-msg.el (gnus-summary-mail-forward): Doc fix: add pointer to - variable `message-forward-ignored-headers'. - -2001-10-24 Per Abrahamsen - - * gnus.el (gnus-expand-group-parameter): New function. - (gnus-expand-group-parameters): Call it. - (gnus-group-fast-parameter): New function. - (gnus-group-find-parameter): Call it. - -2001-10-23 Per Abrahamsen - - * gnus.el (gnus-news-group-p): Rewrote. Now accepts a header - vector (it didn't before because of a bug). - * gnus-msg.el (gnus-post-news): Use header vector directly, if - available. Before it converted it to an article number. - - This makes followup to news articles with negative numbers in - nnvirtual groups use news instead of mail. - -2001-10-23 Per Abrahamsen - - * gnus.el (post-method): Use `native' instead of `nil'. - - * gnus-msg.el (gnus-post-method): Ditto. - -2001-10-23 Per Abrahamsen - - * gnus.el (gnus-define-group-parameter): Grammar fix. - -2001-10-22 Simon Josefsson - - * gnus-msg.el (gnus-extended-version): Include - system-configuration. - Suggested by Kai.Grossjohann@CS.Uni-Dortmund.DE (Kai Gro,b_(Bjohann). - -2001-10-22 Per Abrahamsen - - * gnus.el (post-method): Customization fix: `native' is not a - valid value. - * gnus-msg.el (gnus-post-method): Doc and customization fix: - `native' is not a valid value. - -2001-10-21 Simon Josefsson - - * nnimap.el (nnimap): Defgroup - (nnimap-strict-function, nnimap-strict-function-match): New - widget, from Per Abrahamsen . - (nnimap-split-crosspost, nnimap-split-inbox) - (nnimap-split-rule, nnimap-split-predicate) - (nnimap-split-predicate): Defcustom. - (nnimap-split-inbox, nnimap-expunge-search-string) - (nnimap-importantize-dormant): Remove "*" from doc. - -2001-10-20 Kai Gro,b_(Bjohann - - * gnus-sum.el (gnus-summary-limit-to-score): Prompt for score if - not supplied via prefix arg. From Lisp, make arg mandatory. - Suggested by Frank Schmitt. - -2001-10-20 Per Abrahamsen - - * message.el (message-do-auto-fill): Avoid calling - 'rfc822-goto-eoh'. - -2001-10-20 Paul Jarc - - * message.el (message-get-reply-headers): Restructure the logic - and add comments. - -2001-10-20 Simon Josefsson - - * message.el (message-cancel-news): Support cancel-locks. - Suggested by Per Abrahamsson. - - * nnfolder.el (nnfolder-marks-changed-p): Ditto. - -2001-10-20 David Z. Maze - - * nnml.el (nnml-marks-changed-p): Use `equal' when comparing - conses. - -2001-10-19 Per Abrahamsen - - * mm-decode.el (mm-default-directory): Fix customize type. - - * message.el (message-setup-fill-variables): Kludge to use - normal-auto-fill-function even if auto fill is already activated. - -2001-10-19 Per Abrahamsen - - * message.el (message-do-auto-fill): New version that does not - rely on text properties, by Simon Josefsson . - (message-setup-1): Removed the `message-field' property. - - * gnus-draft.el (gnus-draft-edit-message): Removed the - `message-field' property. - -2001-10-19 Per Abrahamsen - - * gnus-draft.el (gnus-draft-edit-message): Change `field' to - `message-field'. The `field' property has a special significance in - Emacs 21. - - * message.el (message-send, message-setup-1): Ditto. - -2001-10-18 Simon Josefsson - - * gnus-sum.el (gnus-group-make-articles-read): Call g-r-set-mark - when undoing. - -2001-10-18 Frank Schmitt - - * gnus-sum.el (gnus-summary-limit-to-display-predicate): Fix typo. - (gnus-summary-make-menu-bar): Ditto. - -2001-10-17 Simon Josefsson - - * nnimap.el (nnimap-expiry-target): Make sure it is back to the - server. Suggested by ShengHuo ZHU . - -2001-10-17 17:00:00 Frank Schmitt - - * gnus-sum.el (gnus-summary-line-format-alist): user-date entry. - * gnus-util.el (gnus-user-date): New function. - -2001-10-17 Per Abrahamsen - - * message.el (message-check-news-header-syntax): Special case - nnvirtual groups. - - * gnus-sum.el (gnus-summary-respool-default-method): Changed - customize type to `symbol'. - -2001-10-17 12:00:00 ShengHuo ZHU - - * gnus-spec.el (gnus-parse-simple-format): Support extended spec - %&foo;. - (gnus-parse-simple-format): Support user extended spec too. - %u&foo; invokes gnus-user-format-function-foo. - -2001-10-17 11:00:00 ShengHuo ZHU - - * nnml.el (nnml-request-expire-articles): Make sure it is back to - the server. - * nnmbox.el (nnmbox-request-expire-articles): Ditto. - * nnfolder.el (nnfolder-request-expire-articles): Ditto. - * nnbabyl.el (nnbabyl-request-expire-articles): Ditto. - * nndiary.el (nndiary-request-expire-articles): Ditto. - (nndiary-schedule): Defsubst it before use it. - (nndiary-error): eval-and-compile. - -2001-10-17 Per Abrahamsen - - * gnus-msg.el (gnus-post-method): Changed two instances of - `active' to `current' and one `null' to `not'. - -2001-10-16 Katsumi Yamaoka - - * message.el (message-setup-fill-variables): Use - `normal-auto-fill-function' instead of `auto-fill-function'. - -2001-10-16 Simon Josefsson - - * mml2015.el (mml2015-fix-micalg): Fix for Mutt-bug. - (mml2015-gpg-decrypt-1): Decanonicalize decrypted MIME - body. (Mailcrypt seem to do this, but gpg.el doesn't.) - -2001-10-16 Kai Gro,b_(Bjohann - Patch by Oliver Scholz . - - * gnus-draft.el (gnus-draft-edit-message): Add text property - `field' with value `header' to message headers. - * message.el (message-setup-1): Really add text property to all of - the header, not just part of it. - -2001-09-04 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-sort-by-server): Use it. - - * gnus.el (gnus-method-to-full-server-name): New, bogus function. - - * gnus-topic.el (gnus-topic-sort-groups-by-server): New command - and keystroke. - -2001-10-14 Simon Josefsson - - * dig.el: Doc fix. - - * smime.el: Doc fix. - - * gnus-msg.el (gnus-inews-do-gcc): Port header encoded-word - charset magic from message.el. - -2001-10-12 Simon Josefsson - Suggested by david.goldberg6@verizon.net (David S. Goldberg) - - * gnus-cite.el (gnus-article-toggle-cited-text): Don't remove - 'cite from g-a-wash-types. - (gnus-cite-toggle): Ditto. Add 'cite. Set modeline. - (gnus-article-hide-citation): Fix. - - * gnus-cite.el (gnus-article-hide-citation): Add `c' mode line - character. - (gnus-article-toggle-cited-text): Toggle `c' mode line character. - - * gnus-art.el (gnus-treat-hide-citation-maybe): Remove duplicate - definition. - (gnus-signature-toggle): Toggle `s' mode line character. - - * gnus-art.el (article-emphasize): Set `g-a-wash-types' after - doing stuff that clears it. - -2001-10-12 Eric Marsden - - * gnus-cache.el (gnus-summary-limit-include-cached): Rewrite. - -2001-10-12 10:00:00 ShengHuo ZHU - - * message.el (message-do-auto-fill): Use gnus-point-at-bol. - (autoload): Add some autoloads. - -2001-10-12 Kai Gro,b_(Bjohann - Suggested by Oliver Scholz . - - * message.el (message-do-auto-fill): New function. Like - `do-auto-fill' but don't fill when in the message header. - (message-setup-1): Put a text property on the message header. - (message-setup-fill-variables): Use `message-do-auto-fill'. - -2001-10-10 12:00:00 ShengHuo ZHU - - * message.el (message-send-mail-partially): Insert an empty line - first, because of the change of message-make-lines. - -2001-10-10 Florian Weimer - - * mm-util.el (mm-charset-synonym-alist): If Emacs doesn't support - iso-8859-15, make it an alias for iso-8859-1. - -2001-10-10 Katsumi Yamaoka - - * message.el (message-send-news): Don't modify the value of - `message-syntax-checks' if it is not a list (possibly it is - `dont-check-for-anything-just-trust-me'). - -2001-10-10 Katsumi Yamaoka - - * gnus-group.el (gnus-group-name-charset-group-alist): Use - `find-coding-system' for XEmacs to check whether the coding-system - `utf-8' is available. - -2001-10-09 13:00:00 ShengHuo ZHU - - * dgnushack.el (dgnushack-compile): Detect mh-e and xml. - -2001-10-09 Per Abrahamsen - - * message.el (message-send-news): Oops, missed case with no - "Followup-To" header... - -2001-10-09 Per Abrahamsen - - * message.el (message-send-news): Allow - `gnus-group-name-charset-group-alist' to affect encoding of the - "Newsgroups" and "Followup-To" headers. - -2001-10-07 15:00:00 ShengHuo ZHU - - * Makefile.in (install-el): Depend on gnus-load.el. - -2001-10-07 13:00:00 ShengHuo ZHU - - * Makefile.in (install-el): Use -f. - From: Amos Gouaux - -2001-10-07 Per Abrahamsen - - * message.el (message-send-news): Don't encode Followups-To when - `gnus-group-name-charset-group-alist is' ".*". [Yuck] - - * gnus-util.el (gnus-decode-newsgroups): No space in newsgroup - header. - - * gnus-art.el (article-decode-group-name): Also decode - "Followup-To". - - * rfc2047.el (rfc2047-encode-message-header): Encode without - asking for null methods. - - * gnus-group.el (gnus-group-name-charset-group-alist): Make utf-8 - default charset for newsgroup names in accordance with USEFOR. - - * gnus-group.el (gnus-group-name-charset-method-alist, - gnus-group-name-charset-group-alist): Removed "*" from doc - strings, "*" should not be used for complex variables. - -2001-10-06 Simon Josefsson - - Support UTF-8 group names better. - - * message.el (message-check-news-header-syntax): Encode group - names before comparison. - - * gnus-msg.el (gnus-copy-article-buffer): Run all - `gnus-article-decode-hook's except `article-decode-charset' - instead of hardcoding call to one of them. - - * gnus-art.el (gnus-article-decode-hook): Add - `article-decode-group-name'. - (article-decode-group-name): New function, use `g-d-n'. - - * gnus-group.el (gnus-group-insert-group-line): Decode - gnus-tmp-group using `g-d-n'. - - * gnus-util.el (gnus-decode-newsgroups): New function. - -2001-10-06 Per Abrahamsen - - * gnus-srvr.el (gnus-browse-foreign-server): Fixed bug non-nil - `gnus-group-name-charset-group-alist'. - -2001-10-06 08:00:00 ShengHuo ZHU - - * Makefile.in: Install el in install. Add uninstall. - -2001-10-05 Simon Josefsson - - * nnheader.el (gnus-verbose-backends, gnus-nov-is-evil): Custom. - - * gnus-sum.el (gnus-summary-move-article): Also activate new groups. - - * nnfolder.el (nnfolder-normalize-buffer): Don't insert \n\n in - empty folders. - - * gnus-sum.el (gnus-select-newsgroup): Don't enable `display' - limiting if read-all (C-u RET) was used. - -2001-10-04 Simon Josefsson - - * mail-source.el (mail-source-movemail-program): New variable. - (mail-source-movemail): Use it. Suggested by Taylor Hutt - . - -2001-10-03 Simon Josefsson - - * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): New param. - (gnus-summary-line-format-alist): Fix param. - -2001-10-02 Simon Josefsson - - * nnimap.el (nnimap-request-move-article): Use imap.el directly, - don't go through `nnimap-request-expire-articles' to delete the - article. Thanks to prj@po.cwru.edu (Paul Jarc). - -2001-10-02 10:00:00 ShengHuo ZHU - - * gnus-agent.el (gnus-agent-write-active): The min in the - agent/active may be larger than that in the server/active. - -2001-10-01 Simon Josefsson - - * mail-source.el (mail-source-fetch-imap): Use BODY.PEEK if server - is IMAP4rev1. - - * nnml.el (gnus-article-unpropagatable-p): Autoload gnus-sum. - - * nnfolder.el: Ditto. - -2001-09-30 Dan Christensen - - * gnus-sum.el (gnus-summary-extract-address-component): New function. - (gnus-summary-from-or-to-or-newsgroups): Optimize. - -2001-09-29 Kai Gro,b_(Bjohann - - * message.el (message-mode-map): Keybinding for `gnus-delay-article'. - (message-mode-menu): Menu item for same. - - * gnus-group.el (gnus-group-make-menu-bar): Menu item for sending - delayed articles. - - * gnus-delay.el (gnus-delay-send-drafts): Do nothing if - nndraft:delayed does not exist. - (gnus-delay-initialize): Don't set up keymap, that's done from - message.el now. - (gnus-delay, gnus-delay-group, gnus-delay-header) - (gnus-delay-default-delay, gnus-delay-default-hour): Customize. - -2001-09-29 Simon Josefsson - - * mm-util.el (mm-mime-mule-charset-alist): Encode mule-utf-8 as - utf-8, not eight-bit-control. - - * imap.el (imap-shell-host, imap-default-user, imap-use-utf7) - (imap-log, imap-debug): Custom. - (imap-log-buffer, imap-debug-buffer): New constants. - (imap-kerberos4-open, imap-gssapi-open, imap-ssl-open) - (imap-network-open, imap-shell-open, imap-starttls-open) - (imap-send-command-1, imap-send-command, imap-arrival-filter) - (imap-debug): Use imap-*-buffer. - - * nndoc.el (nndoc-article-type): Add mailman. - (nndoc-type-alist): Ditto. - (nndoc-mailman-type-p): New function. - -2001-09-28 07:00:00 ShengHuo ZHU - - * gnus-xmas.el (gnus-article-x-face-command): Merge it into - gnus-art.el. - -2001-09-27 Simon Josefsson - - * gnus-topic.el (gnus-topic-mode-map): Add catchup. - (gnus-topic-catchup-articles): New function. Suggested by Robin - S. Socha . - -2001-09-27 11:00:00 Gerd M,Av(Bllmann . - - * gnus-ems.el (gnus-article-display-xface): Insert xface after - previous ones. - -2001-09-27 07:00:00 Daiki Ueno - - * gnus-sum.el (gnus-summary-show-article): The arglist of - detect-coding-region is incompatible. - -2001-09-26 18:00:00 Katsuhiro Hermit Endo - - * gnus-group.el (gnus-group-delete-group): Typo. - -2001-09-26 Simon Josefsson - - * nnmail.el (nnmail-expiry-target-group): Add doc warning. - - * nnimap.el (nnimap-expiry-target): Use temp buffer. - -2001-09-26 07:00:00 ShengHuo ZHU - - * gnus-cus.el (gnus-group-parameters): Display as sexp. - -2001-09-22 Simon Josefsson - - * nnml.el (nnml-open-marks): Remove unpropagatable marks. - - * nnfolder.el (nnfolder-open-marks): Ditto. - - * gnus-sum.el (gnus-article-unpropagatable-p): New function. - (gnus-update-marks): Use it. - (gnus-update-marks): Use `gnus-article-mark-to-type' instead of - hardcoded list. - - * gnus.el (gnus-article-special-mark-lists): Add killed. - (gnus-article-unpropagated-mark-lists): New constant. - -2001-09-22 Simon Josefsson - - * gnus-sum.el (gnus-summary-mode-hook): Add gnus-pick-mode as - custom option. - -2001-09-23 Simon Josefsson - - * gnus-draft.el (gnus-draft-setup): Add mark in backend as well. - -2001-09-23 02:00:00 ShengHuo ZHU - - * gnus-msg.el (gnus-button-mailto): Hack save-selected-window-window. - -2001-09-22 Per Abrahamsen - - * gnus-group.el (gnus-group-sort-function): Fix customize type to - accept lists of functions. - -2001-09-20 Simon Josefsson - - * gnus-group.el (gnus-group-catchup): Update expire marks in - backend. Also, if ALL also set expire marks on tick/dormant. - -2001-09-20 Kai Gro,b_(Bjohann - - * message.el (message-tab-body-function): New variable. - * message.el (message-tab): Use it. - -2001-09-19 Sam Steingold - - * gnus-win.el (gnus-buffer-configuration): Respect - `gnus-bug-create-help-buffer'. - -2001-09-18 Simon Josefsson - - * gnus-spec.el (gnus-correct-pad-form): Re-revert. - (gnus-parse-simple-format): Re-revert. - -2001-09-16 Katsuhiro Hermit Endo - Trivial patch. - - * gnus-spec.el (gnus-parse-complex-format): Don't fold search - case. (Thanks to Daiki Ueno .) - -2001-09-18 Simon Josefsson - - * gnus-spec.el (gnus-correct-pad-form): Remove until papers are - signed. - (gnus-parse-simple-format): Don't use it. - -2001-09-17 Miles Bader - - * gnus-srvr.el (gnus-server-insert-server-line): Don't let an - error querying a backend abort the whole process. - -2001-09-17 08:00:00 Gerd M,Av(Bllmann - - * gnus-srvr.el (gnus-server-mode): Fix bogus fontification. - -2001-09-17 Didier Verna - - * nndiary.el: version 0.2-b14. - * gnus-diary.el (gnus-diary-check-message): fix `read-string' - compatibility problem with XEmacs 21.1. - -2001-09-15 Simon Josefsson - - * gnus-group.el (gnus-group-line-format): Document %c. - - * nnml.el (nnml-parse-head): Handle CRLF files. - (nnml-generate-nov-file): Ditto. - (nnml-retrieve-headers): Ditto. - -2001-09-15 Michael Welsh Duggan - - * gnus-spec.el (gnus-parse-format): Don't treat %c as %C. - -2001-09-13 Martin Kretzschmar - - * gnus-spec.el (gnus-correct-substring): Still stopped one - character before we wanted (never included last character). - (gnus-tilde-max-form, gnus-tilde-cut-form) Made readable again, - add missing "," (once per function) - -2001-09-14 Simon Josefsson - - * gnus-start.el (gnus-group-mode-hook): Moved from gnus-group - (otherwise e.g. gnus-agentize in .gnus overrides the customized - default before gnus-group is loaded and the variable set.) - - * nnimap.el (nnimap-request-set-mark): Do not store bookmark, - killed or unsent marks. - - * gnus-draft.el (gnus-draft-setup): Don't set mark when there - isn't an article to set it on (e.g. when you `a' in a group). - -2001-09-12 Pavel Jan,Am(Bk - - * mm-util.el (mm-charset-synonym-alist): add windows-1250 so we - can read e-mails from Microsoft Outlook users not using ISO - 8859-2 character set. - -2001-09-12 18:00:00 ShengHuo ZHU - - * gnus-diary.el: Minor modifications to avoid warnings. - (gnus-summary-misc-menu): defvar. - (gnus-diary-check-message): Use gnus-point-at-eol. - (gnus-diary-kill-entire-line): eval-and-compile. - -2001-09-12 Didier Verna - - * nndiary.el: new version (0.2-b13). - * nndiary.el (nndiary-mail-sources): doc update. - * nndiary.el (nndiary-split-methods): ditto. - * nndiary.el (nndiary-request-accept-article-hooks): New. - * nndiary.el (nndiary-request-accept-article): use it, check - message validity. - * nndiary.el (nndiary-get-new-mail): changed default to nil. - * nndiary.el (nndiary-schedule): fix bug (misplaced - condition-case): it didn't return nil on error. - * gnus-diary.el: new version. - * gnus-diary.el (gnus-diary-summary-line-format): removed %I. - * gnus-diary.el (gnus-diary-header-value-history): New. - * gnus-diary.el (gnus-diary-narrow-to-headers): New. - * gnus-diary.el (gnus-diary-add-header): New. - * gnus-diary.el (gnus-diary-check-message): New. - * gnus-diary.el (message-mode-map): bind the above to `C-c D c'. - * gnus-diary.el (gnus-article-edit-mode-map): ditto. - -2001-09-10 TSUCHIYA Masatoshi - - * gnus-sum.el (gnus-select-newsgroup): Make - `gnus-current-select-method' buffer-local. - - * gnus-art.el (gnus-request-article-this-buffer): Refer - `gnus-current-select-method' in the current summary buffer. - -2001-09-10 Daniel Pittman - - * gnus-spec.el (gnus-correct-pad-form): Fix. - -2001-09-09 Simon Josefsson - - * mm-decode.el (mm-inline-media-tests): Add - application/x-emacs-lisp. - (mm-attachment-override-types): Add - application/{x-,}pkcs7-signature. - - * gnus-srvr.el (gnus-server-mode-hook, gnus-server-exit-hook) - (gnus-server-line-format, gnus-server-mode-line-format) - (gnus-server-browse-in-group-buffer): Customize. - -2001-09-08 16:00:00 ShengHuo ZHU - - * nnml.el (nnml-marks-changed-p): Typo. - (nnml-save-marks, nnml-open-marks): Use gnus-sethash. - (nnml-marks-changed-p): Use gnus-gethash. - (nnml-marks-modtime): Use gnus-make-hashtable. - - * nnfolder.el (nnfolder-marks-changed-p): Typo. - (nnfolder-request-expire-articles, nnfolder-save-marks) - (nnfolder-open-marks): Typo. - (nnfolder-save-marks, nnfolder-open-marks): Use gnus-sethash. - (nnfolder-marks-changed-p): Use gnus-gethash. - (nnfolder-marks-modtime): Use gnus-make-hashtable. - -2001-09-08 Simon Josefsson - - * nnfolder.el (nnfolder-marks-modtime): New variable. - (nnfolder-marks-changed-p): New function. - (nnfolder-save-marks, nnfolder-open-marks): Save modtime. - (nnfolder-request-update-info): Don't update if marks didn't change. - - * nnml.el (nnml-marks-modtime): New variable. - (nnml-marks-changed-p): New function. - (nnml-save-marks, nnml-open-marks): Save modtime. - (nnml-request-update-info): Don't update if marks didn't change. - - * gnus-agent.el (gnus-agent-any-covered-gcc) - (gnus-agent-add-server, gnus-agent-remove-server): Use - gnus-agent-method-p. - - * gnus-art.el (gnus-buttonized-mime-types): New variable. - (gnus-unbuttonized-mime-type-p): Use it. - - * gnus-agent.el (gnus-agent-fetch-group): If online, actually - fetch group. - -2001-09-08 Daniel Pittman - - * gnus-spec.el (gnus-correct-pad-form): New function. - (gnus-parse-simple-format): Use it. - -2001-09-07 Simon Josefsson - - * gnus-group.el (gnus-group-sort-groups): Unmark all groups. - (gnus-group-sort-selected-groups): Ditto. Suggested by Harry - Putnam . - (gnus-group-sort-selected-groups): Touch dribble file. - -2001-09-07 Raja R Harinath - - * nnml.el (nnml-filenames-are-evil): New variable. - (nnml-article-to-file-alist): Rename to ... - (nnml-current-group-article-to-file-alist): ... this. - Respect `nnml-filenames-are-evil'. - (nnml-active-number): Update. - (nnml-update-file-alist): Update. - (nnml-request-article): Use nnheader-article-to-file-alist. - (nnml-request-rename-group): Likewise. - -2001-09-06 Katsumi Yamaoka - - * gnus-sum.el (gnus-summary-insert-line): Fix. - -2001-09-06 Bj,Av(Brn Torkelsson - - * gnus-sum.el: Bind g-s-t-s to "W g". - * gnus-sum.el (gnus-summary-make-menu-bar): Add g-s-t-s. - * gnus-sum.el (gnus-summary-toggle-smiley): New function. Toggles - display of graphical smilies. - -2001-09-07 02:00:00 Bill White - - * gnus-start.el (gnus-setup-news): A typo. - -2001-09-06 Simon Josefsson - - * gnus-sum.el (gnus-summary-insert-line): Insert forwarded, recent - and unseen marks. - -2001-09-05 Kai Gro,b_(Bjohann - - * nnmail.el (nnmail-split-fancy): Document `junk'. - -2001-09-04 Simon Josefsson - - * imap.el (imap-search): Don't error if server is broken. - -2001-09-02 Benjamin Rutt - - * nnmbox.el (nnmbox-find-article): Fix infinite loop when - searching for an article that isn't in the mbox. - -2001-09-02 23:12:48 Lars Magne Ingebrigtsen - - * nnslashdot.el (nnslashdot-retrieve-headers-1): Get references - right, and get all the comments. - -2001-09-02 Simon Josefsson - Suggested by Dan Christensen - - * nnfolder.el (nnfolder-request-update-info): Fix message. - - * nnml.el (nnml-request-update-info): Ditto. - -2001-09-01 Simon Josefsson - - * nnml.el (nnml-request-expire-articles): Also bind - `nnml-current-group' and `nnml-article-file-alist' when using - expiry-target. (Otherwise nnml will be in a inconsistent internal - state causing all kind of problems.) - (nnml-request-expire-articles): If `nnml-article-to-file' or - `file-attributes' failes, return article as un-expirable instead - of treating it as expired. - -2001-08-31 Sam Steingold - - * imap.el (imap-mailbox-examine, imap-mailbox-examine-1): Fix a - typo: `exmine' --> `examine'. - -2001-08-30 13:00:00 ShengHuo ZHU - - * nndoc.el (nndoc-forward-type-p): It is not a digest. - -2001-08-30 11:00:00 ShengHuo ZHU - - * nnml.el (nnml-check-directory-twice): Remove. - (nnml-retrieve-headers): Ditto. - (nnml-article-to-file): Use nnheader-directory-files-is-safe. - -2001-08-30 Andrew Innes - - * nnheader.el (nnheader-directory-files-is-safe): No need to read - directory twice on Windows, or on GNU Emacs-21. - -2001-08-30 Andrew Innes - - * nnml.el (nnml-request-article): Use nnml-article-to-file-alist. - (nnml-request-rename-group): Ditto. - (nnml-active-number): Ditto. - (nnml-request-create-group): Use nnml-directory-articles. - (nnml-request-expire-articles): Use nnml-directory-articles, which - gets list from nov database if available. - (nnml-get-nov-buffer): New function. - (nnml-open-nov): Use it. - (nnml-update-file-alist): Use nnml-article-to-file-alist, which - gets alist from nov database if available. - (nnml-directory-articles): New function. - (nnml-article-to-file-alist): New function. - -2001-08-30 Andrew Innes - - * mm-decode.el (mm-display-external): Use `name' as filename, if - `filename' attribute is not present. - -2001-08-30 Andrew Innes - - * mail-source.el (mail-source-flash): New defcustom. - (mail-source-new-mail-p): Ring visible bell if appropriate. - (mail-source-start-idle-timer): Use unwind-protect to ensure idle - timer is cleared even if mail check signals an error. - -2001-08-29 10:00:00 ShengHuo ZHU - - * gnus-sum.el (gnus-summary-move-article): Only update marks of - type 'list. - -2001-08-29 00:00:00 ShengHuo ZHU - - * flow-fill.el (fill-flowed): eol might be point-max. - -2001-08-27 Simon Josefsson - - * nnml.el (nnml-request-update-info): Fix message. - (nnml-open-marks): Ditto. - - * nnfolder.el (nnfolder-request-update-info): - (nnfolder-open-marks): Fix message. - -2001-08-25 Simon Josefsson - - * nnfolder.el (nnfolder-save-marks): Don't create directory named - after group in ~/. - -2001-08-25 Andreas Jaeger - - * nnfolder.el (nnfolder-open-marks): Fix typo. - * nnml.el (nnml-open-marks): Likewise. - -2001-08-25 Simon Josefsson - - Make nnfolder groups self-contained as far as marks are concerned. - - * nnfolder.el (nnfolder-marks-directory, nnfolder-marks-is-evil) - (nnfolder-marks, nnfolder-marks-file-suffix): New variables. - (nnfolder-open-server): Make marks directory. - (nnfolder-request-delete-group): Delete marks file. - (nnfolder-request-delete-group): Check of nov/marks file exist - before deleting. - (nnfolder-request-rename-group): Rename marks file. - (nnfolder-request-rename-group): Only rename nov/mark if they exists. - (nnfolder-request-set-mark, nnfolder-request-update-info) - (nnfolder-group-marks-pathname, nnfolder-save-marks) - (nnfolder-open-marks): New functions. - (top-level): Require gnus. - -2001-08-25 09:00:00 ShengHuo ZHU - - * nnweb.el (nnweb-type-definition): Use google raw file. - (nnweb-google-parse-1): Ditto. - (nnweb-google-identity): Ditto. - (nnweb-reference-wash-article): Move nnweb-decode-entities here. - (nnweb-altavista-wash-article): Ditto. - (nnweb-request-article): Remove nnweb-decode-entities. - - * nnml.el: Require 'gnus. - -2001-08-25 Simon Josefsson - - * nnml.el (nnml-marks-is-evil): Add doc. - -2001-08-25 Simon Josefsson - - * nnml.el (nnml-save-marks): Wrap saving marks in a - condition-case, to allow user to start Gnus if saving marks failed - for some reason. - -2001-08-24 16:05:38 Lars Magne Ingebrigtsen - - * gnus-spec.el (gnus-compile): Don't compile gnus-version. - - * gnus-group.el (gnus-update-group-mark-positions): Bind - gnus-group-update-hook to nil. - -2001-08-24 13:00:00 ShengHuo ZHU - - * mml.el (mml-generate-mime-1): Force as multibyte string. - -2001-08-24 12:00:00 Martin Kretzschmar - - * gnus-sum.el (gnus-summary-insert-line) - (gnus-summary-prepare-threads): gnus-tmp-lines should be a string. - -2001-08-24 12:00:00 ShengHuo ZHU - - * gnus-spec.el (gnus-correct-substring): Take optional END. - - * nnrss.el (nnrss-request-article): Remove \n. - (nnrss-retrieve-headers): Lines number is -1. - -2001-08-24 Simon Josefsson - - * gnus-group.el (gnus-info-clear-data): Call - nnfoo-request-set-mark to propagate marks. Fix bug: - `gnus-group-update-line' doesn't update read range unless we call - `gnus-get-unread-articles-in-group' first. - - * nnimap.el (nnimap-request-set-mark): Don't propagate seen flags - to server. - -2001-08-23 21:00:00 ShengHuo ZHU - - * gnus-util.el (gnus-create-info-command): Return an interactive - function. - -2001-08-23 19:00:00 Katsumi Yamaoka - - * gnus-spec.el (gnus-parse-complex-format): Use equal. - -2001-08-23 18:43:05 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-select-newsgroup): Use it. - - * gnus-util.el (gnus-not-ignore): New function. - - * lpath.el (featurep): Don't fbind char-int. - - * gnus-util.el (gnus-create-info-command): New function. - - * gnus-group.el (gnus-group-edit-group): Make C-c C-i go to the - right node. - - * gnus-sum.el (gnus-select-newsgroup): Clean up. - (gnus-summary-limit-children): Use 'identity instead of `all'. - (gnus-summary-limit-to-display-predicate): New command and - keystroke. - -2001-08-23 10:00:00 ShengHuo ZHU - - * nnrss.el (nnrss-group-alist): Use fm-releases.rdf. - - * gnus-spec.el (gnus-format-specs): Miss a right parenthesis. - -2001-08-23 18:43:05 Lars Magne Ingebrigtsen - - * gnus-spec.el: Add the Gnus version. - (gnus-update-format-specifications): If the Gnus version changes, - nix out the format spec cache. - - * gnus.el (gnus-continuum-version): Made into a command and - optionalize the VERSION. - - * gnus-spec.el (gnus-parse-complex-format): Remove %C specs from - the start of the lines. - -2001-08-22 00:06:52 Lars Magne Ingebrigtsen - - * gnus.el (gnus-visual-p): Define function before use of - function. - -2001-08-21 23:28:02 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-adjust-marked-articles): Use new variable. - (gnus-article-mark-to-type): New function. - (gnus-update-missing-marks): Only update marks of type 'list. - - * gnus.el (gnus-article-special-mark-lists): New variable. - -2001-08-21 12:00:00 ShengHuo ZHU - - * gnus-sum.el (gnus-summary-limit-children): Check 'all. - (gnus-select-newsgroup): Still use 'all. - (gnus-summary-initial-limit): Comparing with 'all. - -2001-08-20 16:00:00 ShengHuo ZHU - - * gnus-start.el (gnus-activate-group): If dont-check, don't update - active. - -2001-08-20 15:00:00 ShengHuo ZHU - - * nnslashdot.el (nnslashdot-retrieve-headers-1): Replace - nnslashdot-*-retrieve-headers. - (nnslashdot-request-article): Fix for slashcode 2.2. - (nnslashdot-make-tuple): New function. - (nnslashdot-read-groups): Use it. - -2001-08-20 01:34:03 Lars Magne Ingebrigtsen - - * gnus.el (gnus-expand-group-parameters): Don't alter the variable - list. - - * gnus-sum.el (gnus-summary-move-article): Don't select article. - -2001-08-20 Simon Josefsson - - * gnus-msg.el (gnus-inews-do-gcc): If archive server can't be - opened, error instead of continuing (and exploding later). - -2001-08-20 01:34:03 Lars Magne Ingebrigtsen - - * gnus.el (gnus-expand-group-parameters): Return the parameter - list. - - * gnus-sum.el (gnus-summary-show-article): Doc fix. - (gnus-summary-show-article): Guess at charset if required. - - * gnus-spec.el (gnus-correct-substring): Stopped one character - before we wanted. - -2001-08-19 Pavel Jan,Am(Bk - - * earcon.el (earcon-auto-play): Remove unused option. - -2001-08-19 16:14:41 Lars Magne Ingebrigtsen - - * gnus-score.el (gnus-score-headers): Move the "Scoring..." - message down in levels, since it happens very fast. - - * smiley-ems.el (smiley-update-cache): Respect the symbol version - of smiley-regexp-alist. - - * mm-view.el (mm-inline-text): Ignore vcard errors. - - * gnus-art.el (gnus-ignored-headers): Added more junk headers. - - * gnus-score.el (gnus-all-score-files): Use append instead of - nconc. - - * gnus.el (gnus-splash-face): Doc fix. - - * mm-decode.el (mm-mailcap-command): Use - mm-path-name-rewrite-functions. - (mm-path-name-rewrite-functions): New variable. - - * gnus-spec.el (gnus-parse-complex-format): React to ?=. - (gnus-complex-form-to-spec): Insert tab. - (gnus-spec-tab): New function. - - * gnus-sum.el (gnus-select-newsgroup): Set the marks before - entering the group. - - * gnus-spec.el (gnus-complex-form-to-spec): Insert Lisp to match - the positional spec. - (gnus-parse-complex-format): React to %C. - - * gnus-ems.el (gnus-char-width): Moved here. - - * gnus-sum.el (gnus-select-newsgroup): Set - gnus-newsgroup-articles. - (gnus-unseen-mark): New variable. - (gnus-newsgroup-unseen): Ditto. - (gnus-newsgroup-seen): Ditto. - (gnus-adjust-marked-articles): Use them. - (gnus-update-marks): Use them. - (gnus-summary-update-secondary-mark): Display. - (gnus-summary-prepare-threads): Display. - - * gnus-msg.el (gnus-inews-group-method): Use and return the - method, not the server. - -2001-08-19 Simon Josefsson - - * gnus-srvr.el (gnus-server-agent-face): New. - (gnus-server-agent-face): New. - (gnus-server-mode): Turn on font-lock-mode. - - * gnus.el (gnus-server-visual): Add defgroup. - -2001-08-19 Joe Casadonte - - * gnus-srvr.el (gnus-server-opened-face, gnus-server-closed-face, - gnus-server-denied-face): New. - (gnus-server-opened-face, gnus-server-closed-face, - gnus-server-denied-face): New. - (gnus-server-font-lock-keywords): Add. - -2001-08-19 Simon Josefsson - - * nnml.el (nnml-request-set-mark): Return nil. - (nnml-save-marks): Use nnml-possibly-create-directory. - (nnml-open-marks): Only work in temp buffer when inserting/reading - .marks file. - -2001-08-18 19:00:00 ShengHuo ZHU - - * gnus.el (gnus-expand-group-parameters): Fix. - - * gnus-spec.el (gnus-char-width): New function. - (gnus-correct-substring, gnus-correct-length): Use it. - - * message.el (message-required-mail-headers): Fix doc. - -2001-08-18 18:00:00 ShengHuo ZHU - - * gnus-sum.el (gnus-group-make-articles-read): gnus-request-set-mark. - - * mm-decode.el (mm-save-part-to-file): Insert the handle. - -2001-08-18 13:00:00 ShengHuo ZHU - - * nnslashdot.el (nnslashdot-threaded-retrieve-headers): - slashdot 2.2 (not fully fixed yet). - (nnslashdot-request-article): Ditto. - -2001-08-18 Simon Josefsson - - * gnus-util.el (gnus-remassoc, gnus-update-alist-soft): Moved from - nnimap. - - * nnimap.el (nnimap-remassoc, nnimap-update-alist-soft): Moved to - gnus-util. - (nnimap-request-update-info-internal): Use new functions. - - * nnml.el (nnml-request-set-mark, nnml-request-update-info): Use - new functions. - -2001-08-18 Simon Josefsson - - Make nnml groups self-contained as far as marks are concerned. - - * nnml.el (nnml-request-delete-group): Delete marks file. - (nnml-request-rename-group): Move marks file. - (nnml-marks-file-name, nnml-marks-is-evil, nnml-marks): New server - variables. - (nnml-request-set-mark, nnml-request-update-info): New server - functions. - (nnml-save-marks, nnml-open-marks): New functions. - -2001-08-18 Simon Josefsson - - * gnus-sum.el (gnus-summary-move-article): Use `add' instead of - `set' when setting marks. - -2001-08-17 22:00:00 ShengHuo ZHU - - * gnus.el (gnus-info-find-node): Take an argument. - - * gnus-art.el (gnus-button-handle-info): New function. - (gnus-url-unhex-string): Replace "+" with " ". - -2001-08-17 21:00:00 ShengHuo ZHU - - * message.el (message-check-news-header-syntax): Check bad From. - -2001-08-18 00:14:45 Lars Magne Ingebrigtsen - - * gnus-spec.el (gnus-correct-length): New function. - (gnus-correct-substring): New function. - (gnus-tilde-max-form): Use it. - -2001-08-17 Nevin Kapur - - * nnmh.el: Docstring changes as below. - - * nnml.el: Docstring changes as below. - - * nnbabyl.el: Docstring changes as below. - - * nnmbox.el: Docstring changes as below. - - * nnfolder.el: Added docstrings identifying each virtual server - parameter. - -2001-08-18 Simon Josefsson - - * mml.el (mml-menu): Collapse Attach, Insert and Security submenu. - -2001-08-17 Bj,Av(Brn Torkelsson - - * message.el: rename "Abort Message" to "Postpone Message". - Remove "Attach file as MIME" from Message menu, it's already in - the MIME menu. - -2001-08-17 14:00:00 ShengHuo ZHU - - * smime.el (smime-point-at-eol): eval-and-compile. - (smime-make-temp-file): New function. - (smime-sign-region, smime-encrypt-region, smime-decrypt-region): - Use it. - -2001-08-17 10:41:14 Lars Magne Ingebrigtsen - - * gnus-agent.el (gnus-agent-fetch-group): Go online if offline. - (gnus-agent-summary-fetch-group): New command and keystroke. - - * gnus-art.el (gnus-insert-mime-button): Tiny clean-up. - (gnus-mime-display-security): Make it respect - gnus-unbuttonized-mime-type-p. - - * gnus-sum.el (gnus-articles-to-read): Comments. - (gnus-article-marked-p): New function. - (gnus-summary-display-make-predicate): New function. - (gnus-select-newsgroup): Use them. - - * mm-decode.el (mm-save-part-to-file): Made it not error. - -2001-08-17 Simon Josefsson - - * imap.el (imap-wait-for-tag): If process-status isn't open or - run, return nil instead of sit-for looping. - -2001-08-17 10:41:14 Lars Magne Ingebrigtsen - - * lpath.el (featurep): fbind xml-parse-region. - - * gnus.el (gnus-message-archive-method): Default to "archive". - (gnus-message-archive-method): Doc fix. - (gnus-parameters-get-parameter): Cleaned up. - (gnus-expand-group-parameter): New function. - - * gnus-start.el (gnus-setup-news): Push the archive server only - the server list. - - * mml.el (mml-menu): Changed name to "Attachments". - - * mm-decode.el (mm-destroy-postponed-undisplay-list): Only message - when there is something to detroy. - -2001-05-21 17:11:46 Lars Magne Ingebrigtsen - - * gnus-srvr.el (gnus-server-browse-in-group-buffer): Default to - nil. - -2001-08-15 Kai Gro,b_(Bjohann - - * gnus-delay.el (gnus-delay-article): Allow "01:23" time spec, - which specifies a time today or tomorrow. - -2001-08-15 Pavel Jan,Am(Bk - - * gnus-agent.el (gnus-agent-make-mode-line-string) - (gnus-agent-toggle-plugged): Use new API. - -2001-08-14 Kai Gro,b_(Bjohann - - * gnus-delay.el (gnus-delay-send-drafts): Fix check whether - deadline has expired. - -2001-08-12 Simon Josefsson - Suggested by Kai.Grossjohann@CS.Uni-Dortmund.DE - - Support `recent' mark indicating newly arrived messages (to - separate from old but unread messages). - - * nnimap.el (nnimap-retrieve-groups): Push dummy article into - `nnmail-split-history' if recent is > 0. - (nnimap-request-update-info-internal): Update `recent' marks. - (nnimap-request-set-mark): Never set `recent' marks. - (nnimap-mark-to-predicate-alist, nnimap-mark-to-flag-alist): Add - recent. - - * gnus-sum.el (gnus-recent-mark): New mark. - (gnus-newsgroup-recent): New variable. - (gnus-summary-local-variables): Add gnus-newsgroup-recent. - (gnus-summary-prepare-threads): Mark recent articles. - (gnus-summary-add-mark): Support recent. - (gnus-summary-update-secondary-mark): Support recent. - - * gnus.el (gnus-article-mark-lists): Add recent. - -2001-08-12 Simon Josefsson - - * mm-bodies.el (mm-decode-content-transfer-encoding): Returns - whether successful decoding took place. Add doc. - -2001-08-12 Simon Josefsson - Suggested by Per Abrahamsen - - * gnus.el (gnus-summary-line-format, gnus-parameters): - * gnus-gl.el (gnus-summary-grouplens-line-format): - * gnus-salt.el (gnus-summary-pick-line-format): - * gnus-spec.el (gnus-format-specs): %n is 23 chars. - -2001-08-11 09:40:00 Karl Kleinpaste - - * gnus-score.el (gnus-score-string): Fix `match' regexp - for `extra' header case. - -2001-08-10 23:00:00 ShengHuo ZHU - - * nnmbox.el (nnmbox-read-mbox): No warning. - -2001-08-10 21:00:00 ShengHuo ZHU - - * nndoc.el (nndoc-article-type): Fix doc. - (nndoc-generate-article-function): New variable. - (nndoc-dissection-function): New variable. - (nndoc-type-alist): Add oe-dbx. - (nndoc-oe-dbx-type-p): New function. - (nndoc-oe-dbx-dissection): New function. - (nndoc-oe-dbx-generate-article): New function. - -2001-08-11 Kai Gro,b_(Bjohann - - * gnus-delay.el (gnus-delay-send-drafts): Cleaner way to check - whether deadline has been reached. Patch from Dan Nicolaescu - . - -2001-08-10 02:00:00 ShengHuo ZHU - - * gnus-ml.el (turn-on-gnus-mailing-list-mode): Use - gnus-group-find-parameter. Suggested by Janne Rinta-Manty - . - - * mail-source.el (mail-source-movemail): The error buffer is - modified, but nothing in it. - -2001-08-10 01:00:00 ShengHuo ZHU - - * message.el (message-bogus-system-names): New variable. - (message-make-fqdn): Use it. - -2001-08-09 15:00:00 ShengHuo ZHU - - * nndraft.el (nndraft-request-group): Use - nndraft-auto-save-file-name. - -2001-08-09 Simon Josefsson - - * mm-view.el (mm-view-pkcs7-decrypt): Operate in current buffer. - Don't ask whether to decrypt. Just leave result in buffer (don't - call mm). - - * mm-decode.el (mm-dissect-buffer): Possibly verify/decrypt single - parts as well. - (mm-inline-media-tests): Ignore application/{x-,}pkcs7-mime. - (mm-possibly-verify-or-decrypt): Support application/{x-,}pkcs7-mime. - -2001-08-09 Simon Josefsson - - * mm-decode.el (mm-insert-part): Return decoding success status. - (mm-save-part-to-file): Error if decoding failed. - -2001-08-09 10:00:00 ShengHuo ZHU - - * message.el (message-tab): Use indent-relative. - (message-mode): Don't bind indent-line-function to indent-relative. - -2001-08-09 Simon Josefsson - - * message.el (message-get-reply-headers): Fix string. Suggested by - Christoph Conrad . - -2001-08-08 15:00:00 ShengHuo ZHU - - * message.el (message-tab): Use the current value of - indent-line-function. - (message-mode): Bind indent-line-function to indent-relative. - -2001-08-08 Simon Josefsson - - * imap.el (imap-gssapi-auth-p, imap-kerberos4-auth-p): Also check - whether `imtest' is installed. - -2001-08-04 Nuutti Kotivuori - - * gnus-sum.el (gnus-summary-show-article): Call - gnus-summary-update-secondary-secondary-mark. - * gnus-sum.el (gnus-summary-edit-article-done): Ditto. - * gnus-sum.el (gnus-summary-reparent-thread): Ditto. - -2001-08-07 16:00:00 Gerd M,Av(Bllmann - - * mm-uu.el (mm-uu-dissect): Autoload. - -2001-08-07 16:00:00 ShengHuo ZHU - - * gnus-sum.el (gnus-summary-make-menu-bar): Misc -> Gnus. - - * gnus-group.el (gnus-group-make-menu-bar): Ditto. - - * gnus-art.el (gnus-output-to-file): Bind file-name-coding-system. - - * gnus-util.el (gnus-output-to-rmail): Ditto. - (gnus-output-to-mail): Ditto. - - * nnmail.el (nnmail-pathname-coding-system): Set default to nil. - -2001-08-06 Florian Weimer - - * message.el (message-indent-citation): Use - `message-yank-cited-prefix' for empty lines. - -2001-08-05 Florian Weimer - - * message.el (message-indent-citation): Quote only lines starting - with ">" using `message-yank-cited-prefix'. - -2001-08-05 Nuutti Kotivuori - Trivial patch. - - * gnus-cache.el (gnus-cache-possibly-enter-article): Use - gnus-cache-fully-p. - -2001-08-04 Simon Josefsson - - * gnus-cache.el (gnus-cache-possibly-update-active): Create active - file if it doesn't exist (by calling gnus-cache-read-active). - -2001-08-04 Simon Josefsson - - * gnus-cache.el (gnus-cache-possibly-enter-article): Revert. - (gnus-cache-passively-or-fully-p): Removed. - (gnus-cache-fully-p): Fix it. - - * mm-view.el (mm-pkcs7-signed-magic): Support more ASN.1 lengths. - -2001-08-04 Simon Josefsson - - * gnus-cache.el (gnus-cache-fully-p) - (gnus-cache-passively-or-fully-p): New functions. - (gnus-cache-possibly-enter-article): Cosmetic change, use - `g-c-p-o-f-p'. - (gnus-cache-possibly-enter-article): Use `g-c-p-u-a'; last change - was bogus (`g-c-p-a-a' does not change active info, just change - the functions parameters). - (gnus-cache-possibly-remove-articles-1): Make sure articles are - not removed in groups that match `gnus-uncacheable-groups'. - - Reported and modifications based on discussions with Nuutti - Kotivuori . - -2001-08-04 Simon Josefsson - Trivial patch from Nuutti Kotivuori - - * gnus-cache.el (gnus-cache-possibly-update-active): New function; - calls `gnus-cache-update-active' if bounds has been extended. - -2001-08-04 10:00:00 ShengHuo ZHU - - * gnus-art.el (gnus-mime-security-verify-or-decrypt): Insert - before remove. - (gnus-mime-security-show-details): Ditto. - -2001-08-04 Kai Gro,b_(Bjohann - - * nnmail.el (nnmail-split-fancy-with-parent): Correct `mapconcat' - syntax. Protect string-match against nil string and regexp. - -2001-08-03 19:00:00 ShengHuo ZHU - - * mm-util.el (mm-find-charset-region): Remove control-1. - -2001-08-03 17:00:00 ShengHuo ZHU - - * mm-decode.el (mm-readable-p): Emacs 20 takes one argument. - -2001-08-04 Simon Josefsson - - * smime.el (smime-sign-region, smime-encrypt-region): Fix details - buffer. Delete MIME-Version header. - -2001-08-03 Simon Josefsson - - * gnus-cache.el (gnus-cache-possibly-enter-article): The article - that is entered does not necessarily have the highest article - number in the group, so use `gnus-cache-possibly-alter-active' - instead of `gnus-cache-update-active'. - -2001-08-03 10:00:00 ShengHuo ZHU - - * mml2015.el (mml2015-gpg-extract-signature-details): Don't barf. - -2001-08-03 Simon Josefsson - - * mml.el (mml-menu): Rename from MML to Mime. Collapse Security - menu. - -2001-08-02 Katsumi Yamaoka - - * gnus.el (post-method): New group parameter. It also provides - the user option `gnus-post-method-alist' and the internal function - `gnus-parameter-post-method'. - - * gnus-msg.el (gnus-post-method): Bind the value of - `gnus-post-method' to the group parameter if it is defined. - -2001-08-02 Simon Josefsson - - * smime.el (smime-extra-arguments): Removed. - (smime-call-openssl-region): Don't use it. - -2001-08-02 Simon Josefsson - - * smime.el (smime-sign-region): Handle stderr. - (smime-encrypt-region): Ditto. - - * mm-view.el (mm-pkcs7-signed-magic): Make it a regexp. Don't - match the ASN.1 length bytes. - (mm-pkcs7-enveloped-magic): Ditto. - (mm-view-pkcs7-get-type): Don't regexp quote. - -2001-08-01 14:00:00 Andreas Fuchs - - * mml2015.el (mml2015-trust-boundaries-alist): Typo. - -2001-08-01 10:00:00 ShengHuo ZHU - - * gnus-art.el (gnus-header-button-alist): References regexp. - -2001-08-01 Gerd Moellmann - - * mm-view.el (autoload): Don't autoload `diff-mode' if it's - already fboundp. Add INTERACTIVE arg to autoload form. - -2001-08-01 09:00:00 ShengHuo ZHU - - * nnslashdot.el (nnslashdot-init): Add as gnus buffer. - - * nnmail.el (nnmail-cache-open): Ditto. - -2001-07-31 21:00:00 ShengHuo ZHU - - * gnus-art.el (gnus-button-fetch-group): Fix the regexp. - -2001-07-31 Katsumi Yamaoka - - * gnus-msg.el (gnus-post-method): Refer to `gnus-parameters'. - -2001-07-31 17:00:00 ShengHuo ZHU - Originally from Pavel Jan,Am(Bk - - * gnus-agent.el (gnus-agent-make-mode-line-string): New function. - (gnus-agent-toggle-plugged): Use it. - -2001-07-31 ShengHuo ZHU - - * gnus-start.el (gnus-startup-file-coding-system): Revert to binary. - (gnus-ding-file-coding-system): New variable. - (gnus-read-newsrc-el-file, gnus-save-newsrc-file) - (gnus-slave-save-newsrc): Use it. - -2001-07-31 Kai Gro,b_(Bjohann - - * gnus-delay.el (gnus-delay-initialize): Use standard define-key - syntax. - -2001-07-30 15:00:00 ShengHuo ZHU - Originally from Andreas Fuchs - - * mml2015.el (mml2015-trust-boundaries-alist): New variable. - (mml2015-gpg-pretty-print-fpr): New function. - (mml2015-gpg-extract-signature-details): More details, rename from - `m-g-e-from'. - (mml2015-gpg-verify): Use them. - (mml2015-gpg-clear-verify): Use them. - -2001-07-31 Simon Josefsson - - * mml-smime.el (mml-smime-sign, mml-smime-encrypt): Goto end of - buffer when done. - -2001-07-30 Simon Josefsson - - * smime.el (smime-call-openssl-region): Revert previous change, - just pass on buf to `call-process-region'. - (smime-verify-region): Doc fix. Don't message stuff. Use - `smime-new-details-buffer'. Inserts error messages into buffer. - (smime-noverify-region): Ditto. - (smime-decrypt-region): Ditto. Handles stderr separately. - (smime-verify-buffer, smime-noverify-buffer) - (smime-decrypt-buffer): Doc fix. - (smime-new-details-buffer): New function. - (smime-pkcs7-region, smime-pkcs7-certificates-region) - (smime-pkcs7-email-region): Use `smime-new-details-buffer'. - (smime-sign-region, smime-encrypt-region): Don't use - `insert-buffer'. - - * mml-smime.el (mml-smime-verify): Fix security button strings. - -2001-07-30 12:00:00 ShengHuo ZHU - - * gnus-art.el (gnus-mime-save-part-and-strip): Save - gnus-article-mime-handles. - -2001-07-29 Simon Josefsson - - * mail-source.el (top-level): Require message for message-directory. - (mail-source-directory): Change default to message-directory. - - * smime.el (smime-keys, smime-CA-directory, smime-CA-file) - (smime-certificate-directory, smime-openssl-program) - (smime-encrypt-cipher, smime-dns-server): Fix doc (leading "*"). - (smime-extra-arguments): New variable. - (smime-dns-server): Fix customize group. - (smime-call-openssl-region): Use `smime-extra-arguments'. - -2001-07-29 Vladimir Volovich - - * smime.el (smime-call-openssl-region): Ignore stderr. - -2001-07-29 Christoph Conrad - - * gnus-agent.el (gnus-agent-save-group-info): Don't destroy active - file. - -2001-07-29 Simon Josefsson - - * mm-view.el (mm-view-pkcs7-decrypt): Adhere to `mm-decrypt-option'. - - Support S/MIME decryption. - - * mm-decode.el (mm-inline-media-tests): - (mm-inlined-types): - (mm-automatic-display): - (mm-attachment-override-types): Add application/{x-,}pkcs7-mime. - - * mm-view.el (mm-pkcs7-signed-magic): - (mm-pkcs7-enveloped-magic): New variables. - (mm-view-pkcs7-get-type): New function; identify PKCS#7 type. - (mm-view-pkcs7): New function; mm viewer for PKCS#7 blobs. - (mm-view-pkcs7-decrypt): New function; mm viewer for encrypted - PKCS#7 blobs. - - * smime.el (smime-decrypt-region): Expand keyfile. - -2001-07-29 Simon Josefsson - - * nntp.el (nntp-open-ssl-stream): Don't mess with internal - `ssl.el' variables. - - * gnus-agent.el (gnus-agent-save-group-info): Delete everything - but line instead of narrowing to it, because `nnmail-parse-active' - calls widen. Thanks to Christoph Conrad - . - -2001-07-29 Kai Gro,b_(Bjohann - - * gnus.el (gnus-summary-line-format): Mention `gnus-sum-thread-*' - for %B spec. - - * gnus-sum.el (gnus-summary-prepare-threads): If - gnus-sum-thread-tree-root is nil, use subject instead. - (gnus-sum-thread-tree-root, gnus-sum-thread-tree-single-indent) - (gnus-sum-thread-tree-vertical, gnus-sum-thread-tree-indent) - (gnus-sum-thread-tree-leaf-with-other) - (gnus-sum-thread-tree-single-leaf): Documentation. - (gnus-sum-thread-tree-single-indent): Allow nil. - -2001-07-28 09:00:00 ShengHuo ZHU - - * message.el (message-fill-paragraph): Do nothing if the user - wants filladapt-mode. - -2001-07-27 23:00:00 ShengHuo ZHU - - * mm-decode.el (mm-image-type-from-buffer): New function. - (mm-get-image): Use it. - -2001-07-27 18:00:00 ShengHuo ZHU - - * gnus.el (gnus-large-newsgroup): Add doc, "If it is nil, ..." - - * gnus-art.el (gnus-mime-view-all-parts): buffer-read-only covers - mm-display-parts too. - -2001-07-27 12:00:00 ShengHuo ZHU - - * nnfolder.el (nnfolder-request-accept-article): Bind - nntp-server-buffer. - - * nnmail.el (nnmail-parse-active): Read from buffer instead of - nntp-server-buffer. - -2001-07-27 11:00:00 ShengHuo ZHU - - * message.el (message-check-news-header-syntax): Use - message-post-method. - (message-send-news): Bind message-post-method. - -2001-07-27 07:00:00 ShengHuo ZHU - - * mml.el (mml-tweak-type-alist): New variable. - (mml-tweak-function-alist): New variable. - (mml-tweak-part): New function. - (mml-generate-mime-1): Use it. - -2001-07-26 22:00:00 ShengHuo ZHU - - * nnfolder.el (nnfolder-request-accept-article): Replace - nnfolder-request-list. - -2001-07-27 Simon Josefsson - - * nnimap.el (nnimap-open-server): Set nnimap-server-buffer if - nnoo-change-server failed to do it. - -2001-07-26 16:00:00 ShengHuo ZHU - - * gnus.el (gnus-parameters): Make it customizable. - -2001-07-26 15:00:00 ShengHuo ZHU - - * gnus-art.el (gnus-mm-display-part): Narrow to point if eobp. - - * message.el (message-set-auto-save-file-name): More - poor-system-types. - - * mailcap.el (mailcap-parse-mimetypes): poor-system-types. - - * gnus-ems.el (nnheader-file-name-translation-alist): M$Windows-NT - supports +. - -2001-07-26 14:00:00 ShengHuo ZHU - - * mm-decode.el (mm-readable-p): New function. - (mm-inline-media-tests): Fix the default testers. - -2001-07-26 Simon Josefsson - - * nnimap.el (nnimap-version): Bump version number. - -2001-07-26 10:00:00 Steven E. Harris - - * nnheader.el (nnheader-translate-file-chars): cygwin32 is running - in M$Windows too. - -2001-07-26 Kai Gro,b_(Bjohann - - * gnus-delay.el (gnus-delay-send-drafts): Don't `error'. - -2001-07-25 21:00:00 ShengHuo ZHU - - * gnus-bcklg.el (gnus-backlog-shutdown): Make interactive. - - * mm-decode.el (mm-get-image): Guess then use the type. - - * gnus-art.el (gnus-mime-view-part-as-type): Don't copy cache. - -2001-07-25 12:54:00 Danny Siu - - * gnus-sum.el (gnus-summary-prepare-threads): Shouldn't do tree - display (%B) for threads if threading is off. - -2001-07-25 14:00:00 Henrik Enberg - - * gnus-msg.el: Customization patch. - -2001-07-25 22:22:22 Raymond Scholz - - * nnmail.el (nnmail-split-fancy-with-parent-ignore-groups): New - variable. - (nnmail-split-fancy-with-parent): Ignore certain groups. - -2001-07-25 11:00:00 ShengHuo ZHU - - * gnus-util.el (gnus-byte-compile): New function. - (gnus-use-byte-compile): New variable. - (gnus-make-sort-function): Use it. - - * nnmail.el (nnmail-get-new-mail): Use it. - - * gnus-agent.el (gnus-category-make-function): Simple function or - compiled function. - (gnus-agent-fetch-group-1): Don't use (caaddr predicate). - - * gnus-gl.el (bbb-build-rate-command): Remove quote before lambda. - * gnus-topic.el (gnus-topic-sort-topics-1): Ditto. - (gnus-topic-sort-topics-1): Use gnus-byte-compile. - - * message.el (message-check-news-header-syntax): Remove quote. - -2001-07-24 19:00:00 ShengHuo ZHU - - * message.el (message-use-mail-followup-to): `t' is not a - documented value. - -2001-07-24 13:00:00 ShengHuo ZHU - - * gnus-sum.el (gnus-summary-display-arrow): Test fboundp. - -2001-07-24 12:00:00 ShengHuo ZHU - - * mm-encode.el (mm-encode-buffer): Don't use 7bit encoding if - there are long lines. - -2001-07-24 Katsumi Yamaoka - - * dgnushack.el (copy-list): New compiler macro. - -2001-07-24 09:00:00 ShengHuo ZHU - - * message.el (message-bounce): If no Return-Path, the whole - content is considered as the original message. - - * nnml.el (nnml-check-directory-twice): New variable. - (nnml-article-to-file): Use it. - (nnml-retrieve-headers): Hack it. - -2001-07-24 02:00:00 ShengHuo ZHU - - * gnus-win.el (gnus-buffer-configuration): New configure. - - * gnus-art.el (gnus-mm-display-part): Don't select-window if it is - not alive. - - * mm-decode.el (mm-remove-part): Don't murder the current window (nil). - (mm-display-external): Use display-term configure. - -2001-07-24 Kai Gro,b_(Bjohann - - * gnus-delay.el (gnus-delay-default-hour): New variable. - (gnus-delay-article): Allow specific date in YYYY-MM-DD format. - -2001-07-23 22:00:00 Karl Kleinpaste - - * gnus-sum.el (gnus-summary-line-format-alist): Add %B. - (gnus-summary-prepare-threads): Ditto. - - * gnus.el (gnus-summary-line-format): Add %B. - -2001-07-23 19:00:00 ShengHuo ZHU - - * gnus-sum.el (gnus-articles-to-read): Use gnus-group-decoded-name. - - * mm-util.el (mm-string-as-multibyte): New function. - - * nnmh.el (nnmh-request-list-1): Encode, not decode! - -2001-07-23 18:00:00 ShengHuo ZHU - - * mm-util.el (mm-universal-coding-system): New variable. - - * gnus-start.el (gnus-startup-file-coding-system): Use it. - - * score-mode.el (score-mode-coding-system): Use it. - -2001-07-23 Katsumi Yamaoka - - * gnus-start.el (gnus-setup-news): Call - `gnus-check-bogus-newsgroups' just after the native server is - opened. - -2001-07-23 Kai Gro,b_(Bjohann - - * nnmail.el (nnmail-do-request-post): Util function to be used by - `nnchoke-request-post' for all nnmail-derived backends. - - * nnml.el (nnml-request-post): Use it. - - * gnus.el (gnus-valid-select-methods): nnml is a post-mail - backend, for it groks nnml-request-post. - - * gnus-group.el (gnus-group-highlight, gnus-group-highlight-line): - Treat `mail-post' backends like `mail' backends, not like `news' - backends. - -2001-07-22 09:00:00 ShengHuo ZHU - - * gnus-msg.el (gnus-setup-message): make-local-hook. - -2001-07-22 Kai Gro,b_(Bjohann - - * gnus-delay.el (gnus-delay-article): Fix `read-string' for - XEmacs. Allow more units. Submitted by Karl Kleinpaste - , slightly changed by Kai. - - * message.el (message-check-news-header-syntax): When checking - whether the groups exist, check the right server based on - `gnus-post-method'. - -2001-07-21 Kai Gro,b_(Bjohann - - * gnus-delay.el: New file. - -2001-07-21 13:00:00 ShengHuo ZHU - - * mm-util.el (mm-read-coding-system): Take two arguments. - - * gnus-sum.el (gnus-summary-show-article): Use - mm-read-coding-system. - - * gnus-art.el (article-de-quoted-unreadable): - (article-de-base64-unreadable, article-wash-html): - (gnus-mime-inline-part, gnus-mime-view-part-as-charset): Ditto. - -2001-07-21 Kai Gro,b_(Bjohann - - * nnml.el (nnml-request-post): New function. Can be used for - annotations in nnml groups. - -2001-07-19 Katsumi Yamaoka - - * nntp.el (nntp-request-newgroups): Use UTC date for NEWGROUPS - command. - - * gnus-start.el (gnus-find-new-newsgroups): Use - `message-make-date' instead of `current-time-string'. - (gnus-ask-server-for-new-groups): Ditto. - (gnus-check-first-time-used): Ditto. - -2001-07-20 11:00:00 ShengHuo ZHU - - * gnus-score.el (gnus-home-score-file): nnheader-translate-file-chars. - -2001-07-18 Per Abrahamsen - - * message.el (message-shorten-references): Change `maxcount' and - `cut' to obey USEFOR draft 5. - -2001-07-12 Colin Walters - - * gnus-sum.el (gnus-summary-display-arrow): New variable. - (gnus-summary-set-article-display-arrow): New function. - (gnus-summary-goto-subject): Use it. - -2001-07-18 12:00:00 ShengHuo ZHU - - * gnus-sum.el (gnus-summary-import-article): Insert date if - doesn't exist. - -2001-07-18 11:00:00 ShengHuo ZHU - - * mml.el (mml-content-type-parameters): New variable. - (mml-content-disposition-parameters): New variable. - (mml-insert-mime-headers): Use them. - (mml-parse-1): Accept charset. - -2001-07-17 22:00:00 ShengHuo ZHU - - * gnus-group.el (gnus-group-select-group): Doc fix. - - * gnus-eform.el (gnus-edit-form-done): Return nil if end-of-file. - -2001-07-17 Katsumi Yamaoka - - * dgnushack.el (dgnushack-make-auto-load): Advise `make-autoload' - to handle `define-derived-mode'. - -2001-07-16 12:00:00 ShengHuo ZHU - From: Stefan Monnier - - * message.el (message-mode): Use define-derived-mode. - (message-tab): message-completion-alist. - - * imap.el (imap-interactive-login): Use make-local-variable. - (imap-open): Ditto. - (imap-authenticate): Ditto. - - * gnus-msg.el (gnus-setup-message): Change-major-mode-hook. - - * gnus-art.el (gnus-article-edit-mode): Use define-derived-mode. - -2001-07-16 Kai Gro,b_(Bjohann - - * message.el (message-citation-line-function): Refer to - gnus-cite-attribution-suffix. - -2001-07-15 Pavel Jan,Am(Bk - - * gnus-art.el,...: Error convention changes. - -2001-07-13 20:00:00 ShengHuo ZHU - - * gnus-sum.el (gnus-rebuild-thread): Count hidden lines too. - -2001-07-13 20:00:00 ShengHuo ZHU - - * nnrss.el (nnrss-read-group-data): Nuke emacs-lisp-mode-hook. - (nnrss-read-server-data): Ditto. - -2001-07-13 12:00:00 Pavel Jan,Am(Bk - - * gnus-setup.el (gnus-use-installed-gnus): Typo. - * Cleanup files. - - -2001-07-13 08:00:00 ShengHuo ZHU - - * gnus.el (gnus-summary-line-format): Add %o. - - * gnus-sum.el (gnus-summary-pipe-output): Don't configure as pipe - unless shell outputs something. - -2001-07-13 07:00:00 ShengHuo ZHU - - * gnus-art.el (gnus-boring-article-headers): Better doc. - (article-hide-headers): Better regexp. - Suggested by Matt Swift . - - * nnheader.el (nnheader-max-head-length): Better doc. - (nnheader-header-value): Skip spaces. - (nnheader-parse-head): Remove space. - Suggested by Matt Swift . - - * gnus-sum.el (gnus-summary-show-raw-article): New function. - (gnus-get-newsgroup-headers): Remove space. - -2001-07-12 23:00:00 ShengHuo ZHU - - * gnus-msg.el (gnus-msg-treat-broken-reply-to): Add force. - (gnus-summary-reply): Use it. - (gnus-summary-reply-broken-reply-to): New function. - (gnus-msg-force-broken-reply-to): New function. - - * mm-view.el (mm-inline-text): Showing as text/plain when error. - -2001-07-12 21:00:00 ShengHuo ZHU - - * gnus-draft.el (gnus-draft-setup): Restore gnus-newsgroup-name. - -2001-07-12 15:00:00 ShengHuo ZHU - - * mm-decode.el (mm-external-terminal-program): New variable. - (mm-display-external): Use it. Use term to display when no - window-system. - -2001-07-12 Bj,Av(Brn Torkelsson - - * gnus-srvr.el (gnus-browse-make-menu-bar): Changed one of the - Browse->Next entries to Browse->Prev - -2001-07-11 22:00:00 ShengHuo ZHU - - * gnus-msg.el (gnus-inews-do-gcc): Don't test gnus-alive-p. - -2001-07-11 18:00:00 ShengHuo ZHU - - * mm-encode.el (mm-content-transfer-encoding-defaults): Use base64 - for the default encoding. - - * nnrss.el (nnrss-url-field): New field. - (nnrss-request-article): Add newsgroups. - - * nnfolder.el (nnfolder-read-folder): Force to use a multibyte buffer. - -2001-07-11 04:00:00 ShengHuo ZHU - - * nndraft.el (nndraft-request-restore-buffer): Don't remove Date. - - * gnus-draft.el (gnus-draft-edit-message): Remove Date here. - (gnus-draft-setup): Remove backlog. - -2001-07-10 Pavel Jan,Am(Bk - - * gnus-logic.el, gnus-srvr.el, gnus-vm.el, nnheaderxm.el, nnoo.el: - Cleanup. - -2001-07-09 23:00:00 ShengHuo ZHU - - * gnus-msg.el (gnus-bug): Erase buffer. - - * nnfolder.el (nnfolder-possibly-change-group): Don't create group. - -2001-07-09 19:00:00 ShengHuo ZHU - - * mm-decode.el (mm-attachment-override-p): Fix typo. - -2001-03-19 05:28:00 Katsumi Yamaoka - - * gnus-kill.el (gnus-execute): Work with the extra headers. - * gnus-sum.el (gnus-summary-execute-command): Ditto. - -2001-07-09 17:00:00 ShengHuo ZHU - - * mm-view.el (mm-inline-text): w3-coding-system-for-mime-charset - may not defined. From: Raja R Harinath . - - * message.el (message-send-mail-real-function): New variable. - (message-send-mail-partially, message-send-mail): - - * nngateway.el (nngateway-request-post): Use it. - - * gnus-agent.el (gnus-agentize): Use it. - - * nnsoup.el (nnsoup-old-functions, nnsoup-set-variables) - (nnsoup-revert-variables): Use it. - -2001-07-09 Colin Walters - - * mm-decode.el (mm-inline-media-tests): Default to displaying as - text/plain if the type doesn't match any other media types. - (mm-inlined-types): Doc fix. - (mm-display-inline): Revert previous change (now handled by a - default type in `mm-inline-media-tests'. - (mm-inlinable-p): Revive. - (mm-display-part): Call `mm-inlinable-p'. - (mm-attachment-override-p): Ditto. - (mm-inlined-p): Doc fix. - - * gnus-art.el (gnus-mime-display-single): Call `mm-inlinable-p' as - well as `mm-inlined-p'. - -2001-07-09 13:00:00 ShengHuo ZHU - - * nntp.el (nntp-send-command, nntp-send-command-nodelete): - (nntp-send-command-and-decode): Use gnus-point-at-bol. - -2001-07-09 13:00:00 Paul Jarc - - * message.el (message-use-mail-followup-to): New variable. - (message-get-reply-headers): Use it. - -2001-07-04 Gerd Moellmann - - * nnheader.el (nnheader-init-server-buffer): Make sure the - *nntpd* buffer is made multibyte instead of a random buffer. - -2001-07-09 12:00:00 ShengHuo ZHU - - * gnus-sum.el (gnus-get-newsgroup-headers-xover): Get headers only - when it returns headers. - -2001-07-07 Simon Josefsson - - * rfc2047.el (rfc2047-encode-message-header): Skip header when - trying to fold. Thanks to Colin Walters - - -2001-07-06 Simon Josefsson - - * imap.el (imap-parse-address-list, imap-parse-flag-list) - (imap-parse-body-extension, imap-parse-body-ext, imap-parse-body): - Add information in `assert's. - - * nnimap.el (nnimap-possibly-change-group): Ignore uidvalidity - changes. (From nnimaps' point of view, `nnimap-verify-uidvalidity' - and `nnimap-group-overview-filename', should handle all - change-of-uidvalidity related issues. But there may be other - problems.) - -2001-07-05 Colin Walters - - * rfc2047.el (rfc2047-encode-message-header): Don't include the - header name when folding. - -2001-07-05 Colin Walters - - * mm-decode.el (mm-inlined-types): Document relationship with - `mm-inline-media-tests'. - (mm-display-inline): Default to displaying as plain text if no - inlining handler is available. - (mm-inlinable-p): Remove. - (mm-inlined-p): Don't call `mm-inlinable-p'. - (mm-automatic-display-p): Ditto. - (mm-attachment-override-p): Ditto. - -2001-07-04 Simon Josefsson - - * nnimap.el (nnimap-importantize-dormant): New variable. - (nnimap-request-update-info-internal): Use it. - (nnimap-request-set-mark): Ditto. - -2001-07-04 Didier Verna - - * nntp.el (nntp-send-command): don't pass a buffer argument to - `point'. Only XEmacs accepts this. - * nntp.el (nntp-send-command-nodelete): ditto. - * nntp.el (nntp-send-command-and-decode): ditto. - -2001-07-04 Didier Verna - - * nntp.el (nntp-open-connection-function): doc update. - * nntp.el (nntp-pre-command): New. - * nntp.el (nntp-via-rlogin-command): New. - * nntp.el (nntp-via-telnet-command): New. - * nntp.el (nntp-via-telnet-switches): New. - * nntp.el (nntp-via-user-name): New. - * nntp.el (nntp-via-user-password): New. - * nntp.el (nntp-via-address): New. - * nntp.el (nntp-via-envuser): New. - * nntp.el (nntp-via-shell-prompt): New. - * nntp.el (nntp-open-telnet-stream): New. - * nntp.el (nntp-open-via-rlogin-and-telnet): New. - * nntp.el (nntp-open-via-telnet-and-telnet): New. - * nntp.el (nntp-wait-for): check for possibly echo'ed commands. - * nntp.el (nntp-send-command): ditto. - * nntp.el (nntp-send-command-nodelete): ditto. - * nntp.el (nntp-send-command-and-decode): ditto. - -2001-06-30 YAGI Tatsuya - Trivial patch. - - * gnus-start.el (gnus-check-first-time-used): Use `if' instead of - `when'. - -2001-07-03 Nuutti Kotivuori - - * flow-fill.el (fill-flowed): Use (1+ (point-at-eol)) instead. - -2001-07-03 Simon Josefsson - - * flow-fill.el (fill-flowed): If `fill-region' inserts empty line, - remove it (workaround XEmacs `fill-region' bug). - -2001-07-01 Simon Josefsson - - * nnimap.el (nnimap-date-days-ago): Defeat locale. - -2001-06-28 11:00:00 ShengHuo ZHU - - * mml2015.el (mml2015-format-error): New function. - (mml2015-mailcrypt-decrypt, mml2015-mailcrypt-clear-decrypt) - (mml2015-mailcrypt-verify, mml2015-gpg-clear-verify) - (mml2015-mailcrypt-clear-verify, mml2015-gpg-verify): Use it. - -2001-06-26 22:00:00 ShengHuo ZHU - - * nnrss.el (nnrss-retrieve-headers): The description may not exist. - Suggested by Christoph Conrad . - - * gnus-sum.el (gnus-summary-set-local-parameters): Don't override - group variables. - -2001-06-25 10:00:00 ShengHuo ZHU - - * nnslashdot.el (nnslashdot-write-groups): Use gnus-prin1. - - * nnrss.el (nnrss-save-server-data): Bind print-level and print-length. - (nnrss-save-group-data): Ditto. - - * gnus-agent.el (gnus-agent-save-alist): Ditto. - -2001-06-25 Katsumi Yamaoka - - * message.el (message-do-send-housekeeping): Narrow to headers. - -2001-06-24 Simon Josefsson - - * rfc2047.el (rfc2047-fold-region): The check to skip WSP - insertion when breaking lines looked for " \t" instead of "[ \t]". - (rfc2047-encode-message-header): Fold lines even if - no QP encoding is done. - -2001-06-23 Samuel Tardieu - - * smime.el (smime-keys): Support additional certificates. - (smime-make-certfiles): New function. - (smime-sign-region): Use previous variables. - (smime-get-certfiles): New function. - (smime-sign-buffer): Use it. - (smime-verify-region): Support both CAfile and CApath. - -2001-06-23 Simon Josefsson - - * smime.el (smime-decrypt-region): Perhaps work. - -2001-06-22 10:00:00 ShengHuo ZHU - - * gnus-msg.el (gnus-copy-article-buffer): Typo. - -2001-04-06 Ralph Schleicher - - * mm-decode.el (mm-save-part): Rewrite file name. - (mm-file-name-rewrite-functions): New variable. - (mm-file-name-delete-whitespace): New function. - (mm-file-name-trim-whitespace): New function. - (mm-file-name-collapse-whitespace): New function. - (mm-file-name-replace-whitespace): New variable and function. - -2001-06-22 Simon Josefsson - - * message.el (message-make-date): Workaround locale for weekdays. - -2001-06-21 17:00:00 ShengHuo ZHU - - * message.el (message-goto-body): Return nil if not found. (revert!) - -2001-06-21 10:00:00 John Fremlin (tiny change) - - * message.el (message-goto-body): Some messages have no header. - - * gnus-msg.el (gnus-copy-article-buffer): Use it. - -2001-06-21 Ralph Schleicher - - * nnultimate.el (nnultimate-retrieve-headers): Date fix. - -2001-06-21 10:00:00 ShengHuo ZHU - - * message.el (message-make-date): Add week day. - Suggested by Jason R. Mastaler . - -2001-06-19 Simon Josefsson - - * message.el (message-yank-prefix): Doc fix. - (message-yank-cited-prefix): Ditto. - (message-delete-not-region): Keep citation prefix on first line, - if possible and appropriate. - -2001-06-19 Simon Josefsson - - * imap.el (imap-process-connection-type): New variable. - (imap-kerberos4-open, imap-gssapi-open): Use it. This makes - recent `imtest's work completely (no line length issues), while - making making old `imtest's unusable. Thanks to NAGY Andras - for his work. - -2000-12-30 NAGY Andras - - * imap.el (imap-ssl-program): Add -quiet to shut up - OpenSSL/SSLeay's internal debug talk. - -2001-06-19 Matt Armstrong - - * imap.el (imap-parse-flag-list): Workaround bug in Courier IMAP - server. - -2001-06-19 10:00:00 ShengHuo ZHU - - * nnmail.el (nnmail-article-buffer): New variable. - (nnmail-split-incoming): Use it. - -2001-06-15 Eli Zaretskii - - * qp.el (quoted-printable-decode-region): If called interactively, - use coding-system-for-read. - -2001-06-16 09:00:00 ShengHuo ZHU - - * message.el (message-check-news-header-syntax): Check Reply-To. - -2001-06-16 08:00:00 ShengHuo ZHU - - * mml.el (mml-parse-1): Use message options. - - * message.el (message-do-fcc): Don't do anything if there is no - FCC. - -2001-06-16 Simon Josefsson - - * nnimap.el (nnimap-split-articles): Support 'junk to-groups. - (nnimap-expunge-search-string): New variable. - (nnimap-request-expire-articles): Use it. - -2001-06-15 19:00:00 ShengHuo ZHU - - * message.el (message-send-mail-with-qmail): wrong exit status is - 100 not 1. Reported by Paul Jarc . - -2001-06-15 09:00:00 ShengHuo ZHU - - * gnus-art.el (article-strip-multiple-blank-lines): Use - delete-region instead of replace-match. - -2001-06-14 16:00:00 ShengHuo ZHU - - * nnweb.el (nnweb-google-parse-1): Fix Google content regexp. - (nnweb-google-wash-article): Ditto. - -2001-06-14 Ferenc Wagner - - * nnweb.el (nnweb-google-parse-1): Fix Google url regexp. - -2001-06-13 Katsumi Yamaoka - - * gnus.el (gnus-define-group-parameter): Don't quote the defcustom - specs. - -2001-06-13 15:00:00 ShengHuo ZHU - - * gnus.el (gnus-email-address): Move it here. - - * gnus-art.el (article-de-quoted-unreadable): Read charset if - requested. - (article-de-base64-unreadable): Ditto. - (article-wash-html): Ditto. - -2001-06-12 14:00:00 ShengHuo ZHU - - * message.el (message-options-set-recipient): Don't add ", " - unless necessary. Suggested by Josh Huber . - -2001-06-12 12:00:00 ShengHuo ZHU - - * nnrss.el (nnrss-group-alist): Use |fr| instead of [fr]. - -2001-06-12 11:00:00 Marc Lefranc - - * gnus-art.el (gnus-plain-save-name): Use file-relative-name. - -2001-06-12 11:00:00 ShengHuo ZHU - - * nnrss.el (nnrss-node-text): Node might be nil. - -2001-06-11 10:00:00 Katsumi Yamaoka - - * gnus-uu.el (gnus-uu-save-article): Use mml tag instead of - part. - -2001-06-11 10:00:00 ShengHuo ZHU - - * nnrss.el (nnrss-group-alist): More items. - -2001-06-09 23:00:00 ShengHuo ZHU - - * nnrss.el (nnrss-node-text): Use cddr instead xml-node-children. - -2001-06-03 ShengHuo ZHU - Trivial patch from Dale Hagglund - - * gnus-mlspl.el (gnus-group-split-fancy): Fix generation of split - restrict clauses. - -2001-06-07 16:00:00 Benjamin Rutt - - * message.el (message-wide-reply-confirm-recipients): New variable. - -2001-06-06 Mark Thomas (tiny change) - - * nnmail.el (nnmail-fix-eudora-headers): Change the In-Reply-To - fix so it works with XEmacs. - -2001-06-07 16:00:00 ShengHuo ZHU - - * nnrss.el (nnrss-retrieve-headers): Support description as extra - headers. - -2001-06-07 15:00:00 ShengHuo ZHU - - * nnrss.el: Fix a few bugs. - -2001-06-05 Alex Schroeder - - * mm-decode.el (mm-handle-set-external-undisplayer): Don't - generate compiler warnings. - -2001-06-04 Hrvoje Niksic - - * mm-decode.el (mm-pipe-part): Bind coding-system-for-write to - binary so that we don't transmit ISO 2022 garbage to the process. - This is needed under XEmacs. - -2001-06-03 Simon Josefsson - - * imap.el (imap-ssl-open): Require ssl. (Otherwise ssl.el is - autoloaded incorrectly below because ssl-program-* is bound.) - Thanks to Amos Gouaux for report. - -2001-06-02 Simon Josefsson - - * imap.el (imap-kerberos4-open): - (imap-gssapi-open): - (imap-ssl-open): - (imap-network-open): - (imap-shell-open): - (imap-starttls-open): Set buffer to workaround spurious - `accept-process-output' buffer changes. Thanks to Mats Lidell - for report and partial patch and Jake - Colman for report. - -2001-05-31 13:00:00 ShengHuo ZHU - - * gnus-sum.el (gnus-summary-catchup): New argument. - (gnus-summary-catchup-from-here): New function. - -2001-05-30 Kai Gro,b_(Bjohann - - * mm-view.el (mm-inline-image-xemacs): Insert newline, then move - back, then insert glyph. (Before, the glyph was inserted first, - then the newline.) This works around a behavior in XEmacs where - it is not possible to insert a character after a glyph which is at - the end of a buffer. Patch by Lloyd Zusman . - -2001-05-28 Jaap-Henk Hoepman - - * mm-decode.el (mm-keep-viewer-alive-types): New variable. - (mm-keep-viewer-alive-p, mm-handle-set-external-undisplayer, - mm-destroy-postponed-undisplay-list): New functions. - (mm-display-external): Use them. - -2001-05-27 Raja R. Harinath - - * gnus-salt.el (gnus-tree-highlight-node): Bind `default-high' and - `default-low' when evaluating `gnus-summary-highlight'. - -2001-05-27 Simon Josefsson - - * message.el (message-yank-cited-prefix): New variable. - (message-indent-citation): Use it. - - * mml2015.el (mml2015-mailcrypt-verify): Store gpg stderr output - as details. - (mml2015-mailcrypt-clear-verify): Ditto. - -2001-05-24 Nevin Kapur - - * gnus-sum.el (gnus-summary-default-high-score, - gnus-summary-default-low-score): New variables. - (gnus-summary-highlight): Use them. - -2001-05-16 Didier Verna - - * message.el (message-mail): pass the 'send-actions argument to - `message-setup'. - -2001-05-16 Raymond Scholz - - * gnus-art.el (gnus-mime-view-part-as-charset): - (gnus-mime-internalize-part): Doc fixes. - -2001-05-11 Simon Josefsson - - * gnus-start.el (gnus-ignored-newsgroups): Also ignore NNTP type - status lines without any text ("^215$"). - -2001-05-06 21:00:00 ShengHuo ZHU - - * nnrss.el (nnrss-check-group): Reverse. - -2001-05-07 Simon Josefsson - - * message.el (message-get-reply-headers): - (message-followup): Fix typo, suggested by David Green - - -2001-05-05 15:00:00 ShengHuo ZHU - - * nnslashdot.el (nnslashdot-request-expire-articles): Fix. - - * nnrss.el (nnrss-open-server): Read server data when it is called. - (nnrss-request-expire-articles): Fix. - -2001-05-05 09:00:00 ShengHuo ZHU - - * message.el (message-do-send-housekeeping): mail-abbrevs may - rename buffer behind Gnus. - -2001-05-04 14:00:00 ShengHuo ZHU - - * nnrss.el (nnrss-check-group): Use nnheader-translate-file-chars. - (nnrss-group-alist): Add more resources. - (nnrss-check-group): Ignore errors. - -2001-05-04 00:00:00 ShengHuo ZHU - - * nnrss.el (nnrss-request-expire-articles): Correct the return value. - - * nnslashdot.el (nnslashdot-request-list): Add time. - (nnslashdot-request-expire-articles): New function. - - * gnus-start.el (gnus-check-bogus-newsgroups): Remove bogus - secondary methods too. - -2001-05-03 23:00:00 ShengHuo ZHU - - * message.el (message-use-followup-to): Set default value to t. - -2001-05-03 Florian Weimer - - * message.el (message-dont-reply-to-names): Fix documentation. - (message-get-reply-headers): Use Mail-Followup-To only for wide - replies. - -2001-05-03 12:00:00 ShengHuo ZHU - - * nnrss.el (nnrss-request-expire-articles): Calculate # of days - correctly. - (nnrss-check-group): Use time. - -2001-05-01 19:21:19 Lars Magne Ingebrigtsen - - * gnus.el: Oort Gnus v0.03 is released. - -2001-05-01 19:06:21 Lars Magne Ingebrigtsen - - * nnultimate.el (nnultimate-topic-article-to-article): Use the - group. - -2001-04-24 19:50:14 Lars Magne Ingebrigtsen - - * gnus-srvr.el (gnus-server-insert-server-line): Add a space. - -2001-04-15 14:55:03 Lars Magne Ingebrigtsen - - * nnultimate.el (nnultimate-retrieve-headers): Return all - available headers. - - * gnus-sum.el (gnus-read-all-available-headers): New variable. - (gnus-get-newsgroup-headers-xover): Use it. - -2001-04-14 15:47:26 Lars Magne Ingebrigtsen - - * nnultimate.el (nnultimate-retrieve-headers): Clean up. - -2001-04-30 17:00:00 ShengHuo ZHU - - * nntp.el (nntp-retrieve-groups): Use throw instead of error. - -2001-04-29 09:00:00 ShengHuo ZHU - - * nnrss.el (nnrss-insert-w3): Use cache before I figure out how to - disable it. - - * gnus.el (gnus-info-nodes): Remove a few The's. - -2001-04-29 08:00:00 ShengHuo ZHU - - * mail-source.el (mail-source-movemail): Call-process may return a - signal description string. - - * gnus-start.el (gnus-read-newsrc-el-file): - gnus-newsrc-file-version may be nil. - - * nnmail.el (nnmail-get-new-mail): Use the exact file only. - Suggested by Michael Sperber [Mr. Preprocessor] - . - -2001-04-25 Per Abrahamsen - - * mm-uu.el (mm-uu-configure-list): Fixed customize type. - -2001-04-24 Hrvoje Niksic - - * mm-view.el (mm-display-inline-fontify): Allow XEmacs to fully - fontify HANDLE. - -2001-04-18 Simon Josefsson - - * smime.el (smime-ask-passphrase): Rework to return value. - (smime-sign-region): Rework to bind value and use it. - (smime-decrypt-region): Ditto. - -2001-04-18 Simon Josefsson - Trivial patch from Mathias Herberts - - * smime.el (smime-ask-passphrase): New function. - (smime-sign-region): Use it. - (smime-encrypt-cipher): New variable. - (smime-decrypt-region): Ditto. - -2001-04-12 Jason Merrill - - * imap.el (imap-shell-open): Erase the buffer *after* copying it into - the log. - -2001-04-14 01:14:42 Lars Magne Ingebrigtsen - - * gnus.el: Oort Gnus v0.02 is released. - -2001-04-14 00:48:42 Lars Magne Ingebrigtsen - - * gnus.el: Oort Gnus v0.01 is released. - -2001-04-13 22:01:46 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-highlight): Highlight read - undownloaded articles as read articles. - - * gnus-agent.el (gnus-agent-get-undownloaded-list): Clean up. - (gnus-agent-get-undownloaded-list): Mark all undownloaded - articles, even read ones, as such. - - * gnus-sum.el (gnus-summary-find-matching): Clean up. - (gnus-find-matching-articles): New function. - (gnus-summary-limit-include-matching-articles): New command. - (gnus-summary-limit-include-thread): Include articles that have - matching subjects. - (gnus-offer-save-summaries): Clean up. - -2001-04-13 Kai Gro,b_(Bjohann - - * nnmail.el (nnmail-split-fancy-with-parent): Add docstring. - -2001-04-12 19:00:00 Jason Merrill - - * gnus-sum.el (gnus-summary-insert-new-articles): Reverse the articles. - -2001-04-10 08:01:15 Katsumi Yamaoka - - * gnus-msg.el (gnus-post-news): Fill the Newsgroups header by the - newsgroup names when the original article is a news message. - -2001-04-12 19:00:00 ShengHuo ZHU - - * message.el (message-cite-prefix-regexp): Use POSIX regexp if - supported. Suggest by Jim Meyering . - -2001-04-02 Nevin Kapur - - * nnmail.el (nnmail-split-it): Added check for .* at the end of - regexp in nnmail-split-fancy. - -2001-04-10 Simon Josefsson - - * message.el (message-options-set-recipient): Look at Cc and Bcc too. - -2001-04-10 Colin Marquardt - - * message.el (message-send-mail): Improve the interaction with the - user. - -2001-04-10 Simon Josefsson - - * imap.el (imap-message-copy): Work around buggy servers that - doesn't send TRYCREATE tags. - -2001-04-09 01:15:54 Katsumi Yamaoka - - * gnus-start.el (gnus-read-newsrc-el-file): Work with Semi-gnusae. - -2001-04-05 21:43:25 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-update-summary-mark-positions): Use a valid - date. - -2001-04-04 16:13:17 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-quit): Check that the dribble buffer - lives. - -2001-04-02 00:40:12 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-parse-news-url): New function. - (gnus-button-handle-news): New function. - (gnus-button-alist): Point to new functions. - - * gnus-group.el (gnus-group-quit): Only mark buffer in non-empty. - - * gnus-start.el (gnus-read-newsrc-el-file): Nix out - gnus-format-specs. - - * message.el (message-check-news-header-syntax): Question even - when Gnus doesn't know the group names. - (message-send-news): Clean up. - - * gnus-start.el (gnus-dribble-read-file): Say whether Gnus was - exited on purpose without saving. - - * gnus-group.el (gnus-group-quit): Mark the dribble file as `Q'. - -2001-04-01 00:37:14 Lars Magne Ingebrigtsen - - * gnus-score.el (gnus-score-orphans): Clean up. - - * gnus-win.el (gnus-remove-some-windows): Leave one Gnus window. - - * gnus-sum.el (gnus-summary-exit): Kill the summary buffer a bit - later. - - * gnus-start.el (gnus-close-all-servers): Find the right items to - close. - - * qp.el (quoted-printable-decode-region): Just message - malformation; don't quit. - -2001-03-31 21:00:00 Gerd Moellmann - - * gnus.el (gnus-interactive): A typo. - -2001-03-26 Juanma Barranquero - - * gnus-util.el (gnus-delete-alist): Declare it as an alias of - `assq-delete-all', if that function exists; otherwise use the old - definition. Documentation changed to match the one in - `assq-delete-all'. - -2001-04-01 00:37:14 Lars Magne Ingebrigtsen - - * gnus-start.el (gnus-close-all-servers): New function. - - * gnus-srvr.el (gnus-server-close-all-servers): Clean up. - (gnus-server-remove-denials): Clean up. - - * gnus-sum.el (gnus-summary-sort-by-original): New command and - keystroke. - -2001-03-31 02:56:55 Lars Magne Ingebrigtsen - - * message.el (message-send-news): Message where we are sending. - (message-send-mail): Ditto. - - * gnus.el (gnus-server-string): New function. - - * gnus-sum.el (gnus-summary-up-thread): Doc fix. - - * mm-decode.el (mm-default-directory): Customized. - (mm-tmp-directory): Ditto. - - * gnus-sum.el (gnus-summary-catchup-and-exit): Doc fix. - (gnus-get-newsgroup-headers): Return -1 for articles without Lines - or Chars. - (gnus-summary-line-format-alist): ?l is now a string. - (gnus-summary-prepare-threads): Output ? for unknown lines. - (gnus-summary-insert-line): Ditto. - (gnus-summary-print-article): Unbalanced parentheses. - - * gnus-msg.el (gnus-inews-do-gcc): Check group to allow it to find - out whether new stuff has arrived. - -2001-03-31 02:14:38 Alan Shutko - - * gnus-sum.el: Let printing work on ttys on Emacs. - -2001-03-31 01:11:14 Lars Magne Ingebrigtsen - - * gnus-msg.el (gnus-post-news): Add an empty Newsgroups header - when forcing news. - - * gnus-sum.el (gnus-summary-mark-article-as-replied): Make into a - command. - -2001-03-31 01:04:54 Francis Litterio - - * message.el (message-set-auto-save-file-name): Don't use - asterisks under nt. - -2001-03-31 00:03:42 Lars Magne Ingebrigtsen - - * gnus-msg.el (gnus-inews-insert-draft-meta-information): Allow - lists of articles. - - * gnus-uu.el (gnus-uu-digest-mail-forward): Mark as forwarded. - - * gnus-msg.el (gnus-put-message): Clean up. - (gnus-summary-reply): Mark all replied-to articles as replied to. - (gnus-inews-add-send-actions): Also mark as forwarded. - (gnus-summary-mail-forward): Mark as forwarded. - - * gnus-sum.el (gnus-summary-mark-article-as-replied): Take a list - of articles. - (gnus-summary-mark-article-as-forwarded): Ditto. - - * gnus-msg.el (gnus-summary-resend-message): Mark article as - forwarded. - (gnus-summary-mail-forward): Clean up. - - * gnus.el (gnus-article-mark-lists): Added forward. - - * gnus-sum.el (gnus-forwarded-mark): New variable. - (gnus-summary-prepare-threads): Use it. - (gnus-summary-update-secondary-mark): Ditto. - (gnus-newsgroup-forwarded): New variable. - -2001-03-30 23:13:37 Lars Magne Ingebrigtsen - - * gnus-msg.el (gnus-summary-reply): Allow very wide replies. - (gnus-summary-very-wide-reply): New command and keystroke. - (gnus-summary-very-wide-reply-with-original): Ditto. - - * gnus-score.el (gnus-adaptive-word-length-limit): New variable. - (gnus-score-adaptive): Use it. - - * gnus-start.el (gnus-get-unread-articles): Clean up. - -2001-03-21 20:00:43 Lars Magne Ingebrigtsen - - * nnultimate.el (nnultimate-retrieve-headers): Work for other - boards. - -2001-03-21 Didier Verna - - * gnus-start.el (gnus-subscribe-newsgroup-hooks): New. - * gnus-start.el (gnus-subscribe-newsgroup): use it. - -2001-03-15 09:47:23 Lars Magne Ingebrigtsen - - * nnultimate.el (nnultimate-retrieve-headers): Understand - long-form month names. - -2001-03-18 23:00:00 ShengHuo ZHU - - * gnus-sum.el (gnus-summary-show-all-headers): - gnus-article-show-all-headers is broken. Use - gnus-summary-toggle-header instead. - - * mml2015.el (mml2015-gpg-extract-from): No error. - -2001-03-18 23:00:00 Bj,Ax(Brn Mork - - * mml2015.el (mml2015-gpg-extract-from): New function. - (mml2015-gpg-verify): Use it. - (mml2015-gpg-clear-verify): Use it. - -2001-03-17 10:00:00 ShengHuo ZHU - - * message.el (message-setup-fill-variables): Use - fill-paragraph-function. - (message-fill-paragraph): Take an argument. - (message-newline-and-reformat): Take another argument. - -2001-03-16 20:00:00 ShengHuo ZHU - - * message.el (rmail-output): It is in rmailout.el not rmail.el. - -2001-03-16 16:00:00 ShengHuo ZHU - - * message.el (message-forward): local-variable-p takes an extra - argument in XEmacs. - -2001-03-16 Simon Josefsson - - * nnimap.el (nnimap-dont-use-nov-p): Renamed from - `nnimap-use-nov-p' (it really tested the negative). - (nnimap-retrieve-headers): Use it. - -2001-03-11 Kai Gro,b_(Bjohann - - * message.el (message-generate-headers-first): Update doc. - -2001-03-10 Matthias Wiehl - Trivial patch. - - * gnus.el (gnus-summary-line-format): Typo. - -2001-03-11 Simon Josefsson - - * mailcap.el (mailcap-mime-data): Add application/sieve. - (mailcap-mime-extensions): Add .siv, .xls. - -2001-03-14 20:00:00 Christoph Conrad - - * gnus-score.el (gnus-summary-lower-thread): Typo. - -2001-03-14 19:00:00 ShengHuo ZHU - - * message.el (message-forward-decoded-p): New variable. - (message-forward-subject-author-subject): Use it. - (message-make-forward-subject): Use it. - (message-forward): Use it. - - * gnus-uu.el (gnus-uu-digest-mail-forward): Use it. - - * mm-util.el, message.el, rfc2047.el, gnus-sum.el, gnus-score.el: - Sync with Emacs 21 (tag EMACS_PRETEST_21_0_100). - -;;Has been fixed -- zsh. -;;2001-03-05 Dave Love -;; -;; * mm-util.el (mm-mime-mule-charset-alist): Fix utf-8 case. -;; Move it after definition of mm-coding-system-p. -;; -2001-03-01 Dave Love - - * mm-util.el (mm-inhibit-file-name-handlers): Add - image-file-handler. - -2001-02-11 Dave Love - - * message.el (message-signature-file): Fix doc, :type. - -2001-02-08 Dave Love - - * rfc2047.el (rfc2047-fold-region): Don't forward-char at EOB. - (message-posting-charset): Defvar when compiling again. - (rfc2047-encodable-p): Require message. - - * gnus-sum.el (gnus-alter-articles-to-read-function): - * gnus-score.el (gnus-score-after-write-file-function): Fix :type. - -2001-03-08 20:00:00 ShengHuo ZHU - - * nnrss.el: New file. - -2001-03-08 02:41:36 Katsumi Yamaoka - - * rfc2047.el (rfc2047-unfold-region): Fix arg of - `skip-chars-forward'. - -2001-03-07 13:00:00 ShengHuo ZHU - - * nndraft.el (nndraft-request-group): Restore auto save files if - the original files do not exist. - -2001-03-07 11:00:00 ShengHuo ZHU - - * gnus-score.el (gnus-score-find-bnews): Print messages on illegal - SCORE paths. - - * mm-decode.el (mm-dissect-buffer): Call - mail-extract-address-components only if necessary. - -2001-03-06 13:00:00 ShengHuo ZHU - - * gnus-score.el (gnus-score-find-bnews): Maybe there is no - directory part. - (gnus-score-search-global-directories): Use file-directory-p. - -2001-03-06 13:00:00 Adrian Aichner - - * gnus-score.el (gnus-score-score-files-1): Use - gnus-kill-files-directory. - -2001-03-05 08:00:00 ShengHuo ZHU - - * gnus.el (charset): Move here from gnus-sum.el. - -2001-03-04 11:00:00 ShengHuo ZHU - - * mml.el (mml-preview): Disable local map. - - * gnus-sum.el (gnus-summary-make-menu-bar): Make - gnus-article-post-menu here. - - * gnus-art.el (gnus-article-make-menu-bar): Make summary-menu bar - if it has not been made. - -2001-03-02 02:00:00 ShengHuo ZHU - - * gnus-art.el (gnus-article-describe-key): Map key to event. - (gnus-article-describe-key-briefly): Ditto - -2001-03-01 23:00:00 ShengHuo ZHU - - * gnus-sum.el (gnus-summary-limit-include-expunged): Fix. - -2001-03-01 22:00:00 Katsumi Yamaoka - - * dgnushack.el (coerce, merge, subseq): defmacro. - -2001-03-01 22:00:00 ShengHuo ZHU - - * lpath.el (nndraft-request-group): Move it here from nndraft.el. - A fake defalias in nndraft.el results a not-activated bug in - uncompiled versions. - -2001-02-26 11:27:27 Paul Jarc - - * gnus-util.el (gnus-split-references): Handle malformed References:. - -2001-02-26 08:00:00 ShengHuo ZHU - - * gnus-art.el (gnus-article-mime-part-status): 1 part. - -2001-02-25 10:00:00 NAGY Andras - - * gnus.el (gnus-parameters): Typo. - -2001-02-24 00:00:00 ShengHuo ZHU - - * gnus.el (gnus-read-method): Remove redundancy. - -2001-02-23 23:00:00 ShengHuo ZHU - - * nnslashdot.el (nnslashdot-backslash-url): New variable. - (nnslashdot-request-list): Use it. - -2001-02-23 22:00:00 ShengHuo ZHU - - * nnml.el (nnml-generate-active-info): Fix the case when there is - no file. - - * gnus-sum.el (gnus-summary-import-article): Display it. Enable edit. - (gnus-summary-create-article): New function. - - * gnus-group.el (gnus-group-mark-article-read): New function. - - * gnus-msg.el (gnus-inews-do-gcc): Use it. - - * gnus-art.el (gnus-article-edit-article): Set modified-p nil. - -2001-02-23 17:00:00 ShengHuo ZHU - - * gnus-art.el (gnus-article-edit-done): Don't use - gnus-article-edit-exit. - (gnus-article-edit-exit): Confirm and insert original-article-buffer. - - * gnus.el (gnus-parameters): New variable. - Suggested by NAGY Andras . - (gnus-parameters-get-parameter): New function. - (gnus-group-find-parameter): Use it. - -2001-02-23 Simon Josefsson - - * gnus-msg.el (gnus-post-method): Fix documentation to reflect - change of default value to `current'. - -2001-02-23 08:00:00 ShengHuo ZHU - - * nneething.el (nneething-get-head): Insert unreadable file too. - -2001-02-22 23:00:00 ShengHuo ZHU - - * gnus-sum.el (gnus-summary-insert-articles): Remove fetched headers. - - * webmail.el (webmail-type-definition): Deja is bought by google. - -2001-02-22 22:00:00 ShengHuo ZHU - - * gnus-sum.el (gnus-fetch-headers): New function. - (gnus-select-newsgroup): Use it. - (gnus-summary-insert-articles): New function. - (gnus-summary-insert-old-articles): New function. - (gnus-summary-insert-new-articles): New function. - - * gnus-group.el (gnus-group-prepare-flat-list-dead): Use decoded-name. - (gnus-group-list-active): Ditto. - * gnus-sum.el (gnus-set-mode-line): Ditto. - (gnus-summary-read-group-1): Ditto. - -2001-02-21 15:00:00 ShengHuo ZHU - - * gnus-topic.el (gnus-topic-get-new-news-this-topic): Redraw the - current topic. - -2001-02-21 01:00:00 ShengHuo ZHU - - * smiley.el (gnus-smiley-display): Don't do widening. - - * smiley-ems.el (gnus-smiley-display): Don't do widening. Smiley - within body. - - * gnus-msg.el (gnus-inews-do-gcc): Activate group anyway. - - * gnus-art.el (gnus-mime-display-multipart-alternative-as-mixed): - New variable. - (gnus-mime-display-multipart-related-as-mixed): New variable. - (gnus-mime-display-part): Use them. - -2001-02-20 16:00:00 ShengHuo ZHU - - * gnus-start.el (gnus-setup-news): Allow gnus-group-line-format to be - something special. - -2001-02-20 00:00:00 ShengHuo ZHU - - * nnweb.el (nnweb-request-group): Set nnweb-group anyway. - (nnweb-request-article): Call reference if exists. - (nnweb-type-definition): Dejanews is bought by google.com. - Beta! - -2001-02-19 19:00:00 ShengHuo ZHU - - * gnus-draft.el (gnus-draft-reminder): "Confirm to exit?" - -2001-02-19 Kai Gro,b_(Bjohann - - * gnus-sum.el (gnus-thread-sort-functions): Doc fix. Refer to - gnus-article-sort-functions. - (gnus-article-sort-functions): Doc fix. Refer to - gnus-thread-sort-functions. - -2001-02-18 20:00:00 Paul Jarc - - * message.el (message-get-reply-headers): More fixes. - -2001-02-17 Paul Jarc - - * message.el (message-get-reply-headers): Fix bug with - Mail-Followup-To/to-address interaction. - -2001-02-17 13:00:00 ShengHuo ZHU - - * gnus-msg.el (gnus-configure-posting-styles): Match header in - gnus-article-copy. - -2001-02-16 22:00:00 ShengHuo ZHU - - * message.el (message-do-send-housekeeping): Rename to a better - name. - -2001-02-16 18:00:00 ShengHuo ZHU - - * message.el (message-cancel-news): Check article first, then ask - yes or no. - -2001-02-16 14:00:00 ShengHuo ZHU - - * mm-uu.el (mm-uu-type-alist): Add emacs-sources. - -2001-02-16 11:00:00 ShengHuo ZHU - - * gnus-range.el (gnus-range-normalize): New function. - -2001-02-15 NAGY Andras - - * imap.el (imap-gssapi-open): Set imap-c-l-s-first. - -2001-02-14 21:00:00 ShengHuo ZHU - - * gnus-srvr.el (gnus-server-regenerate-server): Use gnus-get-function. - - * nnagent.el (nnagent-request-regenerate): New function. - - * nnfolder.el (nnfolder-request-regenerate): New deffoo. - - * nnml.el (nnml-generate-nov-databases): Accept argument - server. Don't open server if it is opened. - (nnml-request-regenerate): Use it. Change to deffoo. - -2001-02-14 Katsumi Yamaoka - - * gnus.el (gnus-define-group-parameter): Fix. - -2001-02-14 15:00:00 ShengHuo ZHU - - * gnus.el (gnus-define-group-parameter): Improved. - - * gnus-sum.el (charset): Define parameter. - (ignored-charsets): Ditto. - (gnus-summary-setup-default-charset): Use them. - - * gnus-start.el (gnus-read-descriptions-file): Use them. - - * gnus-cus.el (gnus-group-parameters): Remove them. - -2001-02-14 00:00:00 ShengHuo ZHU - - * gnus-sum.el (gnus-summary-print-article): Redo highlight. - -2001-02-13 21:00:00 ShengHuo ZHU - - * gnus-sum.el (gnus-summary-read-group-1): Remove - gnus-summary-set-local-parameters. - (gnus-summary-setup-buffer): Put it here. - -2001-02-13 20:00:00 ShengHuo ZHU - - * gnus.el (to-address): Define parameter. - (to-list): Ditto. - * gnus-art.el (article-hide-boring-headers): Use them. - * gnus-msg.el (gnus-post-news): Ditto. - * gnus-cus.el (gnus-group-parameters): Remove them. - -2001-02-13 19:00:00 ShengHuo ZHU - - * gnus-draft.el (gnus-draft-reminder): New function. - - * gnus-art.el (gnus-sender-save-name): New function. - -2001-02-13 18:00:00 ShengHuo ZHU - - * mm-util.el (mm-mime-charset): Error message. - -2001-02-13 11:00:00 ShengHuo ZHU - - * message.el (message-check-news-body-syntax): Don't check mml lines. - -2001-02-12 11:00:00 ShengHuo ZHU - - * gnus-topic.el (gnus-subscribe-topics): Return nil if not - subscribe. - - * gnus-start.el (gnus-call-subscribe-functions): New function. - (gnus-find-new-newsgroups): Use it. - (gnus-ask-server-for-new-groups): Use it. - (gnus-check-first-time-used): Use it. - (gnus-subscribe-newsgroup-method): Grok a list of functions. - (gnus-subscribe-options-newsgroup-method): Ditto. - (gnus-subscribe-hierarchically): Return gnus-subscribe-newsgroup's - return . - -2001-02-12 Kai Gro,b_(Bjohann - - * gnus-cus.el (gnus-score-customize): Doc fix. - -2001-02-11 Jesper Harder - - * dgnushack.el (my-getenv): Typo. - -2001-02-11 11:00:00 ShengHuo ZHU - - * dgnushack.el (dgnushack-make-load): Don't autoload smiley functions. - -2001-02-11 09:00:00 ShengHuo ZHU - - * gnus-group.el (gnus-group-suspend): Offer save summaries. - - * gnus-art.el (gnus-treat-leading-whitespace): New variable. - (gnus-treatment-function-alist): Use it. - (article-remove-leading-whitespace): New function. - (gnus-article-make-menu-bar): Use it. - - * gnus-sum.el (gnus-summary-wash-empty-map): Add - remove-leading-whitespace. - (gnus-summary-wash-map): Bind strip-headers-in-body to `W a', - because of conflict. - -2001-02-09 23:00:00 ShengHuo ZHU - - * Makefile.in: Hack generating gnus-load.el. - * dgnushack.el: Ditto. - * gnus-load.el: Remove it. - -2001-02-09 20:00:00 ShengHuo ZHU - - * dgnushack.el : Add URLDIR. - - * Makefile.in (EMACS_COMP): Ditto. - -2001-02-09 19:00:00 ShengHuo ZHU - - * gnus-cus.el (gnus-score-customize): Error on no score file. - -2001-02-09 08:00:00 ShengHuo ZHU - - * mm-decode.el (mm-merge-handles): New function. - - * mm-view.el (mm-inline-message): Use it. - (mm-view-message): Ditto. - - * mm-partial.el (mm-inline-partial): Ditto. - - * mm-extern.el (mm-inline-external-body): Ditto. - - * gnus-art.el (gnus-mime-view-part): Ditto. - (gnus-mime-view-part-as-type): Ditto. - (gnus-mime-save-part-and-strip): Prevent users to strip in some - cases. - -2001-02-08 20:00:00 ShengHuo ZHU - - * message.el (message-cancel-news): Allow to shoot foot. - (message-supersede): Ditto. - -2001-02-08 Tommi Vainikainen - Trivial patch. - - * gnus-sum.el (gnus-simplify-subject-re): Use - message-subject-re-regexp. - -2001-02-08 18:00:00 ShengHuo ZHU - - * nnmail.el (nnmail-expiry-target-group): Bind - nnmail-cache-accepted-message-ids to nil. - - * gnus-xmas.el (gnus-xmas-article-display-xface): Use binary - coding system. - -2001-02-07 23:00:00 ShengHuo ZHU - - * qp.el (quoted-printable-encode-region): Make sure characters are - between 00 and FF. Don't check charset. - - * mm-encode.el (mm-encode-content-transfer-encoding): Use unibyte - in Emacs 20. - * rfc2047.el (rfc2047-q-encode-region): Ditto. - -2001-02-07 11:00:00 ShengHuo ZHU - - * message.el (message-make-forward-subject): Argument decoded. - (message-forward): Use it when digest. - - * gnus-uu.el (gnus-uu-grab-articles): Shoot down original article - buffer. - -2001-02-07 Kai Gro,b_(Bjohann - - * message.el (message-generate-headers-first): Doc fix. - -2001-02-07 10:00:00 ShengHuo ZHU - - * gnus-art.el (article-make-date-line): Error proof. - -2001-02-06 21:00:00 ShengHuo ZHU - - * gnus-group.el (gnus-group-listing-limit): New variable. - (gnus-group-prepare-flat-list-dead): Use old trick to speed up. - - * gnus-topic.el (gnus-group-prepare-topics): Use gnus-killed-hashtb. - -2001-02-06 18:00:00 ShengHuo ZHU - - * message.el (message-newline-and-reformat): Special case for - breaking at BOL. - -2001-02-06 Per Abrahamsen - - * gnus-uu.el (gnus-uu-save-article): Make the topics summary a - message/rfc822. - -2001-02-06 09:00:00 ShengHuo ZHU - - * message.el (message-encode-message-body): Don't insert - Content-Type if it is inside a mail. - -2001-02-06 02:00:00 ShengHuo ZHU - - * gnus-xmas.el (gnus-xmas-article-menu-add): Add - gnus-article-commands-menu. - - * gnus-sum.el (gnus-summary-make-menu-bar): Don't share menu bar - in Emacs. - - * gnus-start.el (gnus-read-descriptions-file): Use - gnus-group-name-charset and gnus-group-charset-alist. - -2001-02-04 23:00:00 ShengHuo ZHU - - * gnus-sum.el (gnus-summary-mark-as-processable): Understand - active region. - - * gnus-start.el (gnus-group-change-level): Remove from both - gnus-zombie-list and gnus-killed-list. - -2001-02-04 11:00:00 ShengHuo ZHU - - * gnus-start.el (gnus-subscribe-options-newsgroup-method): Add - gnus-subscribe-topics. - - * gnus-cus.el (gnus-extra-topic-parameters): Fix doc. - -2001-02-04 11:00:00 ShengHuo ZHU - - * gnus-art.el (gnus-article-make-menu-bar): Make - gnus-article-post-menu. - - * gnus-xmas.el (gnus-xmas-article-menu-add): Add post menu. - - * gnus-sum.el (gnus-summary-make-menu-bar): Use t if XEmacs. - - * gnus-group.el (gnus-group-make-menu-bar): Ditto. - - * message.el (message-mode-menu): Ditto. - - * gnus-art.el (defvar): eval-when-compile. - -2001-02-02 17:00:00 ShengHuo ZHU - - * gnus-agent.el (gnus-agentize): Fix doc. - -2001-02-02 Karl Kleinpaste - - * mml.el (mml-preview): Bind `q'. - -2001-02-02 12:00:00 ShengHuo ZHU - - * mm-util.el (mm-mime-mule-charset-alist): non-Mule case. - -2001-01-31 Dave Love - - * mm-util.el (mm-mime-mule-charset-alist) - (mm-find-mime-charset-region): Consider mule-utf-8. - -2001-01-31 Dave Love - - * gnus-art.el (gnus-article-x-face-command) - (gnus-treat-display-xface, gnus-treat-display-smileys): Add - :version. - -2001-01-26 Dave Love - - * mm-util.el (mm-multibyte-string-p): New. - -;; * qp.el: Remove un-logged bogus changes from 2000-12-20. -;; (quoted-printable-encode-region): Doc fix. Don't call -;; string-as-multibyte on class. Clarify line-folding. - (quoted-printable-encode-string): Make temp buffer inherit - string's multibyteness. - -2001-01-23 Gerd Moellmann - - * nnheader.el (toplevel): Don't require `gnus-util' at - compile-time; this creates a circular dependency, and prevents - a bootstrap. - -2001-01-22 Andreas Schwab - - * nnheader.el (gnus-delete-line): Autoload it as a macro. - -2001-01-31 18:00:00 ShengHuo ZHU - - * nnmail.el (nnmail-remove-list-identifiers): Use consp. - - * gnus-art.el (article-hide-list-identifiers): Ditto. - - * gnus-sum.el (gnus-summary-remove-list-identifiers): Ditto. - -2001-01-31 15:00:00 ShengHuo ZHU - - * gnus-sum.el (gnus-summary-remove-list-identifiers): Similar. - - * gnus-art.el (article-hide-list-identifiers): Similar. - -2001-01-31 Karl Kleinpaste - - * nnmail.el (nnmail-remove-list-identifiers): Improved. - -2001-01-31 09:00:00 ShengHuo ZHU - - * gnus-score.el (gnus-summary-score-entry): match may be an integer. - -2001-01-30 10:00:00 ShengHuo ZHU - - * gnus-util.el (gnus-string-equal): New function. - - * gnus-art.el (article-hide-boring-headers): Use it. - -2001-01-27 Karl Kleinpaste - - * gnus-art.el (gnus-article-banner-alist): eGroups new banner. - -2001-01-27 00:00:00 ShengHuo ZHU - - * gnus-msg.el (gnus-msg-mail): Support switch-action. - -2001-01-26 08:00:00 ShengHuo ZHU - - * gnus-art.el (gnus-summary-save-in-pipe): Prompt for saving - command if there is not last-saver. - -2001-01-24 19:00:00 ShengHuo ZHU - - * nntp.el (nntp-open-connection): 201 is possible. - -2001-01-24 18:00:00 ShengHuo ZHU - - * rfc2047.el (rfc2047-encode): MIME charset is not coding system. - (rfc2047-charset-encoding-alist): Add big5. - -2001-01-24 17:00:00 ShengHuo ZHU - - * gnus-agent.el (gnus-agent-add-server): Redraw the line. - (gnus-agent-remove-server): Ditto. - (autoload): gnus-server-update-server. - - * gnus-srvr.el (gnus-server-line-format): Add %a. - (gnus-server-line-format-alist): Add gnus-tmp-agent. - (gnus-server-insert-server-line): Use it. - -2001-01-24 09:00:00 ShengHuo ZHU - - * mm-util.el (mm-mime-mule-charset-alist): Preferred MIME names - GB2312 and Big5. - -2001-01-24 Simon Josefsson - - * mail-source.el (mail-sources): Add :program specifier to IMAP - mail source. - (mail-source-fetch-imap): Map :program to `imap-shell-program'. - -2001-01-24 08:00:00 ShengHuo ZHU - - * gnus-score.el (gnus-score-lower-thread): Fix a doc typo. - -2001-01-24 12:22:47 Lars Magne Ingebrigtsen - - * nntp.el (nntp-wait-for): Return the success code. - (nntp-open-connection): Use it. - -2001-01-11 11:49:02 Lars Magne Ingebrigtsen - - * gnus-int.el (gnus-check-server): Allow breaking the opening. - -2001-01-23 11:00:00 ShengHuo ZHU - - * gnus-sum.el (gnus-summary-print-article): Remove process mark. - -2001-01-22 17:00:00 ShengHuo ZHU - - * gnus-sum.el (gnus-summary-print-article): Take one prefix - argument. Allow to print several articles in one file. - -2001-01-21 12:00:00 ShengHuo ZHU - - * webmail.el (webmail-type-definition): netaddress changes. - -2001-01-21 00:00:00 ShengHuo ZHU - - * gnus.el: Fix copyright. Remove trailing spaces. - - * message.el (message-forward): Use mule4. - -2001-01-20 09:00:00 ShengHuo ZHU - - * mm-util.el (mm-string-as-unibyte): New function. - - * message.el (message-forward): Use it. - -2001-01-19 23:00:00 ShengHuo ZHU - - * message.el (message-cite-original-without-signature): Don't peel - off the blank line. - (message-get-reply-headers): Add Cc if it is not in follow-to. - -2001-01-20 Simon Josefsson - - * mm-decode.el (mm-handle-multipart-from): Add. - (mm-dissect-buffer): Save From: header value. - (mm-security-from): Remove. - (mm-possibly-verify-or-decrypt): Don't set mm-security-from. - - * mml-smime.el (mml-smime-verify): Use `mm-handle-multipart-from' - instead of `mml-security-from'. Protect null from value. - -2001-01-20 Simon Josefsson - - * mailcap.el (mailcap-mime-data): Run `gnumeric' on - application/vnd.ms-excel attachments. - -2001-01-19 Simon Josefsson - - * gnus-art.el (gnus-button-alist): Add `?=' to mailto URL regexp. - -2001-01-19 13:00:00 ShengHuo ZHU - - * message.el (message-ignored-mail-headers): Ditto. - -2001-01-19 Simon Josefsson - - * message.el (message-ignored-news-headers): Only search beginning - of line. - -2001-01-19 ShengHuo Zhu - Trivial patch from Alberto Lusiani - - * message.el (message-send-mail): Content-Type may not be there. - -2001-01-18 23:00:00 ShengHuo ZHU - - * gnus-ems.el (gnus-article-display-xface): Add BUFFER. - * gnus-xmas.el (gnus-xmas-article-display-xface): Ditto. - - * gnus-art.el (article-display-x-face): Insert X-Face if there is - not. - -2001-01-18 19:00:00 ShengHuo ZHU - - * gnus-sum.el (gnus-summary-read-group-1): Don't test dead - non-native groups. - -2001-01-18 18:00:00 ShengHuo ZHU - - * message.el (message-yank-original): Understand - universal-argument. - -2001-01-18 16:00:00 ShengHuo ZHU - - * gnus-art.el (gnus-boring-article-headers): Add to-address. - (article-hide-boring-headers): Ditto. - - * mm-view.el (mm-inline-message): Insert a newline unless bolp. - -2001-01-18 08:00:00 ShengHuo ZHU - - * rfc2047.el (rfc2047-fold-region): Don't insert LWSP if there is - one. - -2001-01-16 Simon Josefsson - - * message.el (message-make-in-reply-to): Add comment to message-id - (old syntax, see 2000-08-02 change). - -2001-01-16 13:00:00 ShengHuo ZHU - - * gnus-art.el (gnus-url-mailto): Use gnus-msg-mail. - (gnus-button-mailto): Setup message. Moved to gnus-msg.el. - (gnus-button-reply): Ditto. - -2001-01-16 Katsumi Yamaoka - - * gnus-art.el (article-display-x-face): Fix. - -2001-01-15 16:00:00 ShengHuo ZHU - - * gnus-art.el (article-display-x-face): Use - gnus-original-article-buffer. - -2001-01-15 Jack Twilley - - * message.el (message-add-header): Move to point-max. - -2001-01-15 Simon Josefsson - - * smime.el (smime-CA-directory, smime-CA-file): Change default to - nil, improve documentation. - (smime-certificate-directory): Comment out false hints (until it - is implemented). - - * mml-smime.el (mml-smime-sign): Place user in customize buffer if - there aren't any keys. - (mml-smime-verify): If smime-CA-{file,directory} set, also try to - verify certificate. Default is changed to only check integrity. - Improved security status texts. If a certificate doesn't contain - a email address, don't fail. - - * smime.el (smime-noverify-region): - (smime-noverify-buffer): New functions. Verifies integrity only. - -2001-01-12 22:00:00 ShengHuo ZHU - - * gnus-group.el (gnus-group-sort-by-score): Reverse order. - -2001-01-12 17:00:00 ShengHuo ZHU - - * gnus-win.el (gnus-configure-windows): switch-to-buffer in XEmacs. - (gnus-remove-some-windows): Ditto. - -2001-01-12 14:00:00 ShengHuo ZHU - - * gnus-art.el (article-make-date-line): 11th. - -2001-01-11 23:00:00 ShengHuo ZHU - - * mml2015.el (mml2015-gpg-encrypt): Remove CR. - (mml2015-gpg-sign): Ditto. - -2001-01-10 14:00:00 ShengHuo ZHU - - * gnus.el: Sync with EMACS_PRETEST_21_0_95. - * gnus.el (gnus-default-posting-charset): Bogus. Removed. - -2001-01-08 Dave Love - - * mm-encode.el (mm-qp-or-base64): Don't base64 for the sake of a - single character. - - * mm-util.el (mm-mime-mule-charset-alist): Add Latin-{8,9}. - - * message.el: Doc and message fixes. - (message-send-rename-function) - (message-make-forward-subject-function) - (message-send-mail-function, message-reply-to-function) - (message-wide-reply-to-function, message-followup-to-function) - (message-distribution-function, message-auto-save-directory): Fix - :type. - - * gnus/mml.el (mml-parse-1): Frob mml-confirmation-set when - proceeding after warnings. Amend multipart warning message. - -2001-01-04 Dave Love - - * gnus-util.el (nnmail-pathname-coding-system): Defvar when - compiling. - (gnus-make-directory): Require nnmail. - - * mm-decode.el (mm-inline-media-tests): Add - image/x-portable-bitmap. - (mm-get-image): Grok pbm. - -2001-01-10 Paul Stevenson - - * nnvirtual.el (nnvirtual-request-expire-articles): delq nil. - -2001-01-09 Didier Verna - - * dgnushack.el (dgnushack-compile): give a dummy value to - `gnus-xmas-glyph-directory' for the time of compilation. - * gnus-agent.el: moved some XEmacs specific hook add-ons from - `gnus-xmas-[re]define' to avoid loosing user custom settings. - * gnus-art.el: ditto. - * gnus-group.el: ditto. - * gnus-salt.el: ditto. - * gnus-sum.el: ditto. - * gnus-topic.el: ditto. - * gnus-xmas.el (gnus-xmas-define): see above. - * gnus-xmas.el (gnus-xmas-redefine): see above. - * gnus-xmas.el (gnus-xmas-glyph-directory): generate a - non-continuable error when the directory can't be found. - -2001-01-09 01:00:00 ShengHuo ZHU - - * mm-decode.el (mm-interactively-view-part): Don't copy-sequence - handle. - * gnus-art.el (gnus-mime-view-part): Copy it. - (gnus-mime-view-part-as-type): Add into gnus-article-mime-handles. - -2001-01-09 Michael Downes - - * gnus-sum.el (gnus-summary-read-group-1): More useful message. - -2001-01-08 23:00:00 ShengHuo ZHU - - * nnmail.el (nnmail-get-new-mail): Find group only if file is not - orig-file. Use ',source. - -2001-01-08 22:00:00 ShengHuo ZHU - - * gnus-xmas.el (gnus-xmas-modeline-glyph): - (gnus-xmas-group-startup-message): - Detect gnus-xmas-glyph-directory when it is nil. - -2001-01-08 09:00:00 ShengHuo ZHU - - * pop3.el (pop3-get-message-count): Andrew Innes - 's patch of 1999-12-01 was not fully committed. - -2001-01-05 06:49:37 Lars Magne Ingebrigtsen - - * gnus-agent.el (gnus-agent-fetch-session): Say what we quit. - - * time-date.el (time-to-number-of-days): New function. - -2001-01-04 11:06:14 Gregory Chernov - Trivial patch. - - * nnslashdot.el (nnslashdot-request-list): Always get the right - sid. - -2001-01-05 00:00:00 ShengHuo ZHU - - * message.el (message-minibuffer-local-map): New keymap. - (message-read-from-minibuffer): Use it. - * gnus-msg.el (gnus-summary-resend-message): Use it - -2001-01-04 22:00:00 ShengHuo ZHU - - * gnus-start.el (gnus-display-time-event-handler): New function. - (gnus-after-getting-new-news-hook): Use it. - -2001-01-03 07:26:58 Lars Magne Ingebrigtsen - - * message.el (message-ignored-mail-headers): Add draft header. - -2001-01-02 06:28:28 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-expire-articles): Don't save - excursion. - - * nnslashdot.el (nnslashdot-request-list): Get the right year. - -2001-01-01 00:52:44 Ed L. Cashin - A revoked patch. - - * gnus-sum.el (gnus-summary-expire-articles): Save excursion. - -2000-12-31 11:00:00 ShengHuo ZHU - - * qp.el (quoted-printable-decode-region): Don't backward-char. - -2000-12-31 03:57:31 Lars Magne Ingebrigtsen - - * gnus-draft.el: Mark articles as replied. - - * gnus-sum.el (gnus-summary-add-mark): New function. - - * gnus-group.el (gnus-add-mark): New function. - - * gnus-sum.el (gnus-summary-buffer-name): New function. - (gnus-summary-setup-buffer): Use it. - - * gnus-draft.el: Set things up with the right post method and - stuff. - - * message.el (message-ignored-news-headers): Remove X-Draft-From. - - * gnus-msg.el (gnus-inews-insert-draft-meta-information): New function. - - * gnus.el (gnus-draft-meta-information-header): New variable. - -2000-12-30 00:17:38 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-treatment-function-alist): Move the date - functions before the header sorting functions. - - * mm-uu.el (mm-uu-pgp-signed-extract-1): Unquote "- " quotes. - - * dgnushack.el (dgnushack-compile): Message whether there is w3. - Don't (push "/usr/share/emacs/site-lisp" load-path). - - * gnus-cite.el (gnus-article-fill-cited-article): Don't add space - to empty fill prefixes. - -2000-12-30 10:00:00 ShengHuo ZHU - - * nntp.el (nntp-open-connection): Kill pbuffer if process is nil. - Suggested by Christoph Conrad . - -2000-12-30 09:00:00 ShengHuo ZHU - - * nnheader.el (autoload): Autoload gnus-sorted-intersection. - - * nnml.el (autoload): Move to nnheader.el. - - * nnfolder.el (nnfolder-existing-articles): Reversed, i.e. sorted. - (nnfolder-request-expire-articles): Use gnus-sorted-intersection. - (nnfolder-retrieve-headers): Use intersection. Suggested by Jonas - Kvarnstr,Av(Bm . - -2000-12-30 00:17:38 Lars Magne Ingebrigtsen - - * gnus-art.el (article-make-date-line): Get the hours right. - (gnus-ignored-headers): More hiding. - - * nnmail.el (nnmail-expiry-wait): Not an integer. - - * message.el (message-goto-body): Only expand abbrev when called - interactively. - (message-make-lines): Use it. - -2000-12-29 20:00:00 ShengHuo ZHU - - * gnus-msg.el (gnus-inews-yank-articles): Reparse headers. - -2000-12-30 00:17:38 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-limit-include-expunged): Really - include the expunged articles. - - * gnus-group.el (gnus-group-sort-by-server): New function. - - * gnus.el (gnus-method-to-server-name): New function. - (gnus-group-prefixed-name): Use it. - - * gnus-group.el (gnus-group-sort-function): Doc fix. - (gnus-group-sort-groups-by-server): New command. - -2000-12-29 13:25:10 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-treat-date-english): New variable. - (article-date-english): New command. - (gnus-english-month-names): New variable. - (article-make-date-line): Do 'english. - - * gnus-cite.el (gnus-article-fill-cited-article): Add a space - after the fill prefix. - - * gnus-sum.el (gnus-summary-make-menu-bar): Removed "Enter - score...". - - * gnus-art.el (gnus-ignored-headers): Hide more headers. - - * message.el (message-mode-map): Bind comment-region. - - * gnus-art.el (gnus-mime-display-part): Let w3 display - multipart/related. - - * mm-bodies.el (mm-long-lines-p): New function. - (mm-body-encoding): Use it. - (mm-body-encoding): Encode articles with lines longer than 1000 - characters. - -2000-12-29 01:00:00 ShengHuo ZHU - - * mm-util.el (mm-enable-multibyte): Use - default-enable-multibyte-characters. - (mm-enable-multibyte-mule4): Ditto. - (mm-disable-multibyte): Test XEmacs. - (mm-disable-multibyte-mule4): Ditto. - (mm-with-unibyte-current-buffer): Simplified. - (mm-with-unibyte-current-buffer-mule4): Ditto. - -2000-12-28 19:44:56 Lars Magne Ingebrigtsen - - * nnheaderxm.el (nnheader-string-as-multibyte): New alias. - - * nnheader.el (nnheader-string-as-multibyte): New alias. - - * mm-view.el (mm-inline-text): Warn when bugging out in w3. - - * gnus-uu.el (gnus-message-process-mark): New function. - (gnus-uu-mark-by-regexp): Use it. - (gnus-new-processable): New function. - -2000-12-28 19:21:57 Inge Frick - Trivial patch. - - * gnus-sum.el (gnus-no-mark): New variable. - -2000-11-01 01:12:29 Lars Magne Ingebrigtsen - - * nnwfm.el (nnwfm-create-mapping): Remove quote marks and - backslashes. - -2000-12-26 Katsumi Yamaoka - - * gnus-art.el (gnus-article-banner-alist): Remove duplicate - definition. - -2000-12-25 00:00:00 ShengHuo ZHU - - * dgnushack.el (dgnushack-compile): elc is in the current directory. - - * qp.el (quoted-printable-encode-region): Don't check multibyte in - XEmacs. - -2000-12-25 Lloyd Zusman - Trivial patch. - - * mml.el (mml-read-tag): Save tag location. - -2000-12-25 Simon Josefsson - - * starttls.el: Sync with Emacs 21. - -2000-12-24 11:00:00 ShengHuo ZHU - - * message.el (message-mail): Support yank-action. - - * message.el (message-setup): Revoke the last change. - -2000-12-24 01:00:00 ShengHuo ZHU - - * message.el (message-setup): Use cons. Suggested by Johan Vromans - . - -2000-12-24 Simon Josefsson - - * mm-bodies.el (mm-decode-content-transfer-encoding): Preserve - mailing list junk at end of part. - -2000-12-23 Simon Josefsson - - * nnimap.el (nnimap-expiry-target): New function. - (nnimap-request-expire-articles): Use it. - -2000-12-22 21:00:00 ShengHuo ZHU - - * gnus.el (gnus-group-parameters-more): New variable. - * gnus-cus.el (gnus-group-customize): Use it. - - * gnus.el (gnus-define-group-parameter): New macro. - (auto-expire): Use it - (total-expire): Use it. - * gnus-art.el (banner): Use it. - - * mml.el (mml-parse): save-excursion. Suggested by Lloyd Zusman - . - -2000-12-22 12:00:00 ShengHuo ZHU - - * gnus-topic.el (gnus-topic-create-topic): Use list. - - * gnus-vm.el (gnus-summary-save-article-vm): Require gnus-art - before binding gnus-default-article-saver. - - * gnus-sum.el (gnus-summary-save-article): - (gnus-summary-pipe-output): - (gnus-summary-save-article-mail): - (gnus-summary-save-article-rmail): - (gnus-summary-save-article-file): - (gnus-summary-write-article-file): - (gnus-summary-save-article-body-file): Ditto. - - * gnus-mh.el (gnus-summary-save-article-folder): Ditto. - -2000-12-22 10:00:00 ShengHuo ZHU - - * gnus-art.el (gnus-mime-security-button-map): - (gnus-mime-button-map): Add parent. - -2000-12-22 09:00:00 ShengHuo ZHU - - * messagexmas.el (message-xmas-redefine): New function. - - * message.el: Use it. - - * gnus-art.el (gnus-article-check-hidden-text): Return t. - - * gnus-util.el (gnus-remove-text-properties-when): Return t. - -2000-12-22 03:00:00 ShengHuo ZHU - - * mm-decode.el (mm-dissect-multipart): Avoid errors owing to - malformatted messages. - -2000-12-22 02:00:00 ShengHuo ZHU - - * mm-util.el (mm-image-load-path): New function. - - * gnus-group.el (gnus-group-make-tool-bar): Use it. - - * gnus-sum.el (gnus-summary-make-tool-bar): Use it. - - * message.el (message-tool-bar-map): Use it. - - * Makefile.in (install-el): New rule. - -2000-12-21 Katsumi Yamaoka - - * gnus-art.el (article-treat-dumbquotes): Quote \. - -2000-12-21 22:00:00 ShengHuo ZHU - - * gnus-art.el (gnus-treat-emphasize): Don't treat emphasis if - Emacs 20 runs on a terminal. - -2000-12-21 14:00:00 ShengHuo ZHU - - * gnus-msg.el (gnus-bug): Revert to save-excursion. - - * mml.el (gnus-add-minor-mode): Autoload. - - * message.el (message-forward): Save-restriction. - -2000-12-21 Kai Gro,b_(Bjohann - - * gnus-art.el (article-treat-dumbquotes): More doc, provided by - Paul Stevenson - -2000-12-21 10:00:00 ShengHuo ZHU - - * gnus-ml.el (gnus-mailing-list-mode-map): Use C-c C-n prefix. - - * mml.el (gnus-ems): Don't require. - - * gnus.el (gnus-decode-rfc1522): Removed. - (gnus-set-text-properties): Define. - -2000-12-21 09:00:00 ShengHuo ZHU - - * gnus-art.el (gnus-mime-*): handle may be nil. - - * gnus-sum.el (gnus-summary-mode): Turn on gnus-mailing-list-mode. - - * gnus.el (gnus-group-remove-excess-properties): Not defined - in gnus-xmas. - -2000-12-20 21:00:00 ShengHuo ZHU - - * message.el (message-mail-user-agent): Add :version. - -2000-12-21 Miles Bader - - * message.el (message-mode): Set `comment-start' to the yank prefix. - -2000-12-20 17:00:00 ShengHuo ZHU - - * message.el (message-mail-user-agent): New variable. - (message-setup): Renamed to message-setup-1. Support - mail-user-agent. - (message-mail-user-agent): New function. - (message-mail): Use it. - (message-reply): Use it. - (message-resend): Use it. - (message-mail-other-window): Use it. - (message-mail-other-frame): Use it. - - * gnus-msg.el (gnus-bug): Support mail-user-agent. - -2000-12-20 15:00:00 ShengHuo ZHU - - * message.el (message-tool-bar-map): Simplify. - (message-narrow-to-head-1): New function. - (message-narrow-to-head): Use it. - (message-reply): Ditto. - (message-cancel-news): Ditto. - (message-supersede): Ditto. - (message-make-forward-subject): Ditto. - (message-bounce): Ditto. - -2000-12-20 11:00:00 ShengHuo ZHU - - * uudecode.el (uudecode-decode-region-external): make-temp-file - may not be defined. - - * binhex.el (defalias): eval-and-compile. - - * message.el (message-tool-bar-map): New function. - (message-mode): Use it. - -2000-12-20 09:00:00 ShengHuo ZHU - - * nntp.el (nntp-find-connection): Remove the entry. - (nntp-retrieve-groups): (gnus-buffer-live-p buf). - -2000-12-20 05:00:00 ShengHuo ZHU - - * gnus-msg.el (gnus-summary-mail-forward): Use original buffer. - - * message.el (message-forward): Copy buffer in unibyte mode. - -2000-12-20 04:00:00 ShengHuo ZHU - - * message.el (message-make-forward-subject): Don't widen. Decode. - (message-forward): Don't decode subject. - -2000-12-20 Christoph Conrad - - * qp.el (quoted-printable-encode-region): Upcase QP. - -2000-12-20 03:00:00 ShengHuo ZHU - - * mm-decode.el (mm-possibly-verify-or-decrypt): Use - mail-extract-a-c instead. Don't depend on Gnus. - - * mml.el (gnus-ems): Require it. - - * gnus-msg.el (gnus-summary-mail-forward): - - * message.el (message-forward): Move mime-to-mml here. - -2000-12-20 02:00:00 ShengHuo ZHU - - * gnus-group.el, gnus-sum.el, message.el: Add :help unless Emacs. - * gnus-art.el (gnus-insert-mime-button): Simplify. - (gnus-mime-display-alternative): Ditto. - (gnus-insert-mime-security-button): Ditto. - -2000-12-20 01:00:00 ShengHuo ZHU - - * gnus-util.el (gnus-add-text-properties-when): In XEmacs, - text-property-not-all doesn't return nil when start=mark(end). - (gnus-remove-text-properties-when): Ditto. - -2000-12-20 00:00:00 ShengHuo ZHU - - * gnus-start.el (gnus-group-change-level): Remove group from - gnus-active-hashtb if real killed. - -2000-12-19 22:00:00 ShengHuo ZHU - - * gnus-art.el (gnus-insert-mime-button): Emacs20 needs local-map. - (gnus-mime-display-alternative): Ditto. - (gnus-insert-mime-security-button): Ditto. - -2000-12-19 21:00:00 ShengHuo ZHU - - * gnus-start.el (gnus-group-change-level): Don't add it into - killed-list if it was killed. - -2000-12-19 19:00:00 ShengHuo ZHU - - * nnmbox.el (nnmbox-file-coding-system): Use binary. - (nnmbox-active-file-coding-system): Ditto. - - * gnus-cus.el (gnus-group-parameters): Add posting-style. - -2000-12-19 18:00:00 ShengHuo ZHU - - * gnus.el (gnus-version): - (gnus-version-number): Set to Oort Gnus 0.01. - - * gnus-art.el (gnus-mime-security-button-map): - (gnus-insert-mime-security-button): Fix for Emacs21. - -2000-12-19 17:00:00 ShengHuo ZHU - - * gnus-group.el, gnus-sum.el, message.el: Comment out :help in - easymenu, because XEmacs doesn't understand :help. - - * mm-uu.el: Require binhex. - -2000-12-19 16:00:00 ShengHuo ZHU - - * gnus.el: Merged. Emacs21 CVS tag is zsh-merge-ognus-1. - -2000-12-19 ShengHuo ZHU - - * mm-util.el (mm-charset-synonym-alist): Fix a typo. - -2000-12-18 Gerd Moellmann - - * *.xpm, *.pbm: Convert icons icons to size 24x24. - -2000-12-18 Dave Love - - * gnus-msg.el (news-setup, news-reply-mode): Don't autoload - (unused). - -2000-12-13 Miles Bader - - * smiley-ems.el (smiley-region): Bind `inhibit-point-motion-hooks' - to t, so that we don't get stuck while trying to smilefy - intangible text. - -2000-12-12 Gerd Moellmann - - * smiley-ems.el (smiley-regexp-alist): Make regexps match - at the end of the buffer. - (smiley-region): In the loop, move to the end of the submatch - matching the smiley instead of using the end of the match - of the whole regexp. - -2000-12-12 Eli Zaretskii - - * message.el (message-mode): Doc fix. - -2000-12-12 Gerd Moellmann - - * smiley-ems.el (smiley-region): Doc fix. - -2000-12-11 Miles Bader - - * gnus-sum.el (gnus-summary-recenter): When trying to keep the - bottom line visible, check to see if it's partially obscured, and - if so, either scroll one more line to make it fully visible, or - revert to showing the second line from the top. - -2000-12-07 Dave Love - - * mailcap.el (mailcap-download-directory) - * gnus-audio.el (gnus-audio-directory) - * smiley-ems.el (smiley-data-directory): Fix :type. - -2000-11-30 Dave Love - - * message.el (message-auto-save-directory): Use - file-name-as-directory. - (message-set-auto-save-file-name): Create - message-auto-save-directory if necessary. - (message-replace-chars-in-string): Removed -- unused. - (message-mail-alias-type): Customize. - (message-headers): Remove duplicate defgroup. - -2000-11-29 Dave Love - - * qp.el (quoted-printable-decode-region): Use error, not message - to report malformed text (like base64). Amend message. - -2000-11-29 Miles Bader - - * message.el (message-header-lines): Fontify tag. - -2000-11-27 Dave Love - - * nnlistserv.el: Ignore errors when requiring nnweb and avoid a - compiler warning. - -;2000-11-26 Dave Love -; -; * mm-uu.el (mm-uu-configure-list): Fix typo in :type. -; -2000-11-23 Dave Love - - * uu-post.pbm, uu-decode.pbm: new files from XPMs. - - * mm-uu.el (uudecode): Require. - (uudecode-decode-region, uudecode-decode-region-external): Don't - autoload. - (mm-uu-copy-to-buffer): Doc fix. - (mm-uu-decode-function, mm-uu-binhex-decode-function): Doc, custom - type fix. - - * mailcap.el: Doc fixes. - (mailcap-mime-data): Various adjustments. - (mailcap): New group. - (mailcap-download-directory): Customize. - (mailcap-generate-unique-filename, mailcap-binary-suffixes) - (mailcap-temporary-directory): Deleted (unused). - (mailcap-unescape-mime-test): Simplify slightly. - (mailcap-viewer-passes-test): Use functionp. - (mailcap-command-p): Aliased to executable-find. - - * rfc2047.el (rfc2047-encode-message-header): Don't encode if - default-enable-multibyte-characters is nil. - -2000-11-22 Gerd Moellmann - - * gnus-group.el (gnus-group-make-tool-bar): Fix a paren typo. - -2000-11-21 Dave Love - - * gnus-art.el (gnus-mime-button-map): Don't inherit from - gnus-article-mode-map. -; (gnus-mime-button-menu): Use mouse-set-point. - (gnus-insert-mime-button, gnus-mime-display-alternative) - (gnus-mime-display-alternative): Don't use local-map property. - -2000-11-17 Dave Love - - * uudecode.el (uudecode-insert-char): Fix bogus feature test. - (uudecode-decode-region-external): Doc fix. Use with-temp-buffer - and make-temp-file. - (uudecode-decode-region): Doc fix. - -2000-11-14 Dave Love - - * cu-exit.pbm, exit-summ.pbm, followup.pbm, fuwo.pbm: - * mail-reply.pbm, next-ur.pbm, post.pbm, prev-ur.pbm: - * reply-wo.pbm, reply.pbm, rot13.pbm, save-aif.pbm, save-art.pbm: - New files, derived from the XPMs. - -2000-11-10 Dave Love - - * gnus-agent.el (gnus-agent-confirmation-function): Add :version. - (gnus-agent-lib-file, gnus-agent-load-alist) - (gnus-agent-save-alist, gnus-agent-article-name): Use - expand-file-name. - - * gnus-group.el (gnus-group-name-charset-method-alist): Add - :version. - (nnkiboze-score-file): Defvar when compiling. - - * gnus-start.el (gnus-read-newsrc-file): Add :version. - - * gnus-art.el (gnus-article-banner-alist) - (gnus-emphasize-whitespace-regexp, gnus-ignored-mime-types) - (gnus-article-date-lapsed-new-header) - (gnus-article-mime-match-handle-function, gnus-mime-action-alist) - (gnus-treat-strip-list-identifiers, gnus-treat-date-iso8601) - (gnus-treat-strip-headers-in-body) - (gnus-treat-capitalize-sentences, gnus-treat-play-sounds) - (gnus-treat-translate): Add :version. - (gnus-article-mime-part-function): Fix defcustom. - - * nnmail.el (nnmail-expiry-target) - (nnmail-scan-directory-mail-source-once, nnmail-extra-headers) - (nnmail-split-header-length-limit): Add :version. - - * gnus-sum.el (gnus-auto-expirable-marks) - (gnus-inhibit-user-auto-expire, gnus-list-identifiers) - (gnus-extra-headers, gnus-ignored-from-addresses) - (gnus-newsgroup-ignored-charsets) - (gnus-group-highlight-words-alist) - (gnus-summary-show-article-charset-alist): Add :version. - - * catchup.pbm, describe-group.pbm, exit-gnus.pbm, get-news.pbm: - gnntg.pbm, kill-group.pbm, subscribe.pbm, unsubscribe.pbm: New - files, converted from the XPMs. - - * gnus-cache.el (gnus-cache-active-file): Don't use - file-name-as-directory on directory. - (gnus-cache-file-name): Use expand-file-name, not concat. Don't - use file-name-as-directory on directory. - - * time-date.el (timezone-make-date-arpa-standard): Autoload. - (date-to-time): Use it. - -; * message.el (message-mode) : -; : Use [:alnum:] in regexp range. -; (message-newline-and-reformat): Likewise. - (message-forward-as-mime, message-forward-ignored-headers) - (message-buffer-naming-style, message-default-charset) - (message-dont-reply-to-names, message-send-mail-partially-limit): - Add :version. - - * mm-util.el: Doc fixes. - (mm-mime-charset): Don't use the raw result of - mm-preferred-coding-system. - (mm-with-unibyte-buffer, mm-with-unibyte-current-buffer) - (mm-with-unibyte): Simplify. - - * gnus-int.el (gnus-start-news-server): Use expand-file-name, not - concat. - - * pop3.el (pop3-version): Deleted. - (pop3-make-date): New function, avoiding message-make-date. - (pop3-munge-message-separator): Use it. - -2000-11-09 Dave Love - - * gnus-group.el (gnus-group-make-directory-group) - (gnus-group-fetch-faq): Use expand-file-name. - (gnus-group-fetch-faq): Simplify completing-read form. - - * mm-bodies.el (mm-encode-body): Use mm-multibyte-p, don't just - test for Mule. - - * message.el (tool-bar-map): Defvar when compiling. - - * gnus-setup.el (running-xemacs, gnus-use-installed-tm) - (gnus-tm-lisp-directory): Deleted. - (gnus-use-installed-mailcrypt, gnus-emacs-lisp-directory): Use - (featurep 'xemacs). - (gnus-gnus-lisp-directory, gnus-mailcrypt-lisp-directory) - (gnus-mailcrypt-lisp-directory, gnus-bbdb-lisp-directory): Remove - version numbers from file names. - -2000-11-08 Dave Love - - * mm-view.el: Use featurep for XEmacs test. - (mm-inline-message): Test for `remove-specifier'; don't use - condition-case. - - * mm-bodies.el (mm-encode-body): Use mm-multibyte-p. - - * gnus-score.el (gnus-score-load-file): Use expand-file-name. - (gnus-score-find-bnews): Don't concat "". - - * cu-exit.xpm, prev-ur.xpm, next-ur.xpm, post.xpm, fuwo.xpm: - * followup.xpm, uu-post.xpm, uu-decode.xpm, mail-reply.xpm: - * reply.xpm, reply-wo.xpm, rot13.xpm, save-aif.xpm, save-art.xpm: - * exit-summ.xpm: New files, renamed from icons by Luis Fernandes. - - * gnus-sum.el: Put some defvars in eval-when-compile. - (gnus-summary-mode-hook): Add :options. - (gnus-summary-make-menu-bar): Add some :help, used by tool bar. - (gnus-summary-tool-bar-map): New variable. - (gnus-summary-make-tool-bar): New function. - (gnus-summary-mode): Put kill-all-local-variables first. - - * gnus-group.el (gnus-group-toolbar-map): New variable. - (gnus-group-make-tool-bar): Rewritten. - (gnus-group-mode): Put kill-all-local-variables first. - - * rfc2047.el: Require gnus-util. - - * nnml.el (gnus-sorted-intersection): Autoload. - - * nnheader.el: Wrap subst-char-in-string def in eval-and-compile. - Put some defvars in eval-when-compile. - (gnus-intersection, gnus-sorted-complement): Autoload. - - * imap.el (imap-point-at-eol): New, replacing gnus-point-at-eol. - - * mm-encode.el (mm-body-7-or-8): Autoload. - - * mm-decode.el (mm-insert-inline): Autoload. - - * mml.el: - * message.el: Put some defvars in eval-when-compile. - - * gnus-msg.el: Put some defvars in eval-when-compile. - (gnus-msg-mail): Move after gnus-setup-message. - - * smiley-ems.el (smiley-data-directory, smiley-regexp-alist): Doc fix. - -2000-11-07 Dave Love - - * gnus-util.el (nnheader): Don't require message (recursive - autoload). - - * uudecode.el: Avoid compiler warnings. - - * rfc2047.el: (rfc2047-fold-region): Use gnus-point-at-bol. - (rfc2047-charset-encoding-alist): Add iso-8859-1[45]. - -2000-11-06 Dave Love - - * gnus-salt.el (gnus-binary-mode): Fix call to gnus-add-minor-mode. - - * uudecode.el: Use (featurep 'xemacs). Require cl when compiling. - (uudecode-char-int): New alias, replacing char-int. - (uudecode-decode-region): Don't call buffer-disable-undo. - -; * mm-uu.el (mm-uu-configure): Unquote lambda. -; (mm-uu-configure-list): Doc fix. -; -; * earcon.el (running-xemacs): Don't define. -; -;2000-11-03 Stefan Monnier -; -; * message.el (message-font-lock-keywords): Match a final newline -; to help font-lock's multiline support. -; -2000-11-03 Dave Love - - * gnus-nocem.el (gnus-nocem-check-article-limit): Default to 500. - - * mm-partial.el (mm-inline-partial): Space-prefix temp buffer - name. - - * gnus-cus.el (gnus-group-parameters) : Fix custom type. - : Fix custom type, doc. - - * mm-decode.el (mm-display-external): Space-prefix temp buffer - name. Don't disable undo explicitly. - -;2000-11-02 Dave Love -; -; * message.el (message-font-lock-keywords): Use [:alpha:] for -; cite-prefix. - -2000-11-01 Dave Love - - * rfc2047.el (base64): Require unconditionally. - (message-posting-charset): Defvar when compiling. - (rfc2047-encode-message-header, rfc2047-encodable-p): Require - message. - - * gnus-sum.el (nnoo): Require. - (mm-uu-dissect): Autoload. - - * mml.el (mml-parse-1): Clarify message. - (mml-minibuffer-read-type): Use mailcap-mime-types. - -2000-11-01 Stefan Monnier - - * mml.el: Fix a typo in the requiring of CL. - -2000-11-01 Dave Love - - * utf7.el: Require cl when compiling. - - * binhex.el: Use (featurep 'xemacs). - (binhex-char-int): New alias, replacing char-int. Change callers. - (binhex-decode-region): Simplify work buffer code. - (binhex-decode-region-external): Use expand-file-name, not concat. - -2000-10-30 Dave Love - - * gnus-art.el: Fix 2000-10-27 change properly. - -2000-10-28 Miles Bader - - * gnus-art.el (gnus-read-save-file-name): Remove extraneous paren. - -2000-10-27 Dave Love - - * gnus-group.el (gnus-group-make-menu-bar): Add some :help - strings. - (gnus-group-make-tool-bar): New function. - (gnus-group-mode): Use it. - - * message.el (message-mode-menu): Add some :help strings. - (message-mode) [message-tool-bar-map]: Define tool-bar-map. - (featurep): Use (featurep 'xemacs). Install tool bar for Emacs. - - * catchup.xpm, exit-gnus.xpm, gnntg.xpm, subscribe.xpm: - * describe-group.xpm, get-news.xpm, kill-group.xpm: - * unsubscribe.xpm: New files. Renamed icons from Luis Fernandes. - - * mm-decode.el (mm-valid-and-fit-image-p): Don't test - display-graphic-p here. - -2000-10-27 Miles Bader - - * gnus-ems.el (gnus-ems-redefine): Use (featurep 'xemacs) instead - of the `gnus-xemacs' variable, as the latter has been removed. - * gnus-start.el (gnus-1, gnus-read-descriptions-file): Likewise. - * gnus-art.el (gnus-treat-display-xface) - (gnus-treat-display-smileys, gnus-treat-display-picons) - (gnus-article-read-summary-keys): Likewise. - -2000-10-26 Dave Love - - (defvar): Use rmail-spool-directory unconditionally. - -2000-10-18 Dave Love - - * mm-bodies.el (mm-uu-decode-function) - (mm-uu-binhex-decode-function): Defvar when compiling. - - * gnus-nocem.el (gnus-nocem-issuers): Update. - (gnus-nocem-check-from): New option. - (gnus-nocem-scan-groups): Use it. - (gnus-nocem-check-article): Bind gnus-newsgroup-name. - (gnus-nocem-check-article-limit): Add :version. - -2000-10-16 Stefan Monnier - - * ietf-drums.el (mm-util): Require CL when compiling. - -2000-10-15 Dave Love - - * qp.el: Require mm-util. - -2000-10-13 Dave Love - - * qp.el (quoted-printable-decode-region): Avoid invalid - coding-systems. - -2000-10-12 Gerd Moellmann - - * mm-bodies.el: Don't require `mm-uu' at compile-time; it leads - to a recursive load. - -2000-10-12 Dave Love - - * mm-util.el (mm-charset-synonym-alist): Add windows-1252. - - * gnus.el (gnus-group-startup-message): Check for PBM image. - -2000-10-09 Dave Love - - * mail-source.el (mail-source-fetch-imap): Bind - default-enable-multibyte-characters rather than using - mm-disable-multibyte. - -2000-10-05 Dave Love - - * qp.el (mm-decode-coding-region, mm-encode-coding-region): - Autoload. - (quoted-printable-decode-region): Rename arg which confused - charset with coding-system. Don't use nonascii-insert-offset. - Coding-system encode the region initially. Don't recognize `==' - as valid QP. Coding-system decode the region finally. - (quoted-printable-decode-string): Rename arg which confused - charset with coding-system. - - * mm-bodies.el: Require mm-uu, Don't require qp, uudecode. - (mm-encode-body): Apply mm-charset-to-coding-system to arg of - mm-encode-coding-region. - (mm-decode-body, mm-decode-string): Rename variables which - confused charset with coding-system. - (binhex-decode-region): Don't autoload. - (mm-body-encoding): Require message. - (mm-decode-content-transfer-encoding): Require mm-uu in relevant - cond branches. - - * gnus-art.el (article-de-quoted-unreadable) - (article-de-base64-unreadable): Fold search case - rather than downcasing string. Apply mm-charset-to-coding-system - to arg of quoted-printable-decode-region. - -2000-10-04 Dave Love - - * gnus-ems.el: Don't turn off compiler warnings in local vars. - Require ring when compiling. - (gnus-article-compface-xbm): New variable. - -2000-10-04 Dave Love - - * smiley-ems.el (smiley-regexp-alist, smiley-update-cache): Use - pbm images. - - * frown.pbm, smile.pbm, wry.pbm: New files. - - * frown.xbm, smile.xbm, wry.xbm: Deleted. - -2000-10-03 Dave Love - - * mail-source.el (mail-sources): Revert to nil. - - * nnmail.el (nnmail-spool-file): Revert to `((file))'. - - * qp.el: Don't require mm-util. - (quoted-printable-decode-region): Rewritten. - (quoted-printable-decode-string, quoted-printable-encode-region): - Doc fix. - (quoted-printable-encode-region): Barf on multibyte characters. - Maybe make the class multibyte. Upcase chars, not formatted - strings. Allow mm-use-ultra-safe-encoding to be unbound. - (quoted-printable-encode-string): Don't use - mm-with-unibyte-buffer. - -2000-09-29 Gerd Moellmann - - * smiley-ems.el (smiley-update-cache): Use `:ascent center'. - -2000-09-21 Dave Love - - * smiley-ems.el (smiley-region): Test if display-graphic-p bound - (for Emacs 20). Tidy somewhat. - -2000-09-21 Dave Love - - * gnus-ems.el (gnus-article-display-xface): Use unibyte for the - image processing. Rationalize logic somewhat. - -2000-09-20 Dave Love - - * gnus-start.el (gnus-1) : Don't test for X - specifically. - - * gnus.el (gnus-version-number): Avoid some redundant - autoloads. - -2000-09-20 Gerd Moellmann - - * gnus-ems.el (gnus-article-display-xface): Don't convert PBM - to XBM; we always have PBM support. - -2000-09-14 Dave Love - - * gnus.el (gnus-charset): - * mm-decode.el (mime-display): - * imap.el (imap) : Add :version. - -2000-09-13 Gerd Moellmann - - * parse-time.el: Fix author's mail address. - - * earcon.el, flow-fill.el, gnus-cite.el, gnus-gl.el, gnus-ml.el: - * gnus-mlspl.el, gnus-nocem.el, gnus-range.el, gnus-salt.el: - * gnus-setup.el, gnus-soup.el, gnus-undo.el, gnus-vm.el: - * messcompat.el, nnbabyl.el, nndir.el, nneething.el: - * nngateway.el, nnheaderxm.el, nnkiboze.el, nnlistserv.el: - * nnmbox.el, nnmh.el, nnoo.el, nnsoup.el, nnspool.el, rfc2045.el: - * rfc2231.el, uudecode.el: Fix copyright notice. - - * nnweb.el (toplevel): To make the file bootstrap in Emacs, - require `w3' at load-time only if not running in batch mode. - -2000-12-19 16:00:00 ShengHuo ZHU - - * gnus.el: Before merge with Emacs21. - -2000-12-19 Raymond Scholz - - * gnus-art.el (gnus-article-dumbquotes-map): Add EUR symbol. - -2000-12-19 Per Abrahamsen - - * mml.el (mml-mode-map): Change mml prefix from `M-m' to `C-c C-m' - to avoid conflict with the standard `back-to-indentation' - binding. - -2000-12-17 10:00:00 ShengHuo ZHU - - * mm-extern.el (mm-inline-external-body): g-a-m-h may be a handle. - - * mm-util.el (mm-enable-multibyte-mule4): Test charsetp. - (mm-disable-multibyte-mule4): Ditto. - (mm-with-unibyte-current-buffer-mule4): Ditto. - -2000-12-15 10:00:00 ShengHuo ZHU - - * pop3.el (pop3-movemail): Use binary. - (pop3-movemail-file-coding-system): Removed. - -2000-12-14 13:00:00 ShengHuo ZHU - - * mm-util.el (mm-charset-synonym-alist): Add cn-gb. - -2000-12-13 21:00:00 ShengHuo ZHU - - * nnspool.el (nnspool-lib-dir): Check whether /usr/lib/news/active - exists. - -2000-12-13 13:00:00 ShengHuo ZHU - - * gnus-msg.el (gnus-post-method): Use backend name when the - address is "". - -2000-12-08 10:00:00 ShengHuo ZHU - - * gnus-art.el (article-verify-x-pgp-sig): Don't test - mm-verify-option. - (gnus-treat-x-pgp-sig): Default value. - (gnus-ignored-headers): Redundant. - -2000-12-04 22:00:00 ShengHuo ZHU - - * gnus-win.el (gnus-configure-frame): Save selected window. - -2000-02-15 Andrew Innes - - * nnmbox.el: Require gnus-range. - (nnmbox-group-building-active-articles): New variable. - (nnmbox-group-active-articles): New variable; this is a cache of - all active articles by group and number. - (nnmbox-in-header-p): New function. - (nnmbox-find-article): New function. - (nnmbox-record-active-article): New function. - (nnmbox-record-deleted-article): New function. - (nnmbox-is-article-active-p): New function. - (nnmbox-retrieve-headers): Use nnmbox-find-article. - (nnmbox-request-article): Ditto. Also supply extra arg to - nnmbox-article-group-number. - (nnmbox-request-expire-articles): Ditto. - (nnmbox-request-move-article): Ditto. - (nnmbox-request-replace-article): Ditto. - (nnmbox-request-rename-group): Rename group entry in active - article cache. - (nnmbox-delete-mail): Update active article cache, unless article - is being replaced. - (nnmbox-possibly-change-newsgroup): Call nnmbox-read-mbox, rather - than partially duplicating it. - (nnmbox-article-group-number): Add extra `this-line' arg, to - handle articles belonging to multiple groups. - (nnmbox-save-mail): Update active article cache. - (nnmbox-read-mbox): Build active article cache when loading mbox. - Also do some repair work, if we find articles that are missing the - appropriate X-Gnus-Newsgroup lines in the header. We can usually - reconstruct these from Xref info. - -2000-12-04 18:00:00 ShengHuo ZHU - - * mail-source.el (mail-source-report-new-mail): Use - nnheader-run-at-time. - -2000-02-15 Andrew Innes - - * mail-source.el (mail-source-fetch-pop): Clear pop password when - an error is thrown, and then rethrow the error. - (mail-source-check-pop): Ditto. - (mail-source-start-idle-timer): Prevent multiple pop checks - running if the check takes a long time. - -2000-12-04 14:00:00 ShengHuo ZHU - - * gnus-msg.el (gnus-msg-mail): COMPOSEFUNC should return t if - succeed. - -2000-12-04 13:00:00 ShengHuo ZHU - - * gnus-win.el (gnus-configure-windows): Make sure - nntp-server-buffer is live. - (gnus-remove-some-windows): switch-to-buffer -> set-buffer. - -2000-11-21 Stefan Monnier - - * gnus-win.el (gnus-configure-windows): switch-to-buffer -> set-buffer. - -2000-12-04 Andreas Jaeger - - * gnus-msg.el (gnus-summary-mail-forward): Fix typos in description. - -2000-12-03 12:00:00 ShengHuo ZHU - - * mml2015.el (mml2015-fix-micalg): Alg might be nil. - -2000-12-01 ShengHuo ZHU - Trivial patch from Christopher Splinter - - * gnus-sum.el (gnus-summary-limit-to-age): Fix typo. - -2000-12-01 Simon Josefsson - - * mml-smime.el (mml-smime-verify): Fix address parsing. - -2000-12-01 Simon Josefsson - - * mml-smime.el (mml-smime-verify): Don't modify MM buffer. Handle - more than one certificate inside PKCS#7 blob. Better security - information (clamed / actual sender, openssl output, certificates - inside message). - - * smime.el (smime-verify-region): Output to /dev/null. - (smime-buffer-as-string-region): Don't parse empty lines. - -2000-11-30 23:00:00 ShengHuo ZHU - - * gnus-art.el (gnus-mime-security-button-line-format-alist): Add - ?d and ?D. - (gnus-mime-security-show-details-inline): New variable. - (gnus-mime-security-show-details): Use them. - (gnus-insert-mime-security-button): Ditto. - - * mml2015.el (mml2015-gpg-verify): Set details when succeed. - Suggest by Michael Duggan (md5i@cs.cmu.edu). - (mml2015-gpg-clear-verify): Ditto. - (mml2015-gpg-decrypt-1): Ditto. - (mml2015-use): Prefer 'gpg. - -2000-11-30 19:00:00 ShengHuo ZHU - - * gnus-util.el (gnus-add-text-properties-when): New function. - (gnus-remove-text-properties-when): Ditto. - - * gnus-cite.el (gnus-article-hide-citation): Use them. - (gnus-article-toggle-cited-text): Use them. - - * gnus-art.el (gnus-signature-toggle): Use them. - (gnus-article-show-hidden-text): Ditto. - (gnus-article-hide-text): Ditto. - -2000-11-30 14:00:00 ShengHuo ZHU - - * mm-util.el (mm-find-charset-region): Remove eight-bit-*. - -2000-11-30 Simon Josefsson - - * smime.el (smime-point-at-eol): New alias. - (smime-buffer-as-string-region): Use it. - -2000-11-29 21:00:00 ShengHuo ZHU - - * nndraft.el (nndraft-request-restore-buffer): Remove Date field. - -2000-11-29 20:00:00 ShengHuo ZHU - - * nnfolder.el (nnfolder-request-expire-articles): expiry-target. - - * nnbabyl.el (nnbabyl-request-expire-articles): Ditto. - - * nnmbox.el (nnmbox-request-expire-articles): Ditto. - -2000-11-22 Jan Nieuwenhuizen - - * nnmh.el (nnmh-request-expire-articles): Implemented - expiry-target for nnmh backend. - -2000-11-30 Simon Josefsson - - * mm-decode.el (mm-security-from): New variable. - (mm-possibly-verify-or-decrypt): Use it rather than `from'. - - * mml-smime.el (mml-smime-verify): Use `mm-security-from' rather - than `from'. - -2000-11-30 Simon Josefsson - - * mml-smime.el (mml-smime-verify): Verify that certificate mail - address match sender address. - - * mm-decode.el (mm-possibly-verify-or-decrypt): Bind sender address. - - * smime.el (smime-verify-region): Don't copy buffer. - (smime-decrypt-buffer): Use expand-file-name on keyfile. - (smime-pkcs7-region): New function. - (smime-pkcs7-certificates-region): Ditto. - (smime-pkcs7-email-region): Ditto. - (smime-buffer-as-string-region): Ditto. - - * gnus-art.el (gnus-mime-security-show-details): Goto beginning of - buffer. - -2000-11-23 Jens Krinke - - * smime.el (smime-decrypt-region): Fix keyfile argument. - -2000-11-29 00:00:00 ShengHuo ZHU - - * nnmail.el (nnmail-cache-accepted-message-ids): Add doc. - -2000-11-28 17:00:00 ShengHuo ZHU - - * message.el (message-shoot-gnksa-feet): New variable. - (message-gnksa-enable-p): New function. - (message-send): Use it. - (message-check-news-body-syntax): Ditto. - -2000-11-28 Katsumi Yamaoka - - * message.el (message-make-message-id): Remove the redundancy. - -2000-11-22 17:00:00 ShengHuo ZHU - - * message.el (message-setup): Discourage using mc-install-*-mode. - - * gnus-setup.el (gnus-use-mailcrypt): Don't hook mail-crypt. - -2000-11-22 16:00:00 ShengHuo ZHU - - * gnus-cite.el (gnus-cite-parse): Guess citation length. - -2000-11-22 14:00:00 ShengHuo ZHU - - * gnus-ml.el (gnus-mailing-list-insinuate): New function. - -2000-11-22 13:00:00 ShengHuo ZHU - - * gnus-ml.el (gnus-mailing-list-archive): Find the real url. - -2000-11-22 11:00:00 ShengHuo ZHU - - * gnus-xmas.el (gnus-xmas-article-display-xface): Use - insert-buffer-substring. - - * message.el (message-send-mail): Use buffer-substring-no-properties. - (message-send-news): Ditto. - -2000-11-22 David Edmondson - - * imap.el (imap-wait-for-tag): Message read info. - -2000-11-21 20:00:00 ShengHuo ZHU - - * mml2015.el (mml2015-mailcrypt-encrypt): Ensure the part is encrypted. - (mml2015-mailcrypt-encrypt): Use unibyte-buffer. - (mml2015-gpg-encrypt): Ditto. - -2000-11-21 09:00:00 ShengHuo ZHU - - * mm-decode.el (mm-verify-option): Default value. - - * mml-sec.el (mml-secure-part): Error message. - -2000-11-20 18:00:00 ShengHuo ZHU - - * gnus-ml.el (gnus-mailing-list-archive): Use browse-url. - -2000-11-20 17:00:00 ShengHuo ZHU - - * gnus-art.el (gnus-article-make-menu-bar): Use easy-menu-add. - -2000-11-20 16:00:00 ShengHuo ZHU - - * gnus-art.el (gnus-article-describe-key): Use prompt. - (gnus-article-describe-key-briefly): Ditto. - -2000-11-20 15:00:00 ShengHuo ZHU - - * gnus-agent.el (gnus-agent-expire): Ignore corrupted history. - -2000-11-20 10:00:00 ShengHuo ZHU - - * gnus-art.el (gnus-article-describe-key): New function. - (gnus-article-describe-key-briefly): New function. - -2000-11-19 23:00:00 ShengHuo ZHU - - * mm-decode.el (mm-decrypt-option): Doc typo. - - * gnus-art.el (gnus-article-read-summary-keys): lookup-key may - return a number. - -2000-11-19 21:00:00 ShengHuo ZHU - - * message.el (message-newline-and-reformat): Typo. - -2000-11-19 12:00:00 ShengHuo ZHU - - * gnus-art.el (article-verify-x-pgp-sig): Check whether - original-article-buffer exists. - - * rfc2047.el (rfc2047-q-encoding-alist): Match Resent-. - (rfc2047-header-encoding-alist): Addresses are different from text. - (rfc2047-encode-message-header): Ditto. - (rfc2047-dissect-region): Extra parameter. - (rfc2047-encode-region): Ditto. - (rfc2047-encode-string): Ditto. - -2000-11-19 00:00:00 ShengHuo ZHU - - * mm-uu.el (mm-uu-pgp-encrypted-extract-1): New function. - (mm-uu-pgp-encrypted-extract): Use it. - (mm-uu-pgp-signed-extract-1): New function. - (mm-uu-pgp-signed-extract): Use it. - - * gnus-art.el (gnus-mime-display-security): New function. - (gnus-mime-display-part): Use it. - (gnus-mime-security-verify-or-decrypt): New function. - (gnus-mime-security-press-button): New function. - (gnus-insert-mime-security-button): Use it. - - * mm-decode.el (mm-possibly-verify-or-decrypt): Use mm-h-m-c-p. - (mm-find-raw-part-by-type): Ditto. - (mm-verify-function-alist): Add x-gnus-pgp-signature handle. - (mm-decrypt-function-alist): Add x-gnus-pgp-encrypted handle. - (mm-destroy-parts): Kill nested multibyte buffer. - - * mml2015.el (mml2015-mailcrypt-verify): Use mm-h-m-c-p. - (mml2015-gpg-verify): Ditto. - -2000-11-18 Simon Josefsson - - * mml2015.el (mml2015-mailcrypt-clear-verify): New function. - (mml2015-function-alist): Use it. - - * mml-sec.el (mml-sign-alist): Update names. - (mml-encrypt-alist): Ditto. - (mml-secure-part-smime-sign): Moved to mml-smime.el - as `mml-smime-sign-query'. - (mml-secure-part-smime-encrypt-by-file): Moved to mml-smime.el as - `mml-smime-get-file-cert'. - (mml-secure-part-smime-encrypt-by-dns): Moved to mml-smime.el as - `mml-smime-get-dns-cert'. - (mml-secure-part-smime-encrypt): Moved to mml-smime.el as - `mml-smime-encrypt-query'. - (mml-smime-sign-buffer): Use mml-smime-sign. - (mml-smime-encrypt-buffer): Use mml-smime-encrypt. - - * mml-smime.el (mml-smime-sign): New function. - (mml-smime-encrypt): - (mml-smime-sign-query): - (mml-smime-get-file-cert): - (mml-smime-get-dns-cert): - (mml-smime-encrypt-query): Moved from mml-sec.el. - -2000-11-16 Simon Josefsson - - * mml2015.el (mml2015-gpg-clear-verify): New function. - (mml2015-function-alist): Add it. - -2000-11-17 14:21 ShengHuo ZHU - - * message.el (message-setup-fill-variables): Use - message-cite-prefix-regexp. - (message-newline-and-reformat): Check the end of citation, leading - WSP, break in the cite prefix. - (message-fill-paragraph): New function. - -2000-11-17 13:44 ShengHuo ZHU - - * lpath.el: Shut up. - -2000-11-17 Per Abrahamsen - - * gnus-msg.el (gnus-group-posting-charset-alist): No longer allow - raw 8-bit in headers in dk.* newsgroups. - -2000-11-17 08:02 ShengHuo ZHU - - * message.el (message-newline-and-reformat): Match extra WSPs. - -2000-11-16 23:31 ShengHuo ZHU - - * mml.el (mml-generate-mime-1): Ignore ascii. - -2000-11-16 Justin Sheehy - - * gnus-sum.el (gnus-summary-make-menu-bar): Fix menu items. - -2000-11-16 17:00 ShengHuo ZHU - - * message.el (message-cite-prefix-regexp): Prefix should not end - at space. - -2000-11-15 18:09 ShengHuo ZHU - - * message.el (message-mode-syntax-table): Add - as a word - constituent as in articles. - (message-setup-fill-variables): Add -_. as supercite-style prefix. - * gnus-art.el (gnus-article-mode-syntax-table): Remove ?-. - * gnus-cite.el (gnus-cite-parse): Match from the beginning of line. - -2000-11-15 13:21 ShengHuo ZHU - - * gnus-msg.el (gnus-inews-do-gcc): Expire the article. - -2000-11-12 David Edmondson - - * message.el (message-font-lock-keywords): use - message-cite-prefix-regexp. - -2000-11-15 Kai Gro,b_(Bjohann - - * gnus-group.el (gnus-group-jump-to-group-prompt): New variable by - Stein Arild Str,Ax(Bmme. - (gnus-group-jump-to-group): Use it. - (gnus-group-jump-to-group-prompt): Customize. - -2000-11-14 10:32:42 ShengHuo ZHU - - * mailcap.el (mailcap-possible-viewers): Match the entire string. - -2000-11-14 10:20:56 ShengHuo ZHU - - * mml2015.el (mml2015-mailcrypt-verify): replace-match is - incompatible. - (mml2015-mailcrypt-sign): Ditto. - -2000-11-14 10:12:05 ShengHuo ZHU - - * gnus-msg.el (gnus-inews-do-gcc): Update summary data when the - group is open. - -2000-11-14 00:48:52 ShengHuo ZHU - - * gnus-bcklg.el (gnus-backlog-enter-article): Don't enter - nnvirtual articles. - (gnus-backlog-request-article): Don't request nnvirtual articles. - -2000-11-13 22:08:09 ShengHuo ZHU - - * mml2015.el (mml2015-mailcrypt-sign): Remove "-" escape. - * mml.el (mml-generate-mime-1): Save cont. skip multipart attributes. - -2000-11-13 20:43:37 ShengHuo ZHU - - * mm-decode.el (mm-get-part): Don't call mm-insert-part. - * mml.el (mml-generate-mime-1): Use charset attribute. - * mm-bodies.el (mm-encode-body): Add parameter charset. - * mm-util.el (mm-mime-charset): Show error when find 8-bit characters. - -2000-11-13 16:09:09 ShengHuo ZHU - - * mml2015.el (mml2015-mailcrypt-decrypt): Handle quit. - (mml2015-mailcrypt-clear-decrypt): Ditto. - (mml2015-mailcrypt-verify): Ditto. - (mml2015-mailcrypt-clear-verify): Ditto. - (mml2015-gpg-verify): Ditto. - -2000-11-13 15:29:58 ShengHuo ZHU - - * smime.el (smime-openssl-program): Test the existence of openssl. - * mml-smime.el: Require mm-decode. - (mml-smime-verify-test): New function. - * mm-decode.el (mm-verify-function-alist): Use it. - -2000-11-13 09:50:29 ShengHuo ZHU - - * gnus-sum.el (gnus-summary-repair-multipart): Fix Mime-Version - anyway. - -2000-11-13 Simon Josefsson - - * mm-uu.el (mm-uu-pgp-signed-extract): Explain why clear - verification doesn't work. - -2000-11-12 23:36:45 ShengHuo ZHU - - * gnus-msg.el (gnus-inews-mark-gcc-as-read): New variable. - (gnus-inews-do-gcc): Use it. - -2000-11-12 21:35:04 ShengHuo ZHU - - * rfc2231.el (rfc2231-encode-string): Insert semi-colon and - leading space. - * mm-extern.el (mm-inline-external-body): Report error when no - access-type. - -2000-11-12 19:48:30 ShengHuo ZHU - - * gnus-sum.el (gnus-select-newsgroup): Change the error message. - -2000-11-12 11:53:18 ShengHuo ZHU - - * gnus-art.el (gnus-mime-button-menu): Use select-window. - -2000-11-12 09:47:54 ShengHuo ZHU - - * gnus-art.el (gnus-mime-display-part): Display multipart/related - as multipart/mixed. - -2000-11-12 David Edmondson - - * message.el (message-cite-prefix-regexp): moved from gnus-cite.el - and replace `.' with `\w' to allow for different syntax tables - (from Vladimir Volovich). - * message.el (message-newline-and-reformat): use - `message-cite-prefix-regexp'. - * gnus-cite.el (gnus-supercite-regexp): use - `message-cite-prefix-regexp'. - * gnus-cite.el (gnus-cite-parse): use - `message-cite-prefix-regexp'. - -2000-11-12 08:52:46 ShengHuo ZHU - - * mml2015.el (mml2015-mailcrypt-verify): Replace armors with - PGP SIGNATURE. Escape leading "-"'s. - (mml2015-mailcrypt-sign): Replace armors with PGP MESSAGE. - -2000-11-11 15:55:35 ShengHuo ZHU - - * mm-uu.el (mm-uu-type-alist): Stricter shar regexp. - -2000-11-11 Simon Josefsson - - * mml2015.el (mml2015-gpg-verify): Set "OK" security status. - - * smime.el (smime-details-buffer): New variable. - (smime-sign-region): - (smime-encrypt-region): - (smime-verify-region): - (smime-decrypt-region): Copy OpenSSL output to the buffer. - - * mml-smime.el (mml-smime-verify): Support security info. - -2000-11-10 17:11:22 ShengHuo ZHU - - * mm-decode.el (mm-verify-option): Set default to nil. - (mm-decrypt-option): Ditto. - * gnus-art.el (article-verify-x-pgp-sig): New function. - -2000-11-10 09:01:25 ShengHuo ZHU - - * gnus-art.el (gnus-mime-display-alternative): Show button if no - preferred part. - -2000-11-07 Kai Gro,b_(Bjohann - - * gnus-sum.el (gnus-move-split-methods): Say that - `gnus-split-methods' uses file names, whereas this uses group - names. (Report from Nevin Kapur) - -2000-11-10 01:23:20 ShengHuo ZHU - - * mm-partial.el (mm-inline-partial): Insert MIME-Version. - -2000-11-09 17:02:50 ShengHuo ZHU - - * nnheader.el (nnheader-directory-files-is-safe): New variable. - (nnheader-directory-articles): Use it. - (nnheader-article-to-file-alist): Ditto. - -2000-11-09 16:20:37 ShengHuo ZHU - - * rfc2047.el (rfc2047-pad-base64): New function. - (rfc2047-decode): Use it. - -2000-11-09 08:53:04 ShengHuo ZHU - - * gnus-srvr.el (gnus-browse-foreign-server): Bind the original - select method. - -2000-11-08 19:58:58 ShengHuo ZHU - - * mml2015.el (mml2015-gpg-decrypt-1): - (mml2015-gpg-verify): buffer-string has no argument in Emacs. - -2000-11-08 16:37:02 ShengHuo ZHU - - * gnus-cache.el (gnus-cache-generate-nov-databases): Reopen cache. - -2000-11-08 08:38:30 ShengHuo ZHU - - * pop3.el (pop3-munge-message-separator): A message may have an - empty body. - -2000-11-07 18:02:26 ShengHuo ZHU - - * mm-uu.el (mm-uu-type-alist): Don't test pgp stuff. - (mm-uu-pgp-encrypted-extract): Clean mml2015 buffer. - (mm-uu-pgp-signed-extract): Use coding-system. - -2000-11-07 14:33:19 ShengHuo ZHU - - * gnus-art.el (gnus-mime-display-part): Show MIME security button. - (gnus-insert-mime-security-button): New function. - * mm-decode.el (mm-possibly-verify-or-decrypt): Add security info. - * mml2015.el: Add security info when verify or decrypt. - * mm-uu.el (mm-uu-pgp-signed-extract): Use multipart. - (mm-uu-pgp-encrypted-extract): Ditto. - -2000-11-07 08:49:36 ShengHuo ZHU - - * mm-decode.el (mm-display-parts): New function. - * gnus-art.el (gnus-mime-view-all-parts): Use it. Remove parts first. - -2000-02-02 Alexandre Oliva - - * gnus-mlspl.el: Documentation tweaks. - -2000-11-06 22:06:44 ShengHuo ZHU - - * mm-decode.el (mm-possibly-verify-or-decrypt): Fix. - * gnus-art.el (gnus-article-encrypt-body): Rename and support prefix - argument. - -2000-11-06 19:10:14 ShengHuo ZHU - - * rfc2231.el (rfc2231-encode-string): Use us-ascii if charset is nil. - -2000-11-06 18:17:53 ShengHuo ZHU - - * gnus-art.el (gnus-article-encrypt): New function. - (gnus-article-encrypt-protocol-alist): New variable. - (gnus-article-encrypt-protocol): New variable. - * mml2015.el (mml2015-self-encrypt): New function. - (mml2015-mailcrypt-encrypt): Set mc-pgp-always-sign. - -2000-11-06 16:02:52 ShengHuo ZHU - - * mm-uu.el (mm-uu-gpg-key-skip-to-last): New function. - (mm-uu-pgp-key-extract): Use application/pgp-keys, don't snarf, - let mailcap do it. - * mml2015.el: Remove snarf code. - * mm-decode.el: Remove snarf code. - -2000-11-06 14:03:10 ShengHuo ZHU - - * mml.el (mml-insert-mml-markup): Ignore internal stuff. - (mml-insert-mime): Understand gnus-decoded. - (mime-to-mml): New parameter handles. - * gnus-art.el (gnus-mime-save-part-and-strip): Use it. - * gnus-sum.el (gnus-summary-edit-article): Add argument `3'. - -2000-11-06 13:51:37 ShengHuo ZHU - - * mm-decode.el (mime-security): New group. - (mm-verify-function-alist): Add test function. - (mm-decrypt-function-alist): Ditto. - (mm-snarf-option): Set default value as nil. - (mm-find-part-by-type): Recursive parameter. - (mm-possibly-verify-or-decrypt): Support draft-ietf-openpgp-multsig. - * mml2015.el: Support draft-ietf-openpgp-multsig. - -2000-11-06 13:01:27 ShengHuo ZHU - - * gnus-art.el (gnus-mime-view-part-as-charset): New function. - (gnus-article-view-part-as-charset): New function. - -2000-11-05 22:34:07 ShengHuo ZHU - - * mm-decode.el (mm-verify-option): Default value. - (mm-possibly-verify-or-decrypt): Dealing with broken messages. - -2000-11-05 15:06:05 ShengHuo ZHU - - * nnvirtual.el (nnvirtual-request-expire-articles): Uncompress range. - -2000-11-05 Simon Josefsson - - * mml-smime.el (mml-smime-verify): Work in original multipart - buffert. - - * mm-decode.el (mm-handle-multipart-original-buffer): New macro. - (mm-handle-multipart-ctl-parameter): Ditto. - (mm-alist-to-plist): New function. - (mm-dissect-buffer): Store CTL parameters and copy original buffer - for multiparts. - (mm-destroy-parts): Destroy multipart buffert. - (mm-remove-part): Ditto. - - * mml-smime.el (mml-smime-sign): Not used. - (mml-smime-encrypt): Ditto. - - * mm-decode.el (mml-smime-verify): Autoload mml-smime. - - Verify S/MIME signature support. - - * mm-decode.el (mm-inline-media-tests): Add - application/{x-,}pkcs7-signature. - (mm-inlined-types): Ditto. - (mm-automatic-display): Ditto. - (mm-verify-function-alist): Ditto. Add name of method. - (mm-decrypt-function-alist): Add name of method. - (mm-find-part-by-type): Add documentation. - (mm-possibly-verify-or-decrypt): Use new format of - mm-{verify,decrypt}-function-alist. Use method names. - - * mml-smime.el (mml-smime-verify): New function. - -2000-11-04 20:38:50 ShengHuo ZHU - - * mm-view.el (mm-inline-text): Move point to the end of inserted text. - -2000-11-04 19:07:08 ShengHuo ZHU - - * mml2015.el (mml2015-function-alist): Clear verify and decrypt. - * mm-uu.el: Reorganized. Add gnatsweb, pgp-signed, pgp-encrypted. - * mm-decode.el (mm-snarf-option): New variable. - -2000-11-04 13:08:02 ShengHuo ZHU - - * mm-util.el (mm-subst-char-in-string): New function. - (mm-replace-chars-in-string): Use it. - * message.el (message-replace-chars-in-string): Use it. - * nnheader.el (nnheader-replace-chars-in-string): Use it. - * gnus-mh.el (mh-lib-progs): Shut up. - -2000-11-04 ShengHuo Zhu - - * base64.el, md5.el: Moved to contrib directory. - -2000-11-04 11:13:56 ShengHuo ZHU - - * gnus-sum.el (gnus-summary-search-article-forward): Don't move - the last article when search. - -2000-11-04 10:34:29 ShengHuo ZHU - - * nnheader.el (nnheader-pathname-coding-system): Default iso-8859-1. - * nnmail.el (nnmail-pathname-coding-system): Ditto. - -2000-09-29 David Edmondson - - * message.el (message-newline-and-reformat): Typo. - -2000-11-04 10:11:05 ShengHuo ZHU - - * rfc2231.el (rfc2231-decode-encoded-string): Test mm-multibyte-p. - -2000-11-04 09:53:42 ShengHuo ZHU - - * nntp.el (nntp-decode-text): Delete bogus status lines. - -2000-11-03 Stefan Monnier - - * message.el (message-font-lock-keywords): Match a final newline - to help font-lock's multiline support. - -2000-11-04 09:11:44 ShengHuo ZHU - - * nnoo.el (nnoo-set): New function. - -2000-11-04 ShengHuo Zhu - - * gpg.el, gpg-ring.el: Moved to contrib directory. - -2000-11-04 Simon Josefsson - - * nnimap.el (nnimap-split-inbox): Typo. - -2000-11-03 10:46:44 ShengHuo ZHU - - * gnus-msg.el (gnus-msg-mail): Move it backwards. - -2000-11-03 Simon Josefsson - - * rfc2231.el (rfc2231-parse-qp-string): New function. - (require): rfc2047. - - * mail-parse.el (mail-header-parse-content-type): - (mail-header-parse-content-disposition): Support invalid QP - encoded strings, by using `rfc2231-parse-qp-string'. - -2000-11-03 08:58:08 ShengHuo ZHU - - * rfc2231.el (rfc2231-parse-string): Decode when there is no number. - (rfc2231-decode-encoded-string): Typo "> X 1". - (rfc2231-encode-string): Insert the name of charset. - * mail-parse.el (mail-header-encode-parameter): Use RFC2231. - -2000-11-02 23:35:50 ShengHuo ZHU - - * mm-decode.el (mm-save-part): Return the filename. - * gnus-sum.el (gnus-summary-edit-article): Remove a hack. - * gnus-art.el (gnus-mime-save-part-and-strip): New function. - (gnus-mime-action-alist): Use it. - (gnus-mime-button-commands): Use it. - * mm-extern.el (mm-extern-local-file): Error when the file is gone. - (mm-inline-external-body): unwind-protect. - -2000-11-02 21:08:49 ShengHuo ZHU - - * gnus-art.el (gnus-insert-mime-button): Show url. - -2000-11-02 19:51:19 ShengHuo ZHU - - * mml.el (mml-generate-mime-1): Support external url. - * nnwarchive.el (nnwarchive-mail-archive-article): Use external url. - -2000-11-02 16:53:32 ShengHuo ZHU - - * mm-partial.el (mm-inline-partial): Buffer name with a leading space. - * mm-decode.el (mm-display-external): Ditto. - * mm-extern.el: New file. - * mm-decode.el (mm-inline-media-tests): Hook it up. - (mm-inlined-types): Inline message/external-body. - -2000-11-02 Simon Josefsson - - * gnus-art.el (gnus-visible-headers): Add Mail-Followup-To. - - * message.el (message-get-reply-headers): Better handling when - Mail-Followup-To is very large. - -2000-11-02 13:27:56 ShengHuo ZHU - - * gnus-uu.el (gnus-uu-post-news): Comment out the redundancy. - * gnus-art.el (gnus-article-edit-done): - * gnus-sum.el (gnus-summary-edit-article-done): Move line - counting code here. - * gnus-msg.el (gnus-setup-message): Remove a hack. - -2000-11-02 09:33:01 ShengHuo ZHU - - * gnus-sum.el (gnus-newsgroup-variables): New variable. - (gnus-summary-mode): Make them local variables. - (gnus-set-global-variables): Globalize them. - (gnus-summary-exit): Kill them. - -2000-11-02 Hrvoje Niksic - - * rfc2047.el (rfc2047-encoded-word-regexp): Allow empty encoded - word. - -2000-11-01 10:07:13 ShengHuo ZHU - - * gnus-art.el (gnus-mime-display-part): Add to signed or encrypted. - gnus-article-wash-types. - * gnus-art.el (gnus-article-wash-status): Use them. - -2000-11-01 08:54:11 ShengHuo ZHU - - * mml.el (mml-read-tag): Remove spaces and LF. - -2000-11-01 08:01:03 ShengHuo ZHU - - * mml2015.el (mml2015-mailcrypt-encrypt): Use from and sign parameters. - * mml.el (mml-generate-mime-1): Add sender and recipients attributes. - -2000-11-01 07:39:24 ShengHuo ZHU - - * gnus-sum.el (gnus-summary-force-verify-and-decrypt): New function. - -2000-10-31 22:06:13 ShengHuo ZHU - - * gnus-sum.el (gnus-article-charset): New variable. - (gnus-summary-display-article): Set it. - * gnus-msg.el (gnus-copy-article-buffer): Use it. - * gnus-art.el (gnus-article-mode): Make it local variable. - -2000-11-01 01:12:29 Lars Magne Ingebrigtsen - - * nnultimate.el (nnultimate-create-mapping): Use nreverse. - -2000-10-31 23:45:31 Lars Magne Ingebrigtsen - - * nnwfm.el: New file. - - * nnweb.el (nnweb-replace-in-string): New function. - -2000-10-31 17:32:02 ShengHuo ZHU - - * mml2015.el: Wrap gpg.el. - * gpg.el (gpg-verify): The last argument of apply is a list. - (gpg-encrypt): Add passphrase as a parameter. - -2000-10-31 17:28:45 ShengHuo ZHU - - * gpg.el: New file. - * gpg-ring.el: New file. - -2000-10-31 11:44:29 ShengHuo ZHU - - * gnus-sum.el (gnus-summary-show-article): Fix the summary line. - -2000-10-31 Katsumi Yamaoka - - * gnus-sum.el (gnus-summary-insert-line): Work with quoted - double-quote characters. - (gnus-summary-prepare-threads): Ditto. - -2000-10-31 08:36:03 ShengHuo ZHU - - * gnus-art.el (gnus-mime-display-single): Forward line -1. - * mml.el (mml-read-tag): Don't skip the leading space. - * lpath.el (font-lock-set-defaults): Shut up. - -2000-10-31 00:04:35 ShengHuo ZHU - - * mml2015.el: Fix doc. Remove bogus mml2015-setup. - -2000-10-30 23:37:07 ShengHuo ZHU - - * qp.el (quoted-printable-encode-region): Replace leading - when - ultra safe. - * mml.el (mml-generate-mime-postprocess-function): Removed. - (mml-postprocess-alist): Removed. - (mml-generate-mime-1): Use ultra-safe when sign. - * mml2015.el (mml2015-fix-micalg): Uppercase. - (mml2015-verify): Insert LF. - (mml2015-mailcrypt-sign): Downcase; search backward. - -2000-10-16 11:36:52 Lars Magne Ingebrigtsen - - * nnultimate.el (nnultimate-forum-table-p): Be a bit more - restrictive. - (nnultimate-table-regexp): New variable. - (nnultimate-forum-table-p): Use it. - -2000-10-30 Ed L Cashin - Trivial patch. - - * gnus-sum.el (gnus-summary-expire-articles): Save point. - -2000-10-30 08:52:50 ShengHuo ZHU - - * mml-sec.el (mml-pgpmime-sign-buffer): Use mml2015-sign. - (mml-pgpmime-encrypt-buffer): Use mml2015-encrypt. - -2000-10-30 08:38:12 ShengHuo ZHU - - * mml2015.el: Shut up. - -2000-10-30 08:17:46 ShengHuo ZHU - - * gnus.el (gnus-server-browse-hashtb): Removed. - * gnus-group.el (gnus-group-prepare-flat-list-dead): Use gnus-active. - (gnus-group-insert-group-line-info): Use simplified method. - * gnus-srvr.el (gnus-browse-foreign-server): Use gnus-set-active. - -2000-10-30 01:52:40 ShengHuo ZHU - - * gnus-util.el (gnus-union): Renamed from gnus-agent-union, and - moved here. - * gnus-agent.el (gnus-agent-fetch-headers): Use it. - * gnus-group.el (gnus-group-prepare-flat): Use it. - * gnus-topic.el (gnus-group-prepare-topics): Use it. - -2000-10-30 01:23:49 ShengHuo ZHU - - * mml.el (mml-mode): Show menu in XEmacs. - -2000-10-30 00:49:33 ShengHuo ZHU - - * gnus-srvr.el (gnus-server-browse-in-group-buffer): New variable. - (gnus-server-read-server-in-server-buffer): New function. - (gnus-browse-foreign-server): Browse in group buffer. - * gnus-group.el (gnus-group-prepare-flat): List group not in list. - (gnus-group-prepare-flat-list-dead): Use gnus-group-insert-group-line. - * gnus-topic.el (gnus-group-prepare-topics): Ditto. - * gnus.el (gnus-server-browse-hashtb): New variable. - -2000-10-29 22:31:40 ShengHuo ZHU - - * nnfolder.el (nnfolder-open-nov): Use group. - -2000-10-29 17:23:15 ShengHuo ZHU - - * nnfolder.el: Add NOV. Set version to 2.0. - (nnfolder-nov-is-evil): If non-nil, nnfolder acts like 1.0. - -2000-10-29 10:35:08 ShengHuo ZHU - - * mml2015.el (mml2015-mailcrypt-sign): Use mc-sign-generic. - -2000-10-29 09:42:05 ShengHuo ZHU - - * gnus-srvr.el (gnus-browse-foreign-server): Show level mark. - (gnus-browse-unsubscribe-group): Unsubscribed is not killed. - -2000-10-29 08:28:58 ShengHuo ZHU - - * nnfolder.el (nnfolder-read-folder): Don't goto point-min. - -2000-10-28 19:11:01 ShengHuo ZHU - - * mm-decode.el (mm-verify-function-alist): New variable. - (mm-verify-option): New variable. - (mm-decrypt-function-alist): Ditto. - (mm-decrypt-option): Ditto. - (mm-find-raw-part-by-type): New function. - (mm-possibly-verify-or-decrypt): New function. - (mm-dissect-multipart): Use it. - * mml2015.el (mml2015-fix-micalg): New function. - (mml2015-decrypt): Use new interface. - (mml2015-verify): Use new interface. - (mml2015-setup): Make it bogus. - -2000-10-28 16:54:45 ShengHuo ZHU - - * mml.el (mml-generate-mime-postprocess-function): Set to - mml-postprocess. - (autoload): Autoload mml2015 and mml-smime. - (mml-postprocess-alist): Use mml2015-sign and mml2015-encrypt. - * mml2015.el (mml2015-encrypt): New function. - (mml2015-sign): New function. - (mml2015-encrypt-function): New variable. - (mml2015-sign-function): New variable. - (mml2015-mailcrypt-encrypt): Use message-recipients. - (mml2015-setup): Don't set mml-generate-mime-postprocess-function. - * mml-smime.el (mml-smime-setup): Ditto. - -2000-10-28 Simon Josefsson - - * imap.el (imap-parse-resp-text-code): Workaround bug in Stalker - Communigate Pro 3.3.1 server. - - * mml-sec.el (mml-smime-encrypt-buffer): Support certfiles stored - in buffers. - (mml-secure-dns-server): Removed. - (mml-secure-part-smime-encrypt-by-dns): Use DIG interface. Don't - write certificates to files. - - * smime.el (smime-dns-server): New variable. - (smime-mail-to-domain): - (smime-cert-by-dns): New functions. - - * dig.el: New file. - -2000-10-28 10:09:41 ShengHuo ZHU - - * message.el (message-options): New variable. - (message-options-set-recipient): New function. - (message-send): Use them. - * gnus-int.el (gnus-request-replace-article): Use them. - (gnus-request-accept-article): Ditto. - * mml.el (mml-preview): Use them. - * gnus-sum.el (gnus-summary-edit-article): Use them. - - * message.el (message-options-get): New function. - (message-options-get): New function. - * rfc2047.el (rfc2047-encode-message-header): Use them. - * mm-bodies.el (mm-encode-body): Use them. - -2000-10-28 Simon Josefsson - - * nnimap.el (nnimap-retrieve-which-headers): - (nnimap-request-article-part): Quote message-id. - - * smime.el (smime-CA-directory): Rename from `smime-CAs'. - (smime-CA-file): New variable. - (smime-call-openssl-region): Don't error. - (smime-sign-region): Return result value. - (smime-encrypt-region): Ditto. - (smime-verify-region): New function. - (smime-decrypt-region): Ditto. - (smime-verify-buffer): Ditto. - (smime-decrypt-buffer): Ditto. - - * mml.el: Require mml-sec. - (mml-generate-mime-1): Support "sign" and "encrypt" MML tags. - (mml-mode-map): Add "sign" and "encrypt" maps. - (mml-menu): Add security menu. - (mml-preview): Use generate-new-buffer. - - * mml-sec.el: New file. - -2000-10-28 03:43:03 ShengHuo ZHU - - * mm-decode.el (mm-find-part-by-type): Move it here. - * mml.el (mml-postprocess): Move it here. - (mml-postprocess-alist): Move it here. Merge them. - -2000-10-28 03:38:39 ShengHuo ZHU - - * rfc2047.el (rfc2047-encode-message-header): Make sure no - unencoded stuff in the header. - -2000-10-28 02:40:46 ShengHuo ZHU - - * gnus-group.el (gnus-group-listed-groups): New variable. - (gnus-group-list-option): New variable. - (gnus-group-list-limit-map): New keymap. - (gnus-group-list-flush-map): New keymap. - (gnus-group-list-plus-map): New keymap. - (gnus-group-prepare-logic): New function. - (gnus-group-prepare-flat): Merge with - gnus-group-prepare-flat-predicate. Use gnus-group-listed-groups. - (gnus-group-prepare-flat-list-dead): Ditto. - (gnus-group-list-matching): Use gnus-group-prepare-function. - (gnus-group-list-dormant): Ditto. - (gnus-group-list-cached): Ditto. - (gnus-group-listed-groups): New function. - (gnus-group-list-limit): New function. - (gnus-group-list-flush): New function. - (gnus-group-list-plus): New function. - * gnus-topic.el (gnus-group-prepare-topics): Accept predicate. - (gnus-topic-prepare-topic): Ditto. - -2000-10-27 Paul Jarc - - * message.el (message-insert-to, message-get-reply-headers): - (message-reply, message-followup): Mail-{Followup,Reply}-To. - -2000-10-27 19:45:58 ShengHuo ZHU - - * mml2015.el: New file. - * smime.el: New file. - * mml-smime.el: New file. - -2000-10-27 19:42:12 ShengHuo ZHU - - * ChangeLog: Moved to ChangeLog.1. - -See ChangeLog.1 for earlier changes. - - Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006, 2007 - Free Software Foundation, Inc. - - This file is part of GNU Emacs. - - GNU Emacs is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3, or (at your option) - any later version. - - GNU Emacs is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with GNU Emacs; see the file COPYING. If not, write to the - Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, - Boston, MA 02110-1301, USA. - -;; Local Variables: -;; coding: iso-2022-7bit -;; End: - -;; arch-tag: 956fd310-042f-4fca-8dca-a01dbe06acff diff --git a/xemacs-packages/gnus/lisp/ChangeLog.contrib.upstream b/xemacs-packages/gnus/lisp/ChangeLog.contrib.upstream deleted file mode 100644 index 4e6ff13b..00000000 --- a/xemacs-packages/gnus/lisp/ChangeLog.contrib.upstream +++ /dev/null @@ -1,338 +0,0 @@ -2007-10-04 Reiner Steib - - * Relicense "GPLv2 or later" files to "GPLv3 or later". - -2007-04-06 Chong Yidong - - * sendmail.el (mail-text, mail-mode): Revert extant pieces of - 1995-05-19 doc changes. - -2007-03-24 Reiner Steib - - * smtpmail.el: Signal an error when used with Emacs 22+ or XEmacs. - (smtpmail-send-it): Remove NOMODIFY argument of - `set-buffer-file-coding-system' for compatibility with Emacs 21. - -2007-02-20 Juanma Barranquero - - * smtpmail.el (smtpmail-smtp-service, smtpmail-queue-index-file): - Fix typos in docstrings. - (smtpmail-local-domain, smtpmail-queue-mail): Doc fixes. - -2007-01-06 Simon Josefsson - - * README: Mention that smtpmail.el doesn't work on XEmacs. - -2006-11-24 Eli Zaretskii - - * smtpmail.el (smtpmail-send-it): - Copy buffer-file-coding-system from the mail buffer. Possibly add a - MIME header for the message encoding. - Bind coding-system-for-write around the call to mail-do-fcc. - Use smtpmail-code-conv-from to encode queued mail messages. - -2006-10-02 MIYOSHI Masanori (tiny change) - - * smtpmail.el (smtpmail-try-auth-methods): Fix typo in - 2006-09-28 commit. - -2006-09-28 Osamu Yamane (tiny change) - - * smtpmail.el (smtpmail-try-auth-methods): Do not break long - lines in base64-encoded authentication response. - -2006-09-04 Chong Yidong - - * sendmail.el (sendmail-program): Moved here from pathe.el. - -2006-06-15 Chong Yidong - - * sendmail.el (mail-send): Search explicitly for - mail-header-separator when checking for corrupted header lines. - -2006-02-11 Miles Bader - - * sendmail.el, smtpmail.el: New files, from Emacs tree. - -2005-05-17 Katsumi Yamaoka - - * hashcash.el (hashcash): New custom group. - (hashcash-default-payment): Add :group. - (hashcash-payment-alist): Ditto. - (hashcash-default-accept-payment): Ditto. - (hashcash-accept-resources): Ditto. - (hashcash-path): Ditto. - (hashcash-extra-generate-parameters): Ditto. - (hashcash-double-spend-database): Ditto. - (hashcash-in-news): Ditto. - - * nnir.el (nnir): Add :group. - -2005-03-13 Steve Youngs - - * gpg.el: Add timer/itimer compatibility. - -2003-11-15 Simon Josefsson - - * starttls.el: Sync with recent gnu.emacs.sources post. - -2003-10-24 Steve Youngs - - * nnir.el: Autoload `read-kbd-macro' at compile time. - -2003-09-30 Kai Grossjohann - From Torsten Hilbrich . - - * nnir.el (nnir-imap-search-field, nnir-imap-search-arguments) - (nnir-imap-search-argument-history): New variables. - (nnir-engines, nnir-run-imap): Use them. - (nnir-read-parm): Support reading the new IMAP query parameters. - -2003-06-03 Kai Gro,A_(Bjohann - - * README: Explain purpose of each file (well, most files). - -2003-05-01 Vasily Korytov - - * gpg.el (gpg-passphrase-forget): Check that gpg-passphrase is - set. - -2003-04-17 Steve Youngs - - * hashcash.el (hashcash-point-at-bol): Move the fbound test - outside of the defalias. - (hashcash-point-at-eol): Ditto. - -2003-03-19 Simon Josefsson - - * gnus-idna.el: Update. - -2003-03-11 Teodor Zlatanov - - * hashcash.el (hashcash-version, hashcash-insert-payment): patch - from Paul Foley - -2003-03-07 Simon Josefsson - - * gnus-idna.el (gnus-idna-to-ascii-rhs-1): Narrow to - head (otherwise forwarded mail break havoc). - -2003-03-07 Teodor Zlatanov - - * hashcash.el: New version from Paul Foley with better variable - names, executable-find support, and no errors in GNU Emacs - (hashcash-version): return nil when invoked with a - nil token - -2003-02-21 Simon Josefsson - - * hashcash.el (hashcash-point-at-bol): - (hashcash-point-at-eol): Defalias. - (hashcash-generate-payment): - (mail-check-payment): Use it. - -2002-12-30 Lars Magne Ingebrigtsen - - * hashcash.el: New version from Paul Foley with new - mail-check-payment function. - -2002-06-22 Simon Josefsson - - * hashcash.el: New file. - (hashcash-default-payment, hashcash-payment-alist, hashcash): - Defcustom. - (hashcash-generate-payment): Update to recent hashcode command - line syntax. - (hashcash-insert-payment): Use X-Hashcode:. - (mail-add-payment): Also look at Newsgroups. - (top-level): Add provide and EOF comment. - (mail-add-payment): Autoload. - (hashcash-insert-payment): s/Hashcode/Hashcash/ - (mail-add-payment): Doc fix. - -2002-05-20 Lars Magne Ingebrigtsen - - * gnus-mdrtn.el (gnus-moderated-groups): Removed (require 'gnus-load). - -2002-04-24 Kai Gro,A_(Bjohann - - * ucs-tables.el (featurep): Barf on XEmacs. - -2002-03-06 ShengHuo ZHU - - * ucs-tables.el: Copy from Emacs 21. - -2002-03-05 ShengHuo ZHU - - * xml.el: Sync with Emacs 21. - -2002-01-25 Josh Huber - - * gpg.el (gpg-command-decrypt): Enable the status-fd command line - option to gpg when decrypting so `mml2015-mailcrypt-decrypt' can - parse and display the output. - -2002-01-01 Lars Magne Ingebrigtsen - - * gnus-mdrtn.el (gnus-moderation-cancel-article): Insert an extra - newline. - -2001-12-26 Florian Weimer - - * gpg.el (gpg-command-default-alist): Using gpg-2comp is no longer - the default. - -2001-12-18 Josh Huber - - * ChangeLog: changed buffer-file-coding-system back to - coding. (oops) - -2001-12-17 Josh Huber - - * ChangeLog: changed coding to buffer-file-coding-system - -2001-11-22 Simon Josefsson - - * sha1.el: Removed. (A FSF copyrighted sha1-el.el file is in - ../lisp/). - -2001-10-30 21:00:00 ShengHuo ZHU - - * canlock.el, hex-util.el, sha1-el.el: Move to lisp. - -2001-10-30 Katsumi Yamaoka - - * canlock.el: (canlock-base64-encode-function): Removed. - (canlock-mmencode-program): Removed. - (canlock-mmencode-args-for-encoding): Removed. - (canlock-openssl-program): Renamed from `canlock-ssleay-program'. - (canlock-openssl-args): Renamed from `canlock-ssleay-args'. - (canlock-load-hook): Removed. - (canlock-base64-encode-string-with-mmencode): Removed. - (canlock-sha1-with-openssl): Renamed from - `canlock-sha1-with-ssleay'. - (canlock-hex-string-to-int): Removed. - (canlock-fetch-fields): Don't use `mapcar'. - (canlock-fetch-id-for-key): Don't use Cancel header if there is no - cancel command. - (gnus-summary-canlock-verify): Removed. - (wl-summary-canlock-verify): Removed. - (canlock-mew-summary-display): Removed. - (mew-summary-canlock-verify): Removed. - (mh-summary-canlock-verify): Removed. - (vm-summary-canlock-verify): Removed. - (cmail-summary-canlock-verify): Removed. - (rmail-summary-canlock-verify): Removed. - -2001-10-25 Simon Josefsson - - * canlock.el (canlock-password, canlock-password-for-verify) - (canlock-force-insert-header): Defcustom. - -2001-10-17 Simon Josefsson - - * canlock.el (sha1-binary): Autoload `sha1-binary'. - (canlock-sha1-function): Use it. - (canlock-sha1-function-for-verify): Ditto. - - * sha1-el.el: New file. - - * hex-util.el: Ditto. - -2001-08-24 16:09:14 Fabien Penso - - * gpg.el (gpg-command-sign-detached): Doc fix. - -2001-08-07 Andreas Jaeger - - * gpg.el (gpg-passphrase-forget): Don't cache - gpg-passphrase-timer. - (gpg-passphrase-store): Check if gpg-passphrase-timer is - initialized already. - -2001-07-30 16:00:00 ShengHuo ZHU - From Andreas Fuchs - - * gpg.el (gpg-command-verify): --status-fd 1 - (gpg-unabbrev-trust-alist): New. - -2001-01-18 Colin Marquardt - - * gpg.el (gpg-make-temp-file): Error info. - -2001-01-13 23:00:00 ShengHuo ZHU - - * gpg.el (gpg-build-arg-list): Use copy-sequence. - -2000-12-19 22:00:00 ShengHuo ZHU - - * gpg.el (defalias): Use eval-and-compile. - (gpg-command-all-arglist): Suggest by Jeff Senn . - -2000-12-15 00:00:00 ShengHuo ZHU - - * gpg.el (gpg-command-alist): Alist may not be defined. - -2000-12-14 23:00:00 ShengHuo ZHU - - * gpg.el (gpg-make-temp-file): Don't check file-modes of M$Windows. - -2000-12-14 10:00:00 ShengHuo ZHU - - * gpg.el (gpg-passphrase-store): Don't activate timer if it is live. - -2000-11-30 22:00:00 ShengHuo ZHU - - * gpg.el: (gpg-make-temp-file): Use expand-file-name. - (gpg-point-at-eol): New function. - (gpg-call-process): Use it. - (gpg-key-list-keys-parse-line): Ditto. - (gpg-with-passphrase-env): edebug-form-spec. - (gpg-with-temp-files): Ditto. - (gpg-show-result): Ditto. - -2000-11-08 Bj,Av(Brn Torkelsson - - * gpg.el: In Xemacs it is called point-at-eol, not - line-end-position - - * gpg.el (gpg-key-lessp): use string-lessp instead of - compare-strings (not available on XEmacs) - -2000-11-16 Simon Josefsson - - * gpg.el (gpg-command-verify-cleartext): New variable. - (gpg-verify-cleartext): New function. - -2000-10-31 17:32:02 ShengHuo ZHU - - * gpg.el (gpg-verify): The last argument of apply is a list. - (gpg-encrypt): Add passphrase as a parameter. - - Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, - 2007 Free Software Foundation, Inc. - - This file is part of GNU Emacs. - - GNU Emacs is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3, or (at your option) - any later version. - - GNU Emacs is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with GNU Emacs; see the file COPYING. If not, write to the - Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, - Boston, MA 02110-1301, USA. - -;; Local Variables: -;; coding: iso-2022-7bit -;; fill-column: 79 -;; add-log-time-zone-rule: t -;; End: - -;;; arch-tag: 105a2bf0-3f04-4ba6-a991-619aece2c04f diff --git a/xemacs-packages/gnus/lisp/ChangeLog.upstream b/xemacs-packages/gnus/lisp/ChangeLog.upstream deleted file mode 100644 index adf2c769..00000000 --- a/xemacs-packages/gnus/lisp/ChangeLog.upstream +++ /dev/null @@ -1,5617 +0,0 @@ -2008-04-10 Reiner Steib - - * gnus.el: Gnus v5.10.10 is released. - -2008-03-31 Katsumi Yamaoka - - * Makefile.in (datarootdir): Define. - (EMACS_COMP, install-el, install-elc, install-el-elc): Quote directory - name that might contain whitespace. - -2008-03-29 Sven Joachim - - * gnus-sum.el (gnus-summary-make-menu-bar): Add missing dots. - -2008-03-24 Reiner Steib - - * message.el (message-cite-original-without-signature): Mention - stripping of the signatur in doc string. - -2008-03-19 Reiner Steib - - * tls.el (open-tls-stream): Reindent. - -2008-03-18 Nils Ackermann (tiny change) - - * nnmh.el (nnmh-request-expire-articles): Prefer expiry-target group - parameter. - - * message.el (message-disassociate-draft): Specify drafts group name - fully. - -2008-03-14 Katsumi Yamaoka - - * mail-source.el (mail-source-delete-old-incoming) Fix regexp to find - Incoming* files. - -2008-03-12 Katsumi Yamaoka - - * nntp.el (nntp-open-telnet-stream, nntp-open-via-rlogin-and-telnet) - (nntp-open-via-telnet-and-telnet): Make sure the nntp port to specify - is a string. - -2008-03-10 Glenn Morris - - Merge from the Emacs trunk to enable it to work with XEmacs. - * tls.el: Don't require rx when compiling. - (tls-end-of-info): Rewrite without using rx. - (open-tls-stream): Use with-current-buffer. - -2008-03-10 Katsumi Yamaoka - - * lpath.el: Consider the case without Emacs/W3. - -2008-03-08 Riccardo Murri - - * net/tls.el: Require rx when compiling. - (tls-end-of-info): New variable. - (open-tls-stream): Keep reading input until `tls-end-of-info' is - matched. [Sync from EMACS_22_BASE.] - -2008-03-08 Reiner Steib - - * mail-source.el (mail-source-delete-old-incoming-confirm): Change - default to nil. - (mail-source-delete-old-incoming): Make confirmation prompt more clear. - -2008-03-07 Katsumi Yamaoka - - * lpath.el: Rearrange. - - * gnus-art.el (gnus-narrow-to-page): Position point properly. - (gnus-article-goto-prev-page): Work for articles having ^L's. - - * gnus-sum.el (gnus-summary-end-of-article): Remove needless narrowing. - - * mm-view.el (mm-w3m-standalone-supports-m17n-p): Fix typo. - -2008-03-05 Reiner Steib - - * gnus-sum.el (gnus-print-buffer): Honor ps-print-color-p. - Suggested by . - -2008-03-01 Reiner Steib - - Sync from EMACS_22_BASE. - - * parse-time.el: Rename elt->parse-time-elt and val->parse-time-val. - - * nnimap.el (nnimap-split-download-body): Fix spelling. - - * netrc.el: Remove eval-and-compile for `netrc-point-at-eol'. - - * gnus-uu.el (gnus-uu-default-view-rules, gnus-uu-decode-save): Fix - spelling and typo. - - * gnus-demon.el (gnus-demon): Fix spelling. - - * deuglify.el: Don't use "illegal". - -2008-03-01 Glenn Morris - - * calendar/time-date.el (with-decoded-time-value): Doc fix. - -2008-03-01 Ari Roponen (tiny change) - - * calendar/time-date.el (encode-time-value): Doc fix. - -2008-03-01 Glenn Morris - - * message.el (message-tool-bar-retro): Update for rename - mail_send.xpm->mail-send.xpm. - -2008-03-01 Reiner Steib - - * Update copyright years. - -2008-02-29 Andreas Seltenreich - - * nnweb.el (nnweb-google-parse-1): Fix date parsing on articles with - empty author. - -2008-02-16 Reiner Steib - - * mail-source.el (mail-source-delete-incoming): Change default. - Supplement doc string. - -2008-02-14 Reiner Steib - - * nnmail.el (nnmail-message-id-cache-file): Derive from - `gnus-home-directory'. - -2008-02-11 Reiner Steib - - * gnus-topic.el (gnus-topic-select-group, gnus-topic-read-group): - Document negativ prefix. - - * gnus-group.el (gnus-group-read-group): Document negativ prefix. - -2008-02-03 Reiner Steib - - * gnus.el (gnus-group-startup-message): Add `find-image' call before - image-load-path is let-bound. Reported by Harald Hanche-Olsen - . - -2008-01-12 Reiner Steib - - * gnus-sum.el (gnus-article-sort-by-random) - (gnus-thread-sort-by-random): Fix doc strings. Reported by - jidanni@jidanni.org. - -2007-12-18 Reiner Steib - - * gnus-draft.el (gnus-draft-send-message): Mention process/prefix - convention in doc string. - -2007-12-14 Johan Bockg,Ae(Brd - - * gnus-sum.el (gnus-summary-mark-unread-as-read) - (gnus-summary-mark-read-and-unread-as-read) - (gnus-summary-mark-current-read-and-unread-as-read) - (gnus-summary-mark-unread-as-ticked): Doc fix. - `gnus-mark-article-hook', not `gnus-summary-mark-article-hook'. - -2007-12-14 Reiner Steib - - * gnus-sum.el (gnus-summary-prev-article): Fix doc string. Reported by - Christoph Conrad . - -2007-12-03 Reiner Steib - - * message.el (message-ignored-supersedes-headers): Add "X-ID". - -2007-11-04 Reiner Steib - - * gnus.el: Bump version to 5.10.9. - -2007-11-03 Reiner Steib - - * gnus-sum.el (gnus-summary-highlight): Mark as risky local variable. - -2007-11-01 Reiner Steib - - * mm-util.el (mm-charset-eval-alist): Mark as risky local variable. - - * gnus.el (gnus-group-charter-alist): Mark as risky local variable. - - * gnus-art.el (gnus-button-alist, gnus-header-button-alist): Mark as - risky local variable. - - * gnus-group.el (gnus-group-icon-list): Mark as risky local variable. - -2007-11-01 ARISAWA Akihiro (tiny change) - - * message.el (message-use-alternative-email-as-from): Examine the - From header as well; use message-make-from in order to include a - user's full name. [ Backported bug fix from No Gnus. ] - -2007-10-30 Reiner Steib - - * qp.el (quoted-printable-decode-string): Fix typo in doc string. - -2007-10-30 Katsumi Yamaoka - - * gnus-ems.el (gnus-x-splash): Work even if there's no scroll bar. - -2007-10-23 Richard Stallman - - * gnus-group.el (gnus-group-highlight): Mark as risky. - -2007-10-23 Katsumi Yamaoka - - * gnus.el (gnus-server-to-method): Return method found first in - gnus-newsrc-alist. - -2007-10-20 Reiner Steib - - * html2text.el (html2text-fix-paragraph): Use `forward-line' instead of - `next-line'. - -2007-10-18 Katsumi Yamaoka - - * nnmail.el (nnmail-fancy-expiry-target): Use rmail-dont-reply-to to - exclude address matching message-dont-reply-to-names. - -2007-10-15 Katsumi Yamaoka - - * gnus-util.el (gnus-string<): New function. - - * gnus-sum.el (gnus-article-sort-by-author) - (gnus-article-sort-by-subject): Use it. - -2007-10-15 Katsumi Yamaoka - - * gnus-win.el (gnus-configure-windows): Focus on the frame for which - the frame-focus tag is set in gnus-buffer-configuration. - -2007-10-08 Reiner Steib - - * mm-util.el (mm-charset-synonym-alist): Alias gbk to cp936. - -2007-10-04 Reiner Steib - - * Relicense "GPLv2 or later" files to "GPLv3 or later". - -2007-09-13 Katsumi Yamaoka - - * gnus-sum.el (gnus-newsgroup-maximum-articles): Move from gnus.el. - Suggested by Leo . - - * gnus.el: Do. - -2007-09-13 Katsumi Yamaoka - - * gnus.el (gnus-newsgroup-maximum-articles): Rename from - gnus-maximum-newsgroup. Suggested by Leo . - - * gnus-agent.el (gnus-agent-fetch-headers): Do. - - * gnus-sum.el (gnus-articles-to-read, gnus-list-of-unread-articles) - (gnus-list-of-read-articles, gnus-sequence-of-unread-articles): Do. - -2007-09-13 Katsumi Yamaoka - - * nnmbox.el (nnmbox-request-article): Don't assume delim regexp matches - newline. - (nnmbox-request-accept-article): Don't change article in source buffer; - narrow to header to use message-fetch-field rather than - nnmail-fetch-field; use with-current-buffer instead of save-excursion. - (nnmbox-request-replace-article): Quote lines that'll be misidentified - as delimiters; make sure article ends with newline. - (nnmbox-delete-mail): Correct last position of article to be deleted; - ignore X-Gnus-Newsgroup header in article body. - (nnmbox-save-mail): Quote lines looking like delimiters at the right - positions; make sure article ends with newline. - - * lpath.el: Don't bind define-ccl-program for non-Mule XEmacs. - - * dgnushack.el: Bind or autoload define-ccl-program for XEmacs. - -2007-09-05 Katsumi Yamaoka - - * gnus-cus.el (gnus-score-extra): New widget. - (gnus-score-extra-convert): New function. - (gnus-score-customize): Use it for Extra. - -2007-08-23 Katsumi Yamaoka - - * mml.el (mml-generate-mime): Make sure it uses multibyte temp buffer. - (mml-generate-mime-1): Don't encode body if it is specified to be in - raw form; don't make buffer be unibyte when inserting multibyte string. - -2007-08-23 Stefan Monnier - - * sha1.el: Fix up comment style. - (sha1-F0, sha1-F1, sha1-F2, sha1-F3, sha1-S1, sha1-S5, sha1-S30) - (sha1-OP, sha1-add-to-H): Use new-style backquotes. - - * hex-util.el: Fix up comment style. - (hex-char-to-num, num-to-hex-char): Use new-style backquotes. - - * gnus-salt.el: Use with-current-buffer. - (gnus-pick-setup-message): Fix long-standing typo. - -2007-08-17 Katsumi Yamaoka - - * gnus-art.el (gnus-article-summary-command-nosave) - (gnus-article-read-summary-keys): Don't use 3rd arg of pop-to-buffer. - -2007-08-14 Katsumi Yamaoka - - * gnus.el (gnus-maximum-newsgroup): New variable. - - * gnus-agent.el (gnus-agent-fetch-headers): Limit the range of articles - according to gnus-maximum-newsgroup. - - * gnus-sum.el (gnus-articles-to-read, gnus-list-of-unread-articles) - (gnus-list-of-read-articles, gnus-sequence-of-unread-articles): - Limit the range of articles according to gnus-maximum-newsgroup. - -2007-08-10 Katsumi Yamaoka - - * nntp.el (nntp-xref-number-is-evil): New server variable. - (nntp-find-group-and-number): If it is non-nil, don't trust article - numbers in the Xref header. - -2007-08-06 Katsumi Yamaoka - - * gnus-ems.el (gnus-x-splash): Bind inhibit-read-only to t. - -2007-08-04 Reiner Steib - - * gnus-art.el (article-hide-headers): Bind inhibit-read-only to t. - -2007-08-08 Glenn Morris - - * gmm-utils.el, gnus-async.el, gnus-msg.el, gnus-score.el - * gnus-util.el, imap.el, mailcap.el, nnimap.el: Replace `iff' in - doc-strings and comments. - -2007-07-25 Glenn Morris - - * Relicense all FSF files to GPLv3 or later. - -2007-07-24 Katsumi Yamaoka - - * gnus-msg.el (gnus-summary-supersede-article) - (gnus-summary-resend-message-edit): Add Gcc header. - (gnus-summary-resend-bounced-mail): Ditto; search whole body for parent - article's Message-ID; refer parent article in summary buffer. - - * message.el (message-bounce): Call mime-to-mml. - -2007-07-21 Reiner Steib - - * mm-uu.el (mm-uu-type-alist): Refer to mm-uu-configure-list in doc - string. - -2007-07-16 Katsumi Yamaoka - - * gnus-srvr.el (gnus-server-font-lock-keywords): Quote faces. - -2007-07-14 David Kastrup - - * gnus-art.el (gnus-mime-delete-part): Don't go through article-edit - finishing actions if we did not edit the article. - -2007-07-13 Katsumi Yamaoka - - * gnus-srvr.el (gnus-server-agent-face, gnus-server-opened-face) - (gnus-server-closed-face, gnus-server-denied-face) - (gnus-server-offline-face): Remove variable. - (gnus-server-font-lock-keywords): Use faces that are not aliases. - - * mm-util.el (mm-decode-coding-string, mm-encode-coding-string) - (mm-decode-coding-region, mm-encode-coding-region): Don't modify string - if the coding-system argument is nil for XEmacs. - - * nnrss.el (nnrss-compatible-encoding-alist): Inherit the value of - mm-charset-override-alist. - - * rfc2047.el: Don't require base64; require rfc2045 for the function - rfc2045-encode-string. - (rfc2047-encode-parameter): Use rfc2045-encode-string to quote or not - to quote the parameter value. - -2007-07-04 Katsumi Yamaoka - - * gnus-sum.el (gnus-summary-catchup): Don't recognize cached articles - as unfetched articles. - -2007-07-02 Reiner Steib - - * gnus-start.el (gnus-level-unsubscribed): Improve doc string. - -2007-06-26 Katsumi Yamaoka - - * gnus-art.el (gnus-article-summary-command-nosave) - (gnus-article-read-summary-keys): Don't set the 3rd arg of - pop-to-buffer for XEmacs. - -2007-06-14 Katsumi Yamaoka - - * gnus-agent.el (gnus-agent-fetch-headers) - (gnus-agent-retrieve-headers): Bind - gnus-decode-encoded-address-function to identity. - - * nntp.el (nntp-send-xover-command): Recognize an xover command is - available also when the server returns simply a dot. - - * gnus-ems.el (gnus-x-splash): Redisplay window before measuring it. - -2007-06-08 Katsumi Yamaoka - - * gnus-ems.el (gnus-x-splash): Make it work. - - * gnus-start.el (gnus-1): Relax restrictions that prevent gnus-x-splash - from being used. - - * lpath.el: Bind line-spacing and tool-bar-mode for XEmacs. - - * gnus-art.el (gnus-article-summary-command-nosave): Correct the order - of the arguments passed to pop-to-buffer. - (gnus-article-read-summary-keys): Ditto. - -2007-06-07 Juanma Barranquero - - * gnus-art.el (gnus-split-methods): Fix typo in docstring. - -2007-06-06 Juanma Barranquero - - * gnus-diary.el (gnus-diary-time-format, gnus-summary-sort-by-schedule): - * gnus-sum.el (gnus-summary-highlight): - * pgg.el (pgg-sign-region, pgg-sign): - * mail-source.el (mail-source-delete-old-incoming-confirm): - * nndiary.el (nndiary-reminders): Fix typos in docstrings. - -2007-06-04 Katsumi Yamaoka - - * gnus-art.el (gnus-mime-view-part-externally) - (gnus-mime-view-part-internally): Fix predicate function passed to - completing-read. - - * mm-decode.el (mm-image-fit-p): Return t if argument is not an image; - return t if image size is just the same as window size. - -2007-05-28 Katsumi Yamaoka - - * message.el (message-pop-to-buffer): Add switch-function argument. - (message-mail): Pass switch-function argument to it. - -2007-05-24 Katsumi Yamaoka - - * message.el (message-narrow-to-headers-or-head): Ignore - mail-header-separator in the body. - -2007-05-10 Reiner Steib - - * gnus-art.el (gnus-article-mode): Fix comment about displaying - non-break space. - -2007-05-09 Didier Verna - - * gnus-diary.el, nndiary.el: Remove the description comment (nndiary is - now properly documented in the Gnus manual). Fix the spelling of "Back - End". - -2007-04-19 Katsumi Yamaoka - - * gnus-art.el (gnus-mime-strip-charset-parameters): New function. - (gnus-mime-view-part-as-charset): Use it; redisplay subpart currently - displayed of multipart/alternative part if it is invoked from summary - buffer. - (gnus-article-part-wrapper): Select article window. - - * mm-view.el (mm-inline-text-html-render-with-w3m) - (mm-inline-text-html-render-with-w3m-standalone) - (mm-inline-render-with-function): Use mail-parse-charset by default. - -2007-04-18 Levin Du (tiny change) - - * parse-time.el (parse-time-string-chars): Check if CHAR - is less than the length of parse-time-syntax. - -2007-04-10 Katsumi Yamaoka - - * gnus-msg.el (gnus-inews-yank-articles): Use - message-exchange-point-and-mark instead of exchange-point-and-mark. - -2007-04-09 Katsumi Yamaoka - - * message.el (message-yank-original): Make sure cited text ends with - newline; don't exchange point and mark. - -2007-04-07 Chong Yidong - - * tls.el (open-tls-stream): Properly handle case where there - is no associated buffer. - -2007-04-03 Thien-Thi Nguyen - - * gnus-msg.el (gnus-inews-yank-articles): Fix bug: After - message-yank-original, make sure (< mark TEXT point). - -2007-03-31 Reiner Steib - - * nnmail.el (nnmail-spool-file): Mark as obsolete. - (nnmail-get-new-mail): Reformat. - - * gnus-registry.el (gnus-registry-cache-save): Add FIXME comment. - - * gmm-utils.el: Fix Commentary. - (gmm-tool-bar-from-list): Fix typo in doc string. - -2007-03-27 Thien-Thi Nguyen - - * message.el (message-yank-original): Fix bug: - Don't switch point and mark unnecessarily. - -2007-03-25 Andreas Seltenreich - - * gnus-msg.el (gnus-setup-message, gnus-inews-add-send-actions): Move - evaluation of gnus-extended-version to ensure correct generation of the - User-Agent header when message-generate-headers-first is used. - -2007-03-24 Reiner Steib - - * gnus-art.el (gnus-button-alist): Also catch ` k ...'. - (gnus-treat-display-x-face): Fix doc string. - -2007-03-20 Andreas Seltenreich - - * message.el (message-required-news-headers): - * gnus-util.el (gnus-intern-safe): Fix typo in docstring. - -2007-03-18 Thien-Thi Nguyen - - * tls.el (open-tls-stream): In handshake-waiting loop, - don't wait more if there is output available to process. - -2007-03-17 Thien-Thi Nguyen - - * tls.el (tls-program): Doc fix. - -2007-03-15 Katsumi Yamaoka - - * message.el (message-generate-new-buffers): Change the meaning of the - nil value; add `standard' to the choices; treat t as `unique'; improve - doc string. - (gnus-select-frame-set-input-focus): Autoload. - (message-buffer-name): Search for the existing message buffer if - message-generate-new-buffers is nil or `standard'; treat the value t of - message-generate-new-buffers as `unique'. - (message-pop-to-buffer): Raise the frame already displaying the message - buffer; clear the echo area after querying. - (message-setup): Pass the `continue' argument to compose-mail. - (message-mail): Prefer `switch-function' if it is given; search for the - existing message buffer if the `continue' argument is non-nil; pass - continue and switch-function arguments to compose-mail by way of - message-setup. - (message-mail-other-window): Adjust argument of message-setup. - (message-mail-other-frame): Ditto. - -2007-02-24 Chris Moore - - * pgg-pgp5.el (pgg-pgp5-encrypt-region): - * pgg-pgp.el (pgg-pgp-encrypt-region): - * pgg-gpg.el (pgg-gpg-encrypt-region): - Check pgg-encrypt-for-me if no other recipients. - -2007-02-24 John Paul Wallington - - * tls.el (tls-certtool-program): Fix custom type. - -2007-02-28 Katsumi Yamaoka - - * message.el (message-make-in-reply-to): Quote name containing - non-ASCII characters. It will make the RFC2047 encoder cause an error - if there are special characters. Reported by NAKAJI Hiroyuki - . - -2007-02-27 Katsumi Yamaoka - - * nntp.el (nntp-never-echoes-commands) - (nntp-open-connection-functions-never-echo-commands): New variables. - (nntp-send-command): Use them. - -2007-02-15 Andreas Seltenreich - - * nnweb.el (nnweb-google-parse-1): Fix date parsing to also match on - articles posted in the last 24 hours. - -2007-02-14 Chong Yidong - - * smiley.el (smiley-regexp-alist): Add "dead" smiley. - -2007-02-01 Andreas Seltenreich - - * nnweb.el (nnweb-google-parse-1): Update parser. - -2007-01-29 Juanma Barranquero - - * gnus-art.el (gnus-button-prefer-mid-or-mail): Fix typo in docstring. - -2007-01-28 Andreas Seltenreich - - * nnslashdot.el (nnslashdot-request-article): Update end-of-article - regexp. - -2007-01-24 Katsumi Yamaoka - - * uudecode.el (uudecode-string-to-multibyte): New function emulating - string-to-multibyte. - (uudecode-decode-region-internal): Use it. - - * lpath.el: Fbind string-as-multibyte for XEmacs. - -2007-01-23 Reiner Steib - - * gnus-score.el (gnus-home-score-file, gnus-home-adapt-file): Fix - custom choice. - - * gnus-art.el (gnus-signature-limit): Fix custom choice. - -2007-01-19 Reiner Steib - - * nnsoup.el (nnsoup-directory, nnsoup-packer, nnsoup-packet-directory): - Use gnus-home-directory instead of "~/" or "$HOME". - -2007-01-12 Kenichi Handa - - * uudecode.el (uudecode-decode-region-internal): Make it work in a - multibyte buffer. - -2007-01-14 Reiner Steib - - * gnus-sum.el (gnus-auto-select-first): Improve doc string. - -2007-01-07 Reiner Steib - - * gnus-soup.el: Add missing :group in previous change. - -2007-01-05 Reiner Steib - - * gnus-soup.el (gnus-soup): New custom group. Make user variables - customizable. - -2007-01-03 Andreas Seltenreich - - * nnweb.el (nnweb-gmane-create-mapping): Put back code to merge the - headers read from disk with the ones newly found in the current search. - This should no longer cause problems, because the article numbers in - Gmane's `nov.php' output are ignored since the previous change. - -2006-01-03 Andreas Seltenreich - - * nnweb.el (nnweb-gmane-create-mapping): Keep the mapping stable for - solid groups. - -2006-01-03 Lars Magne Ingebrigtsen - - * nnweb.el (nnweb-gmane-create-mapping): Use the article number from - the headers when creating the mapping to avoid mismappings. - (nnweb-gmane-create-mapping): Always nix out old mapping. - -2007-01-02 Andreas Seltenreich - - * gmm-utils.el (gmm-tool-bar-style): Fix custom type. - -2007-01-01 Katsumi Yamaoka - - * lpath.el: Fbind cp-supported-codepages; bind url-version; fbind - display-images-p and timer-set-function for XEmacs; bind timer-list for - XEmacs; fbind find-face and set-itimer-function for Emacs; bind - itimer-list for Emacs; bind coding-system-change-eol-conversion for - XEmacs without the file-coding feature. - - * mm-decode.el (mm-display-external): Use itimer function for XEmacs. - -2006-12-30 Andreas Seltenreich - - * gnus-sum.el (gnus-summary-insert-dormant-articles): Fix typo in - message. - -2006-12-29 Jouni K. Sepp,Ad(Bnen - - * nnimap.el (nnimap-expunge-search-string): Mention - nnimap-search-uids-not-since-is-evil in docstring. - -2006-12-28 Reiner Steib - - * spam.el: Revert to make-obsolete-variable because - define-obsolete-variable-alias is not supported in Emacs 21. - -2006-12-28 Daiki Ueno - - * gnus-sum.el (gnus-summary-next-article): Make sure we are in the - summary buffer. - -2006-12-27 Reiner Steib - - * spam.el (spam-ifile-path, spam-ifile-database-path) - (spam-bogofilter-path): Use define-obsolete-variable-alias instead of - make-obsolete-variable. - -2006-12-26 Reiner Steib - - * message.el (message-make-fqdn): Fix comment. - (message-bogus-system-names): Add ".local". - - * spam.el (spam-ifile-path, spam-ifile-program) - (spam-ifile-database-path, spam-ifile-database) - (spam-bogofilter-path, spam-bogofilter-program): Rename variables. - Don't use "path" inappropriately. - (spam-spamoracle-database, spam-get-ifile-database-parameter): Fix doc - strings. - (spam-check-ifile, spam-ifile-register-with-ifile) - (spam-check-bogofilter, spam-bogofilter-register-with-bogofilter): Use - new variable names. - - * gnus-art.el (gnus-treat-display-x-face, gnus-treat-display-face) - (gnus-treat-display-smileys): Simplify using - gnus-image-type-available-p. - - * gnus-ems.el (gnus-image-type-available-p): Use display-images-p if - available. - - * gnus-xmas.el (gnus-xmas-image-type-available-p): Use - `display-images-p' if available. - -2006-12-25 Daiki Ueno - - * pgg-def.el (pgg-passphrase-coding-system): Default to nil instead of - locale-coding-system. - * pgg-gpg.el (pgg-gpg-process-region): Encode passphrase with eol-type - LF. - -2006-12-22 Katsumi Yamaoka - - * nnrss.el (nnrss-fetch): Replace buffer's contents with the decoded - one after turning on the buffer's multibyteness instead of decoding - them directly in the unibyte buffer that causes unexpected conversion - in Emacs 23 (unicode). - -2006-12-20 Reiner Steib - - * gnus-group.el (gnus-group-tool-bar-gnome): Exchange connect and - disconnect icons. Add help text. - -2006-12-17 Chong Yidong - - * pgg-gpg.el (pgg-gpg-use-agent): Default to t. - -2006-12-13 Reiner Steib - - * legacy-gnus-agent.el: Add Copyright notice. - -2006-12-12 Chong Yidong - - * gnus-sum.el (gnus-make-thread-indent-array): Fix last change. - -2006-12-08 Chong Yidong - - * gnus-sum.el (gnus-make-thread-indent-array): New optional arg - specifying array size. - (gnus-summary-insert-line, gnus-summary-prepare-threads): Regrow indent - array if it is too small. - (gnus-sort-threads-recursive): Renamed from gnus-sort-thread-1. - (gnus-sort-threads-loop): New function. - -2006-12-06 Chris Moore - - * gnus-sum.el (gnus-sort-threads, gnus-summary-limit-children): - Use `max' to avoid the value of `max-lisp-eval-depth' decreasing. - -2006-12-04 Jouni K. Sepp,Ad(Bnen - - * mm-url.el (mm-url-predefined-programs): Call curl with correct - options. - -2006-11-30 Katsumi Yamaoka - - * mml2015.el (mml2015-pgg-clear-verify): Replace encode-coding-string - with mm-encode-coding-string. - -2006-11-29 Katsumi Yamaoka - - * nneething.el (nneething-decode-file-name): Replace - decode-coding-string with mm-decode-coding-string. - -2006-11-24 Stefan Monnier - - * pgg-pgp.el (pgg-pgp-process-region): Change `args' from a list of - strings to a single string. Quote `errors-file-name'. - (pgg-pgp-encrypt-region, pgg-pgp-decrypt-region, pgg-pgp-sign-region) - (pgg-pgp-verify-region, pgg-pgp-insert-key, pgg-pgp-snarf-keys-region): - Adjust calls. Use `shell-quote-argument'. - -2006-11-24 Juanma Barranquero - - * gnus-agent.el (gnus-agent-expire-unagentized-dirs) - (gnus-agent-regenerate-group): Fix space/tab mixup in messages. - - * gnus-art.el (gnus-article-x-face-command, gnus-numeric-save-name): - * gnus-group.el (gnus-group-sort-function, gnus-group-line-format) - (gnus-group-mode, gnus-group-read-group, gnus-group-delete-group) - (gnus-group-make-directory-group, gnus-group-transpose-groups): - * gnus-start.el (gnus-options-subscribe, gnus-options-not-subscribe) - (gnus-subscribe-newsgroup, gnus-1): - * gnus-sum.el (gnus-summary-make-false-root, gnus-make-threads): - * gnus.el (gnus-nntp-server, gnus-use-cross-reference) - (gnus-valid-select-methods, total-expire, gnus-summary-line-format) - (gnus-group-read-only-p): Fix space/tab mixup in docstrings. - -2006-11-21 Katsumi Yamaoka - - * mm-util.el (mm-string-to-multibyte): Alias to identity in XEmacs. - -2006-11-18 Andreas Seltenreich - - * mm-uu.el (mm-uu-pgp-signed-extract-1): Make last fix more thorough - and comment it. - - * nnslashdot.el (nnslashdot-retrieve-headers-1): Update regexp. - -2006-11-15 Reiner Steib - - * gnus-util.el (gnus-extract-address-components): Improve comment. - -2006-11-14 Katsumi Yamaoka - - * gnus-util.el (gnus-extract-address-components): Work with address in - which the name portion contains @. - - * lpath.el: Fbind custom-autoload. - -2006-11-14 Reiner Steib - - * gnus.el (gnus-start): Move custom group up. - (gnus-select-method): Don't autoload, but make it available for - `customize-variable'. - (gnus-getenv-nntpserver): Don't autoload. - -2006-11-14 Katsumi Yamaoka - - * mml.el (mml-generate-mime-1): Use mm-string-as-unibyte instead of - mm-with-unibyte-current-buffer to make string unibyte. - - * mm-decode.el (mm-insert-part): Use mm-string-to-multibyte instead of - mm-string-as-multibyte. - -2006-11-09 Reiner Steib - - * message.el: Merge from the trunk to fix the bug WRT double encoded - subjects. - (message-replacement-char): New variable. - (message-fix-before-sending): Use it. - (message-simplify-subject): New function to remove duplicate code. - (message-reply, message-followup): Use it. - (message-simplify-subject-functions): New variable. - (message-strip-subject-encoded-words): New function. - -2006-11-08 Wolfgang Jenkner (tiny change) - - * gnus-sum.el (gnus-summary-catchup): Use gnus-sorted-intersection - instead of gnus-intersection because arguments of gnus-sorted-nunion - must be sorted. This avoids corruption of gnus-newsgroup-unreads. - -2006-11-03 Juanma Barranquero - - * gnus-diary.el (gnus-diary-delay-format-function): - * nndiary.el (nndiary-reminders): - * nnsoup.el (nnsoup-always-save): Use "non-nil" in docstrings. - -2006-11-01 Reiner Steib - - * gnus-art.el (article-hide-boring-headers): Fetch date from - gnus-original-article-buffer to avoid problems with localized date - strings. - -2006-10-30 Katsumi Yamaoka - - * html2text.el (html2text-format-tags): Avoid infloop on open tags. - -2006-10-29 Reiner Steib - - * mm-util.el (mm-codepage-iso-8859-list, mm-codepage-ibm-list): - New variables. - (mm-setup-codepage-iso-8859, mm-setup-codepage-ibm): New functions. - (mm-charset-synonym-alist): Move some entries to - mm-codepage-iso-8859-list. - (mm-charset-synonym-alist, mm-charset-override-alist): Add - iso-8859-8/windows-1255 and iso-8859-9/windows-1254. - -2006-10-29 Katsumi Yamaoka - - * gnus-sum.el (gnus-set-mode-line): Quote % in group name. - -2006-10-28 Reiner Steib - - * gnus-agent.el (gnus-agent-make-mode-line-string): Make it compatible - with Emacs 21 and XEmacs. - -2006-10-26 Reiner Steib - - * mm-view.el: Add interactive arg to html2text autoload. - -2006-10-25 Katsumi Yamaoka - - * gnus-sum.el (gnus-summary-move-article): Use no-encode for `B B'. - -2006-10-20 Katsumi Yamaoka - - * gnus-group.el (gnus-group-make-doc-group): Work for non-ASCII group - names. - - * gnus-sum.el (gnus-select-newsgroup): Decode group name. - -2006-10-19 Katsumi Yamaoka - - * message.el (message-headers-to-generate): Fix typo in docstring. - -2006-10-19 Reiner Steib - - * gnus.el (gnus-mime): Remove unused custom group. - (gnus-getenv-nntpserver, gnus-select-method): Autoload. - -2006-10-13 Andreas Seltenreich - - * mm-uu.el (mm-uu-pgp-signed-extract-1): Use RFC 2440 definition of - "blank line" when searching for end of armor headers. - -2006-10-11 Katsumi Yamaoka - - * gmm-utils.el (gmm-write-region): Fix variable name. - -2006-10-10 Reiner Steib - - * gmm-utils.el (gmm-write-region): New function based on compatibility - code from `mm-make-temp-file'. - - * mm-util.el (mm-make-temp-file): Use `gmm-write-region'. - - * nnmaildir.el (nnmaildir--update-nov) - (nnmaildir-request-replace-article, nnmaildir-request-accept-article): - Use `gmm-write-region'. - -2006-10-04 Reiner Steib - - * gnus-sum.el (gnus-summary-make-menu-bar): Clarify - gnus-summary-limit-to-articles. - -2006-10-04 Romain Francoise - - * gnus-util.el (gnus-alist-to-hashtable, gnus-hashtable-to-alist): - Moved here (and renamed) from gnus-registry.el. - - * gnus-registry.el: Require gnus-util. - Use `gnus-alist-to-hashtable' and `gnus-hashtable-to-alist'. - -2006-10-04 Reiner Steib - - * pop3.el (pop3-authentication-scheme): Clarify doc. - (pop3-movemail): Warn about pop3-leave-mail-on-server. - -2006-10-04 Dave Love - - * pop3.el (pop3-authentication-scheme): Add custom version. - -2006-10-04 Jesper Harder - - * pop3.el (pop3-leave-mail-on-server): Don't quote nil in - doc string. Improve doc string. - -2006-10-03 Katsumi Yamaoka - - * gnus-util.el (gnus-with-local-quit): New macro. - - * gnus-demon.el (gnus-demon): Replace with-local-quit with it. - -2006-09-28 Reiner Steib - - * gmm-utils.el (gmm): Adjust custom version. - - * mm-util.el (mm-charset-override-alist, mm-charset-eval-alist): Adjust - custom version. - - * gnus-draft.el (gnus-draft-mode): Don't call `mml-mode'. - -2006-09-25 Chong Yidong - - * gnus-demon.el (gnus-demon): Use with-local-quit to avoid hangs. - -2006-09-19 Andreas Seltenreich - - * nnslashdot.el (nnslashdot-request-article): Update end-of-article - regexp. Articles containing quotation were cut prematurely. - -2006-09-16 Katsumi Yamaoka - - * message.el (message-cite-original-without-signature): Use nobody by - default for the value of From header. - (message-cite-original): Ditto. - (message-reply): Ditto. - -2006-09-09 Reiner Steib - - * pop3.el (pop3-leave-mail-on-server): Mention problem of duplicate - mails in the doc string. Add some URLs in comment. - -2006-09-07 Katsumi Yamaoka - - * rfc2047.el (rfc2047-quote-special-characters-in-quoted-strings): Fix - backslashes handling and the way to find boundaries of quoted strings. - -2006-09-06 Reiner Steib - - * gnus-art.el (gnus-button-regexp, gnus-button-marker-list) - (gnus-button-last): Move up. Convert comments into doc strings. - -2006-09-06 Daiki Ueno - - * pgg-gpg.el (pgg-gpg-process-region): Encode passphrase with - pgg-passphrase-coding-system rather than locale-coding-system. - * pgg-def.el (pgg-passphrase-coding-system): New user option. - -2006-09-05 Daiki Ueno - - * pgg.el (pgg-clear-string): Alias to clear-string for backward - compatibility. - - * pgg-gpg.el (pgg-gpg-process-region): Avoid display blinking with - inhibit-redisplay; encode passphrase with locale-coding-system. - -2006-09-04 Chong Yidong - - * message.el (message-send-mail-with-sendmail): Look for sendmail in - several common directories. - -2006-09-04 Katsumi Yamaoka - - * gnus-art.el (article-decode-encoded-words): Make it fast. - -2006-09-04 Katsumi Yamaoka - - * gnus-art.el (article-decode-encoded-words): Don't infloop in XEmacs. - - * rfc2047.el (rfc2047-strip-backslashes-in-quoted-strings): Decode `\\' - in quoted string into `\'. - -2006-09-04 Daiki Ueno - - * pgg-gpg.el (pgg-gpg-process-region): Revert two patches from Satyaki - Das. http://article.gmane.org/gmane.emacs.gnus.general/49947 - http://article.gmane.org/gmane.emacs.gnus.general/50457 - -2006-09-01 Katsumi Yamaoka - - * rfc2047.el (rfc2047-quote-special-characters-in-quoted-strings): - Use standard-syntax-table. - -2006-09-01 Katsumi Yamaoka - - * gnus-art.el (gnus-decode-address-function): New variable. - (article-decode-encoded-words): Use it to decode headers which are - assumed to contain addresses. - (gnus-mime-delete-part): Remove useless `or'. - - * gnus-sum.el (gnus-decode-encoded-address-function): New variable. - (gnus-summary-from-or-to-or-newsgroups): Use it to decode To header. - (gnus-nov-parse-line): Use it to decode From header. - (gnus-get-newsgroup-headers): Ditto. - (gnus-summary-enter-digest-group): Use it to decode `to-address'. - - * mail-parse.el (mail-decode-encoded-address-region): New alias. - (mail-decode-encoded-address-string): New alias. - - * rfc2047.el (rfc2047-quote-special-characters-in-quoted-strings): - New function. - (rfc2047-encode-message-header, rfc2047-encode-region): Use it. - (rfc2047-strip-backslashes-in-quoted-strings): New fnction. - (rfc2047-decode-region): Use it; add optional argument `address-mime'. - (rfc2047-decode-string): Ditto. - (rfc2047-decode-address-region): New function. - (rfc2047-decode-address-string): New function. - -2006-08-23 Andreas Seltenreich - - [ Backported bug fix from No Gnus. ] - - * gnus.el (gnus-find-method-for-group): On killed/unknown groups, try - looking up the method using GROUP's prefix before inventing a new one. - It is used on killed/unknown groups in various places where returning - an all-new method isn't expected by the caller. - - * gnus-util.el (gnus-group-server): Copy required macro from No Gnus. - -2006-08-13 Romain Francoise - - * mm-extern.el (mm-extern-mail-server): End `y-or-n-p' prompt with a - space. - -2006-08-09 Katsumi Yamaoka - - * compface.el (uncompface): Use binary rather than raw-text-unix. - -2006-08-09 Katsumi Yamaoka - - * compface.el (uncompface): Make sure the eol conversion doesn't take - place when communicating with the external programs. Reported by - ARISAWA Akihiro . - -2006-07-31 Katsumi Yamaoka - - * nnheader.el (nnheader-insert-head): Fix typo in comment. - -2006-07-31 Andreas Seltenreich - - * nnweb.el (nnweb-google-parse-1): Update regexp for author and date. - Make it more robust by parsing author and date independently. - -2006-07-28 Katsumi Yamaoka - - * nnheader.el (nnheader-insert-head): Make it work with Mac as well. - -2006-07-27 Katsumi Yamaoka - - * nnheader.el (nnheader-insert-head): Make it work even if the file - uses CRLF for the line-break code. - -2006-07-24 Daiki Ueno - - * pgg-def.el (pgg-truncate-key-identifier): Truncate the key ID to 8 - letters from the end. Thanks to "David Smith" and - andreas@altroot.de (Andreas V,Av(Bgele) - -2006-07-19 Andreas Seltenreich - - * mm-url.el (mm-url-insert-file-contents): Inhibit Connection: close - workaround for the url package included with Emacs. - - * nnweb.el (nnweb-google-create-mapping): Update regexp. - -2006-07-18 Karl Fogel - - * nnmail.el (nnmail-article-group): If splitting raises an error, give - some information about the error when saying that the `bogus' mail - group will be used. - -2006-07-18 Andreas Seltenreich - - [ Backported bug fixes from No Gnus. ] - - * nnweb.el (nnweb-google-parse-1): Update regexp for author and date. - (nnweb-google-search): Respect nnweb-max-hits as upper bound. - (nnweb-request-article): Do proper xwfu encoding when fetching articles - by message-id. - - * gnus-srvr.el (gnus-browse-unsubscribe-group): Don't subscribe - unsubscribed groups as if they were killed ones. It causes duplicate - entries in gnus-newsrc-alist. - -2006-07-17 Reiner Steib - - * gnus-sum.el (gnus-summary-delete-article): Don't use TAB in doc - string. - -2006-07-16 NAKAJI Hiroyuki (tiny change) - - * mm-util.el (mm-charset-synonym-alist): Map windows-31j to cp932. - -2006-07-14 Andreas Seltenreich - - * gnus-start.el (gnus-subscribe-options-newsgroup-method): Doc fix. - -2006-06-26 Reiner Steib - - * gnus-diary.el (gnus-user-format-function-d) - (gnus-user-format-function-D): Autoload. - -2006-06-26 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-select-group): Doc fix. - [ See 2004-05-19 change on the trunk. ] - -2006-06-20 Katsumi Yamaoka - - * rfc2231.el (rfc2231-parse-string): Allow `*'s in parameter values. - -2006-06-19 Katsumi Yamaoka - - * message.el (message-syntax-checks): Doc fix. - -2006-06-16 Katsumi Yamaoka - - * message.el (message-syntax-checks): Doc fix. - (message-send-mail): Add check for continuation headers. - (message-check-news-header-syntax): Fix regexp used to check for - continuation headers. - -2006-06-14 Katsumi Yamaoka - - * gnus-art.el (gnus-display-mime): Make sure body ends with newline. - -2006-06-06 Katsumi Yamaoka - - * mm-util.el (mm-mime-mule-charset-alist): Use unicode-precedence-list - to fill the utf-8 entry. - - * lpath.el: Fbind unicode-precedence-list. - -2006-06-05 Dan Christensen - - * gnus-sum.el (gnus-summary-read-group-1): When summary is unthreaded, - respect display group parameter and gnus-summary-expunge-below. - (gnus-articles-to-read): Remove unused reference to display group - parameter. - [ Merge 2004-07-06 change from the trunk. ] - -2006-05-29 Reiner Steib - - * gnus-ml.el (gnus-mailing-list-subscribe) - (gnus-mailing-list-unsubscribe, gnus-mailing-list-owner) - (gnus-mailing-list-message): Fix doc strings. - -2006-05-29 Andreas Seltenreich - - * gnus-ml.el (gnus-mailing-list-message): Use gnus-url-mailto instead - of doing it manually. - -2006-05-29 Kevin Greiner - - * gnus-agent.el (gnus-agent-possibly-synchronize-flags): A server - must be explicitly online rather than "not explicitly offline" for - its flags to be synchronized. - (gnus-agent-read-local): All symbols allocated in my-obarray - (gnus-agent-set-local): Skip invalid entries (min and/or max is nil). - (gnus-agent-regenerate-group): Check numeric names to see if they are - messages or groups. - -2006-05-29 Katsumi Yamaoka - - * gnus-art.el (gnus-save-all-headers): Mention it might be overridden. - (gnus-saved-headers): Ditto. - (gnus-default-article-saver): Doc fix; add - gnus-summary-write-body-to-file; mention functions may have properties. - (gnus-article-save-coding-system): New variable. - (gnus-article-save): Override gnus-save-all-headers and - gnus-saved-headers by :headers property which saver function may have. - (gnus-read-save-file-name): Add optional `dir-var' argument which - specifies directory in which files are saved; work even if optional - `variable' argument is not specified. - (gnus-summary-save-in-file): Add properties :decode and :headers. - (gnus-summary-write-to-file): Add properties :decode, :function, and - :headers; read file name. - (gnus-summary-save-body-in-file): Add :decode property; add optional - `overwrite' argument. - (gnus-summary-write-body-to-file): New function; add properties - :decode and :function. - (gnus-output-to-file): Add coding cookie and encode text according - to gnus-article-save-coding-system; don't use mm-append-to-file. - - * gnus-sum.el (gnus-newsgroup-last-directory): New variable. - (gnus-summary-local-variables): Add it. - (gnus-summary-save-map): Add gnus-summary-write-article-body-file. - (gnus-summary-save-article): Require gnus-art; save decoded articles - if function that gnus-default-article-saver specifies has `:decode' - property; bind gnus-prompt-before-saving to t when saving many - articles in a file; move point to article which will be saved. - (gnus-summary-write-article-body-file): New function. - - * lpath.el: Fbind select-safe-coding-system for XEmacs. - -2006-05-26 Reiner Steib - - * uudecode.el (uudecode-decode-region-external): Fix previous commit. - -2006-05-26 Katsumi Yamaoka - - * mm-util.el (mm-enrich-utf-8-by-mule-ucs): Don't edit - after-load-alist. - -2006-05-22 Reiner Steib - - * uudecode.el (uudecode-decode-region-external): nil isn't a valid - coding system in XEmacs, use binary. - - * mail-source.el (mail-sources): Fix custom type. - - * imap.el (Commentary): Fix typo. - -2006-05-18 Reiner Steib - - * gnus-sum.el (gnus-summary-save-article-mail): Clarify doc string. - (gnus-summary-expire-articles-now): Shorten prompt. - - * gmm-utils.el (wid-edit): Require. - (defun-gmm): Renamed from `gmm-defun-compat'. - (gmm-image-search-load-path): Use it. - (gmm-image-load-path-for-library): Use it. Sync with `mh-compat.el'. - -2006-05-04 Stefan Monnier - - * mm-decode.el (mm-dissect-buffer): Remove spurious double assignment. - (mm-copy-to-buffer): Use with-current-buffer. - (mm-display-part): Simplify. - (mm-inlinable-p): Add optional arg `type'. - - * gnus-art.el (gnus-mime-view-part-as-type): Add optional PRED arg. - (gnus-mime-view-part-externally, gnus-mime-view-part-internally): - Try harder to show the attachment internally or externally using - gnus-mime-view-part-as-type. - -2006-05-04 Reiner Steib - - * gnus-art.el (gnus-mime-view-part-as-type-internal): Try to fetch - `filename' from Content-Disposition if Content-Type doesn't - provide `name'. - (gnus-mime-view-part-as-type): Set default instead of initial-input. - -2006-04-28 Katsumi Yamaoka - - * mm-uu.el (mm-uu-pgp-encrypted-extract-1): Assume buffer is made - unibyte after clear-decrypt function runs. - - * mml2015.el (mml2015-pgg-clear-decrypt): Treat data which pgg - returns as a unibyte string. - -2006-04-27 Katsumi Yamaoka - - * lpath.el: Don't fbind string-as-multibyte for XEmacs. - - * pgg-gpg.el (pgg-string-to-multibyte): Remove. - (pgg-gpg-process-region): Revert. - - * pgg-pgp.el (pgg-pgp-process-region): Revert. - (pgg-pgp-lookup-key): Revert. - - * pgg-pgp5.el (pgg-pgp5-process-region): Revert. - (pgg-pgp5-lookup-key): Revert. - - * pgg.el (pgg-fetch-key): Revert. - -2006-04-27 Katsumi Yamaoka - - * lpath.el: Fbind make-network-process for both Emacs and XEmacs; - fbind string-as-multibyte for XEmacs. - - * mml1991.el (mml1991-pgg-sign): No need to load pgg.el, which is - always loaded by way of gnus-art.el -> mm-uu.el -> mml2015.el. - (mml1991-pgg-encrypt): Ditto. - - * pgg-gpg.el (pgg-string-to-multibyte): New function. - (pgg-gpg-process-region): Make sure pgg-output-buffer is always - a multibyte buffer. - - * pgg-pgp.el (pgg-pgp-process-region): Ditto. - (pgg-pgp-lookup-key): Ditto. - - * pgg-pgp5.el (pgg-pgp5-process-region): Ditto. - (pgg-pgp5-lookup-key): Ditto. - - * pgg.el (pgg-fetch-key): Ditto. - -2006-04-26 Reiner Steib - - * deuglify.el (gnus-outlook-deuglify-unwrap-min) - (gnus-outlook-deuglify-unwrap-max): Remove autoload. - - * mml-sec.el (mml-secure-method): New internal variable. - (mml-secure-sign, mml-secure-encrypt, mml-secure-message-sign) - (mml-secure-message-sign-encrypt, mml-secure-message-encrypt): - New functions using mml-secure-method. Sync from the trunk. - - * mml.el (mml-mode-map): Add key bindings for those functions. - (mml-menu): Simplify security menu entries. Suggested by Jesper - Harder . Sync from the trunk. - - * message.el (message-valid-fqdn-regexp): Add TLDs .cat, jobs, - .mobi and .travel. Remove .nato, .bitnet and .uucp. - (message-in-body-p): New function. Sync from the trunk. - - * mml.el (mml-mode, mml-dnd-protocol-alist) - (mml-dnd-attach-options, mml-dnd-attach-file) - (mml-attach-file, mml-attach-buffer, mml-attach-external): - Sync DND support and use of message-in-body-p from the trunk. - -2006-04-26 Katsumi Yamaoka - - * mml1991.el (mml1991-pgg-sign): Make sure to load pgg.el before - binding pgg-* variables; reimplement the section which prevents - MIME header from being signed. - (mml1991-pgg-encrypt): Make sure to load pgg.el before binding - pgg-text-mode; remove a blank line at the top of body. - - * mm-uu.el (mm-uu-pgp-encrypted-extract-1): Don't remove blank - lines at the top of body; use gnus-newsgroup-charset if there's no - Charset header. - -2006-04-25 Andreas Seltenreich - - * nnweb.el (nnweb-google-wash-article): Sync up to new Google HTML. - -2006-04-25 Katsumi Yamaoka - - * mm-uu.el (mm-uu-pgp-signed-test): Erase prompt. - (mm-uu-pgp-encrypted-test): Ditto. - (mm-uu-pgp-encrypted-extract-1): Make sure there's a blank line - between header and body; return application/pgp-encrypted handle - if decryption failed; decode decrypted body by charset. - - * mm-decode.el (mm-automatic-display): Don't make application/pgp - element match to application/pgp-*. - -2006-04-20 Reiner Steib - - * gnus-util.el (gnus-replace-in-string): - Prefer replace-regexp-in-string over of replace-in-string. - -2006-04-20 Katsumi Yamaoka - - * gnus-group.el: Bind tool-bar-mode instead of tool-bar-map. - - * gnus-sum.el: Ditto. - - * gnus-util.el (gnus-select-frame-set-input-focus): - Use select-frame-set-input-focus if it is available in XEmacs; use - definition defined in Emacs 22 for old Emacsen. - - * dgnushack.el: Autoload customize-group for XEmacs. - - * lpath.el: Bind codepage-setup, cursor-in-non-selected-windows - and select-frame-set-input-focus for XEmacs. - -2006-04-17 Reiner Steib - - [ Merge from Gnus trunk. ] - - * mm-util.el (mm-charset-synonym-alist): Improve doc string. - (mm-charset-override-alist): New variable. - (mm-charset-to-coding-system): Use it. - (mm-codepage-setup): New helper function. - (mm-charset-eval-alist): New variable. - (mm-charset-to-coding-system): Use mm-charset-eval-alist. - Warn about unknown charsets. Add allow-override. - Use `mm-charset-override-alist' only when decoding. - (mm-detect-mime-charset-region): Use :mime-charset. - - * mm-bodies.el (mm-decode-body, mm-decode-string): - Call `mm-charset-to-coding-system' with allow-override argument. - - * message.el (message-tool-bar-zap-list, message-tool-bar) - (message-tool-bar-gnome, message-tool-bar-retro): New variables. - (message-tool-bar-local-item-from-menu): Remove. - (message-tool-bar-map): Replace by `message-make-tool-bar'. - (message-make-tool-bar): New function. - (message-mode): Use `message-make-tool-bar'. - - * gnus-sum.el (gnus-summary-tool-bar) - (gnus-summary-tool-bar-gnome, gnus-summary-tool-bar-retro) - (gnus-summary-tool-bar-zap-list): New variables. - (gnus-summary-make-tool-bar): Complete rewrite using - `gmm-tool-bar-from-list'. - - * gnus-group.el (gnus-group-tool-bar, gnus-group-tool-bar-gnome) - (gnus-group-tool-bar-retro, gnus-group-tool-bar-zap-list): - New variables. - (gnus-group-make-tool-bar): Complete rewrite using - `gmm-tool-bar-from-list'. - (gnus-group-tool-bar-update): New function. - - * gmm-utils.el: New file. - -2006-04-12 Ralf Angeli - - * flow-fill.el (fill-flowed): Remove trailing space from blank - quoted lines. - -2006-04-12 Reiner Steib - - * gnus-art.el (gnus-article-mode): - Set cursor-in-non-selected-windows to nil. - -2006-04-12 Kenichi Handa - - * rfc2231.el (rfc2231-decode-encoded-string): Work on unibyte - buffer and then decode the buffer text if necessary. - (rfc2231-encode-string): Be sure to work on multibyte buffer at - first, and after mm-encode-body, change the buffer to unibyte. - Use mm-disable-multibyte instead of set-buffer-multibyte. - -2006-04-12 Katsumi Yamaoka - - * gnus-art.el (gnus-mime-view-part-as-charset): Ignore charset - that the part specifies. - - * mm-decode.el (mm-display-part): Work with external parts and - usual parts similarly. - - * mm-extern.el (mm-inline-external-body): Use mm-display-part - instead of gnus-display-mime. - - * gnus-uu.el (gnus-uu-save-article): Put mml tags instead of part - tag to summarized topics part in order to encode non-ASCII text. - -2006-04-11 Reiner Steib - - * gnus-art.el (gnus-button-valid-localpart-regexp): Exclude `@'. - -2006-04-11 Arne J,Ax(Brgensen - - * gnus-sieve.el (gnus-sieve-generate): Delete from the start of - the sieve region. - -2006-04-11 Reiner Steib - - * gnus.el: Gnus v5.10.8 is released. - -2006-04-11 Lars Magne Ingebrigtsen - - * nnslashdot.el (nnslashdot-retrieve-headers-1): Fix up to new layout. - - * rfc2047.el (rfc2047-decode-encoded-words): Don't message about - unknown charset. - - * message.el (message-header-synonyms): Add Original-To to the default. - - * gnus-sum.el (gnus-get-newsgroup-headers-xover): Group is an - optional parameter. - -2006-04-07 Reiner Steib - - * pgg-gpg.el: Revert to revision 7.15 to allow the use of gpg-agent. - -2006-04-06 Reiner Steib - - * gnus-fun.el (gnus): Require it for gnus-directory. - - * pgg-gpg.el: Revert to revision 7.11 because of unresolved - problems caused by adding symmetric encryption support and the - asynchronous gpg call. - -2006-04-05 Daiki Ueno - - * pgg-gpg.el (pgg-gpg-encrypt-region, pgg-gpg-sign-region): Wait - for BEGIN_SIGNING too, new in GnuPG 1.4.3. - -2006-03-29 Daiki Ueno - - * pgg-gpg.el (pgg-gpg-start-process): Don't bind - default-enable-multibyte-characters. This reverts the change from - revision 6.17 which is no longer necessary because the passphrase - is sent separately now. GnuPG messages are unreadable under - multibyte locales with default-enable-multibyte-characters set to - nil. - -2006-04-04 Andreas Seltenreich - - * nnweb.el (nnweb-google-create-mapping): Update regexp. - Some whitespace was matched into the url, which broke browsing hits - > 100 when mm-url-use-external was nil. - -2006-04-04 Daiki Ueno - - * pgg-gpg.el: Clean up process buffers every time gpg processes - complete. - -2006-04-03 Daiki Ueno - - * pgg-gpg.el (pgg-gpg-process-filter) - (pgg-gpg-wait-for-completion): Check if buffer is alive. - - * pgg-gpg.el (pgg-gpg-process-sentinel): Don't remove GNUPG: - lines, temporary fix. - -2006-03-31 Reiner Steib - - * gnus-group.el (gnus-group-update-tool-bar): Add :initialize and :set. - -2006-03-27 Daiki Ueno - - * pgg-gpg.el: Invoke gpg asynchronous, to avoid querying for - passphrases when it is not needed. - (pgg-gpg-use-agent): Add, to hard code that pgg shouldn't wait for - passphrase stuff from gpg, should only be necessary when you use - gpg with a smartcard. - -2006-03-23 Katsumi Yamaoka - - * mml.el (mml-insert-mime): Ignore cached contents of - message/external-body part. - - * mm-decode.el (mm-get-part): Add optional 'no-cache' argument. - (mm-insert-part): Ditto. - -2006-03-23 Simon Josefsson - - * pgg-gpg.el (pgg-gpg-update-agent): Add again, with fixes from - Reiner. - (pgg-gpg-use-agent-p): Use it again. - -2006-03-23 Simon Josefsson - - * pgg-gpg.el (pgg-gpg-update-agent): Remove, doesn't work with - older emacsen. - (pgg-gpg-use-agent-p): Don't use it. - -2006-03-22 Sascha Wilde - - * pgg-gpg.el (pgg-gpg-use-agent): Disable by default. - (pgg-gpg-update-agent): New function. - (pgg-gpg-use-agent-p): New function. - (pgg-gpg-process-region, pgg-gpg-encrypt-region) - (pgg-gpg-encrypt-symmetric-region, pgg-gpg-decrypt-region) - (pgg-gpg-sign-region): Use it. - -2006-03-22 Katsumi Yamaoka - - * gnus-sum.el (gnus-map-articles): Don't funcall symbol macro. - Reported by Ralf Wachinger . - -2006-03-21 Daniel Pittman - - * nnimap.el (nnimap-request-update-info-internal): Optimize. - Don't `gnus-uncompress-range' to avoid excessive memory usage. - -2006-03-21 Simon Josefsson - - * pgg-gpg.el: Ideas below based on patch from Sascha Wilde - . - (pgg-gpg-use-agent): New variable. - (pgg-gpg-process-region): Use it. - (pgg-gpg-encrypt-region): Likewise. - (pgg-gpg-encrypt-symmetric-region): Likewise. - (pgg-gpg-decrypt-region): Likewise. - (pgg-gpg-sign-region): Likewise. - (pgg-gpg-possibly-cache-passphrase): Don't cache a nil password. - -2006-03-21 Reiner Steib - - * gnus-agent.el (gnus-agent-queue-mail): Fix custom tag for `t'. - - * spam.el (spam-mark-new-messages-in-spam-group-as-spam): - Add comment on version. - -2006-03-20 Teodor Zlatanov - - * spam.el (spam-mark-new-messages-in-spam-group-as-spam): New variable. - (spam-mark-junk-as-spam-routine): Use it. Allow to disable - assigning the spam-mark to new messages. - -2006-03-20 Adam Sj,Ax(Bgren - - (spam-ham-copy-or-move-routine): Don't declare `todo' twice. - -2006-03-20 Reiner Steib - - * smiley.el: Add missing test smiley. - -2006-03-17 Katsumi Yamaoka - - * mm-decode.el (mm-with-part): New macro. - (mm-get-part): Use it; work with message/external-body as well. - (mm-save-part): Treat name and filename equally. - - * mm-extern.el (mm-extern-cache-contents): New function. - (mm-inline-external-body): Use it; force the part to be displayed; - move undisplayer added to the cached handle to the parent. - - * gnus-art.el (gnus-mime-save-part-and-strip): Add name parameter. - (gnus-mime-view-part-as-type): Work with message/external-body. - - * gnus-util.el (gnus-tool-bar-update): Bind tool-bar-mode. - -2006-03-15 Andreas Seltenreich - - * gnus-art.el (gnus-article-only-boring-p): - Bind inhibit-point-motion-hooks to avoid infinite loop when entering - intangible text. - Reported by Ralf Wachinger . - -2006-03-14 Simon Josefsson - - * message.el (message-unique-id): Don't use message-number-base36 - if (user-uid) is a float. - Reported by Bjorn Solberg . - -2006-03-13 Katsumi Yamaoka - - * mm-uu.el (mm-uu-dissect): Dissect all parts correctly. - - * gnus-art.el (gnus-mime-display-single): Make sure there is an - empty line between a part and a message part. - -2006-03-10 Reiner Steib - - * smiley.el: Add more test smileys. - (smiley-data-directory, smiley-regexp-alist) - (gnus-smiley-file-types): Fix doc strings. - (smiley-update-cache): Clear smiley-cached-regexp-alist before - adding new elements. - (smiley-mouse-map): Unused code. Make it a comment. - -2006-03-10 Katsumi Yamaoka - - * gnus-nocem.el (gnus-nocem-scan-groups): Add autoload cookie; - scan latest NoCeM messages instead of old ones. - (gnus-nocem-check-article): Fix regexps so as to match to PGP - delimiters that are recently used. - (gnus-nocem-load-cache): Add autoload cookie. - - * gnus.el (gnus-use-nocem): Enable it to be set to also a number. - - * gnus-start.el (gnus-setup-news): Scan NoCeM messages if a group - level which is larger than gnus-use-nocem is specified. - - * gnus-group.el (gnus-group-get-new-news): Ditto. - -2006-03-08 Reiner Steib - - * gnus-util.el (gnus-tool-bar-update): New function. - - * gnus-group.el (gnus-group-update-tool-bar): New variable. - (gnus-group-insert-group-line): Add gnus-tool-bar-update. - - * gnus-topic.el (gnus-topic-prepare-topic): Add gnus-tool-bar-update. - -2006-03-08 Katsumi Yamaoka - - * nnmail.el (nnmail-split-it): Invert match-partial-words behavior - if optional last element is specified in splits (FIELD VALUE...). - -2006-03-06 Katsumi Yamaoka - - * mm-view.el (mm-w3m-cid-retrieve-1): Check carefully whether - handle is multipart when calling it recursively. - (mm-w3m-cid-retrieve): Display warning if retrieving fails. - -2006-03-03 Reiner Steib - - * mm-util.el (mm-with-unibyte-current-buffer): Change "Emacs 23" - to "Emacs 23 (unicode)" in doc string. - - * gnus-sum.el (gnus-summary-set-display-table): Change "Emacs 23" to - "Emacs 23 (unicode)" in comment. - -2006-03-03 Katsumi Yamaoka - - * mm-decode.el (mm-get-part): Don't use mm-with-unibyte-current-buffer. - - * gnus-sum.el (gnus-summary-set-display-table): Don't nix out - characters 160 through 255 in Emacs 23. - -2006-03-02 Katsumi Yamaoka - - * mml.el (mml-generate-mime-1): Encode parts other than text/* or - message/* containing non-ASCII text properly. - -2006-02-28 Katsumi Yamaoka - - * mm-util.el (mm-with-unibyte-current-buffer): Add note. - -2006-02-28 Andreas Seltenreich - - * nnweb.el (nnweb-gmane-create-mapping): Don't choke on ^M. - -2006-02-28 Reiner Steib - - * nnweb.el (nnweb-type-definition, nnweb-gmane-search): - Use new nov.php. - -2006-02-28 Andreas Seltenreich - - * nnweb.el (nnweb-type-definition, nnweb-gmane-create-mapping) - (nnweb-gmane-wash-article, nnweb-gmane-search): Fix Gmane web - groups. Kudos to Olly Betts for providing NOV - output on the server side. - (nnweb-google-create-mapping): Update regexps and add some - progress indication. - -2006-02-28 Reiner Steib - - * message.el (message-user-fqdn): Remove useless * in doc string. - - * gnus-draft.el (gnus-draft-send): Bind message-signature to avoid - unnecessary interaction when sending queued mails. Reported by - TAKAHASHI Yoshio . - -2006-02-28 Lars Magne Ingebrigtsen - - * gnus-int.el (gnus-open-server): Respect gnus-batch-mode. - Merge of 2006-02-20 change from the trunk. - -2006-02-28 Lars Magne Ingebrigtsen - - * dns.el (query-dns): Protect more against buggy tcp output. - Merge of 2006-02-20 change from the trunk. - -2006-02-27 Reiner Steib - - * gnus-sum.el (gnus-sequence-of-unread-articles): Return nil if - first or last are nil. - -2006-02-24 Simon Josefsson - - * flow-fill.el (fill-flowed): Flow-fill unquoted lines too. - Merge of 2005-10-26 change from the trunk. - -2006-02-23 Lars Magne Ingebrigtsen - - * flow-fill.el (fill-flowed): Bind adaptive-fill-mode to nil. - Remove space stuffing, and only do quotes that actually start with - ">" at the beginning of the lines. - Merge of 2005-11-17 and 2004-07-25 from the trunk. - -2006-02-23 Reiner Steib - - * utf7.el (utf7-utf-16-coding-system): Fix comment. utf-16-be is - also available in Emacs 21.3. - - * message.el (message-fix-before-sending): Change "Emacs 22" to - "Emacs 23 (unicode)" in comment. - - * qp.el (quoted-printable-encode-region): Change "Emacs 22" to - "Emacs 23 (unicode)" in comment. - - * mm-util.el: Change "Emacs 22" to "Emacs 23 (unicode)" in - comment. - (mm-coding-system-p): Add comment about no-MULE XEmacs. - - * mm-view.el (mm-fill-flowed): Add :version. - -2006-02-23 Ralf Angeli - - * mm-view.el (mm-fill-flowed): New variable. - (mm-inline-text): Use it. - -2006-02-21 Wolfram Fenske (tiny change) - - * nnimap.el (nnimap-request-move-article): Change folder back to - source group before deleting. - -2006-02-20 Katsumi Yamaoka - - * rfc2047.el (rfc2047-charset-to-coding-system): Don't check the - coding system which mm-charset-to-coding-system returns for a - given charset is valid. - -2006-02-16 Juanma Barranquero - - * html2text.el (html2text-remove-tag-list): - * spam-stat.el (spam-stat-buffer-words): Fix typo in docstring. - -2006-02-14 Chong Yidong - - * gnus-cus.el: Revert 2005-10-17 change. - -2006-02-17 Katsumi Yamaoka - - * gnus-art.el (article-strip-banner): Call - article-really-strip-banner only when the regexp match is made. - -2006-02-16 Katsumi Yamaoka - - * gnus-art.el (article-strip-banner): Use - gnus-extract-address-components instead of - mail-header-parse-addresses to make it work with non-ASCII text. - - * rfc2231.el (rfc2231-parse-string): Attempt to parse parameter - values which are surrounded with \"...\"; make it never cause a - Lisp error; give up parsing of parameters if it failed in - extracting type. - -2006-02-15 Katsumi Yamaoka - - * mm-util.el (mm-make-temp-file): Import the Emacs 22 version of - make-temp-file; make it work with Emacs 20 and XEmacs as well. - - * mm-decode.el (mm-display-external): Use the 3rd arg of - mm-make-temp-file. - (mm-create-image-xemacs): Ditto. - -2006-02-14 Katsumi Yamaoka - - * gnus-draft.el (gnus-draft-send): Replace message-narrow-to-head - with message-narrow-to-headers. - (gnus-draft-setup): Narrow to header to run message-fetch-field. - (gnus-draft-check-draft-articles): New function. - (gnus-draft-edit-message, gnus-draft-send-message): Use it. - -2006-02-13 Katsumi Yamaoka - - * nnoo.el (nnoo-declare): Don't generate duplicate entries when - re-loading nn* modules. - -2006-02-10 Reiner Steib - - * gnus.el: Remove bogus comment. - -2006-02-09 Daiki Ueno - - * pgg-gpg.el (pgg-gpg-encrypt-region): Don't convert line-endings - in elisp. - (pgg-gpg-encrypt-symmetric-region): Ditto. - (pgg-gpg-sign-region): Ditto. - - * pgg-def.el (pgg-text-mode): New variable. - - * mml2015.el (mml2015-pgg-sign): Enable pgg-text-mode. - (mml2015-pgg-encrypt): Ditto. - - * mml1991.el (mml1991-pgg-sign): Enable pgg-text-mode. - (mml1991-pgg-encrypt): Ditto. - -2006-02-08 Katsumi Yamaoka - - * nnfolder.el (nnfolder-insert-newsgroup-line): Use - message-make-date instead of current-time-string. - - * mm-view.el (mm-inline-message): Don't set gnus-newsgroup-charset - to gnus-decoded which mm-uu might set. - -2006-02-08 Katsumi Yamaoka - - * rfc2231.el (rfc2231-parse-string): Sort segmented parameters; - don't decode quoted parameters; remove misimported Emacs code. - Suggested by ARISAWA Akihiro . - (rfc2231-decode-encoded-string): Don't use split-string which - behaves differently according to Emacs version; use - mm-decode-coding-region to convert charset to coding-system. - Suggested by ARISAWA Akihiro . - (rfc2231-encode-string): Remove misimported Emacs code. - -2006-02-07 Katsumi Yamaoka - - * gnus-art.el (article-decode-charset): Don't use ignore-errors - when calling mail-header-parse-content-type. - (article-de-quoted-unreadable): Ditto. - (article-de-base64-unreadable): Ditto. - (article-wash-html): Ditto. - - * mm-decode.el (mm-dissect-buffer): Don't use ignore-errors when - calling mail-header-parse-content-type and - mail-header-parse-content-disposition. - (mm-find-raw-part-by-type): Don't use ignore-errors when calling - mail-header-parse-content-type. - - * mml.el (mml-insert-mime-headers): Use mml-insert-parameter to - insert charset and format parameters; encode description after - inserting it to buffer. - (mml-insert-parameter): Fold lines properly even if a parameter is - segmented into two or more lines; change the max column to 76. - - * rfc1843.el (rfc1843-decode-article-body): Don't use - ignore-errors when calling mail-header-parse-content-type. - - * rfc2231.el (rfc2231-parse-string): Return at least type if - possible; don't cause an error even if it fails in parsing of - parameters. Suggested by ARISAWA Akihiro . - (rfc2231-encode-string): Don't break lines at the beginning, leave - it to mml-insert-parameter. - - * webmail.el (webmail-yahoo-article): Don't use ignore-errors when - calling mail-header-parse-content-type. - -2006-02-06 Reiner Steib - - * spam-report.el (spam-report-gmane-use-article-number): - Improve doc string. - (spam-report-gmane-internal): Check if a suitable header was found - in the article. - -2006-02-04 Katsumi Yamaoka - - * rfc2231.el (rfc2231-parse-string): Revert 2006-02-03 change. - (rfc2231-encode-string): Make param*=value always begin with LWSP. - -2006-02-05 Romain Francoise - - Update copyright notices of all files in the gnus directory. - -2006-02-03 Reiner Steib - - * gnus-util.el (gnus-error): Describe `args'. - -2006-02-03 Andreas Seltenreich - - * nnweb.el (nnweb-request-group): Avoid growing overview files. - -2006-02-03 Katsumi Yamaoka - - * rfc2231.el (rfc2231-parse-string): Add missing semicolons to - segmented lines of parameter value to cope with Thunderbird 1.5 - bug (cf. https://bugzilla.mozilla.org/show_bug.cgi?id=323318). - Suggested by ARISAWA Akihiro . - (rfc2231-encode-string): Don't make lines exceeding 76 column. - -2006-02-01 Max Froumentin (tiny change) - - * mml.el (mml-generate-mime-1): Correct the order of inline signed - parts. - -2006-01-31 Andreas Seltenreich - - * nnweb.el (nnweb-group-alist): Use defvar instead of defvoo, - there's only one active file for all servers. - (nnweb-request-scan): Make sure nnweb-articles is initialized on - solid groups. Gnus might have used a FAST request to select the group. - (nnweb-request-group, nnweb-google-parse-1): Don't keep nnweb-type - and nnweb-search redundantly in the active file. - (nnweb-request-list): Don't list bogus groups. There can only be one. - (nnweb-request-create-group): Don't use ARGS. - (nnweb-possibly-change-server, nnweb-request-group): Remove some - initialisations. Let nnoo do the work. - -2006-01-31 Romain Francoise - - * message.el (message-alternative-emails): Improve docstring. - (message-setup-1): Call `message-use-alternative-email-as-from' - after `message-setup-hook' to give it precedence over posting - styles, etc. - (message-use-alternative-email-as-from): Add docstring. - Remove the original From header if present. - -2006-01-31 Katsumi Yamaoka - - * mm-uu.el (mm-uu-emacs-sources-extract, mm-uu-diff-extract): - Say the part has been decoded. - -2006-01-31 Kevin Ryde - - * mailcap.el (mailcap-viewer-passes-test): Don't put "(nil t)" into - mailcap-viewer-test-cache when there's no 'test clause, since that - will invert the meaning of a "nil" test previously determined by - mailcap-mailcap-entry-passes-test. - -2006-01-30 Reiner Steib - - * nnweb.el (nnweb-google-parse-1): Clarify some comments. - -2006-01-30 Andreas Seltenreich - - * nnweb.el (nnweb-type-definition, nnweb-google-parse-1) - (nnweb-google-create-mapping, nnweb-google-search): Adapt to - current Google Groups. - -2006-01-26 Katsumi Yamaoka - - * Makefile.in (clean): New rule. - (distclean): Use it. - -2006-01-25 Katsumi Yamaoka - - * mm-uu.el (mm-uu-dissect-text-parts): Ignore it if a given part - is dissected into a single part of which the type is the same as - the given one; decode charset. - -2006-01-21 Kevin Ryde - - * mailcap.el (mailcap-parse-mailcap-extras): "test" key must go - into alists as symbol not string, since that's what - mailcap-viewer-passes-test and mailcap-mailcap-entry-passes-test - look for. - -2006-01-24 Katsumi Yamaoka - - * mm-uu.el (mm-uu-dissect-text-parts): Reduce the number of - recursive calls. - -2006-01-24 Katsumi Yamaoka - - * mm-view.el (mm-w3m-standalone-supports-m17n-p): New variable. - (mm-w3m-standalone-supports-m17n-p): New function. - (mm-inline-text-html-render-with-w3m-standalone): Use it to alter - w3m usage. - - * gnus-art.el (gnus-article-wash-html-with-w3m-standalone): Use - mm-w3m-standalone-supports-m17n-p to alter w3m usage. - -2006-01-23 Katsumi Yamaoka - - * mm-uu.el (mm-uu-dissect-text-parts): Decode content transfer - encoding. - -2006-01-20 Reiner Steib - - * mml.el (mml-attach-file): Describe `description' in doc string. - (mml-menu): Add Emacs MIME manual and PGG manual. - -2006-01-19 Reiner Steib - - * spam.el (spam-group-ham-mark-p, spam-group-spam-mark-p) - (spam-group-spam-marks, spam-list-articles, spam-group-ham-marks): - Revert 2006-01-08 change because the functions will be used in No - Gnus. - -2006-01-19 Katsumi Yamaoka - - * mm-bodies.el (mm-decode-body): Don't decode decoded body. - - * mm-uu.el (mm-uu-dissect-text-parts): Dissect dissected parts. - -2006-01-17 Katsumi Yamaoka - - * mm-decode.el (mm-inlined-types): Add application/pgp. - (mm-automatic-display): Ditto. - - * mm-uu.el (mm-uu-dissect-text-parts): Recognize application/pgp - part as text. - -2006-01-16 Katsumi Yamaoka - - * nnrss.el: Update copyright. - (nnrss-opml-import): Query whether to subscribe to each entry. - - * gnus-art.el: - * gnus-cus.el: - * gnus-group.el: - * gnus-start.el: - * gnus-sum.el: - * gnus-xmas.el: - * messagexmas.el: - * mm-uu.el: - * mm-view.el: Update copyright. - -2006-01-16 Reiner Steib - - * message.el (message-info): New function. - (message-mode-menu): Add it. - Update copyright. - - * ChangeLog: Fix and update copyright. - -2006-01-16 Katsumi Yamaoka - - * mm-uu.el (mm-uu-text-plain-type): New variable. - (mm-uu-pgp-signed-extract-1): Use it. - (mm-uu-pgp-encrypted-extract-1): Use it. - (mm-uu-dissect): Use it; allow two optional arguments; one is a - flag specifying whether there's no message header; the other is - for a MIME type and parameters; bind mm-uu-text-plain-type with - the later one. - (mm-uu-dissect-text-parts): New function. - - * gnus-art.el (gnus-display-mime): Use mm-uu-dissect-text-parts to - dissect text parts. - -2006-01-13 Katsumi Yamaoka - - * gnus-art.el (article-wash-html): Use - gnus-summary-show-article-charset-alist if a numeric arg is given. - (gnus-article-wash-html-with-w3m-standalone): New function. - - * mm-view.el (mm-text-html-renderer-alist): Map w3m-standalone to - mm-inline-text-html-render-with-w3m-standalone. - (mm-text-html-washer-alist): Map w3m-standalone to - gnus-article-wash-html-with-w3m-standalone. - (mm-inline-text-html-render-with-w3m-standalone): New function. - -2006-01-10 Katsumi Yamaoka - - * nnrss.el (nnrss-wash-html-in-text-plain-parts): New variable. - (nnrss-request-article): Render text/plain parts as HTML. - - * gnus-art.el (gnus-article-wash-html-with-w3m): No need to narrow - the buffer. - -2006-01-08 Reiner Steib - - * gnus-cus.el (gnus-group-parameters): Sync posting-style with - custom definition of `gnus-posting-styles'. - - * gnus-start.el (gnus-gnus-to-quick-newsrc-format): Bind - print-circle. Suggested by Kalle Olavi Niemitalo . - -2006-01-05 Reiner Steib - - * gnus-group.el (gnus-useful-groups): Use Gmane for ding. - Use nntp for bug archive. - -2006-01-05 Katsumi Yamaoka - - * nnrss.el (nnrss-request-article): Fix the way to fill text/plain - parts. - (nnrss-normalize-date): New function converts ISO 8601 date into - RFC822 style. Suggested by Mark Plaksin . - (nnrss-check-group): Use it. - -2006-01-03 Rodrigo Ventura (tiny change) - - * gnus-xmas.el (gnus-xmas-group-startup-message): Typo - gnus-splash-face -> gnus-splash. Fixes starting from a TTY in - XEmacs. - -2006-01-01 Katsumi Yamaoka - - * gnus-sum.el (gnus-summary-work-articles): Remove useless `min'. - - * nnrss.el (nnrss-fetch): Make it fail gracefully when it can't - fetch a feed. Suggested by Mark Plaksin . - (nnrss-insert-w3): Ditto. - -2005-12-21 Katsumi Yamaoka - - * nnrss.el (nnrss-request-article): Fix last change; fill - text/plain parts. - -2005-12-20 Katsumi Yamaoka - - * nnrss.el (nnrss-request-article): Replace
s with newlines - in text/plain part. - (nnrss-check-group): Don't add excessive newline to dc:subject. - -2005-12-19 Katsumi Yamaoka - - * gnus-art.el (gnus-article-delete-text-of-type): Enable it to - remove MIME buttons associated with multipart/alternative parts. - (gnus-mime-display-alternative): Tag buttons using `article-type' - text property. - - * gnus-msg.el (gnus-copy-article-buffer): Remove MIME buttons - associated with multipart/alternative parts. - -2005-12-19 Mark Plaksin (tiny change) - - * nnrss.el (nnrss-check-group): Put the RSS dc:subject in the - article. - -2005-12-18 Lars Magne Ingebrigtsen - - * dns.el (query-dns): Make sure we check the buffer size before - removing tcp headers. - -2006-01-08 Chong Yidong - - * spam.el (spam-group-ham-mark-p, spam-group-spam-mark-p) - (spam-group-spam-marks): Delete functions. - (spam-list-articles): Just call spam-group-ham-marks directly. - (spam-group-ham-marks): Simplify. - -2005-12-16 Katsumi Yamaoka - - * gnus-art.el (gnus-signature-separator): Fix custom type. - - * mm-decode.el (mm-inlined-types): Fix custom type. - (mm-keep-viewer-alive-types): Ditto. - (mm-automatic-display): Ditto. - (mm-attachment-override-types): Ditto. - (mm-inline-override-types): Ditto. - (mm-automatic-external-display): Ditto. - -2005-12-12 Katsumi Yamaoka - - * gnus-art.el (gnus-buttonized-mime-types): Mention addition of - multipart/alternative and add xref to mm-discouraged-alternatives - in doc string. - - * mm-decode.el (mm-discouraged-alternatives): Add xref to - gnus-buttonized-mime-types in doc string. - -2005-12-12 Katsumi Yamaoka - - * rfc2047.el (rfc2047-charset-to-coding-system): Recognize - us-ascii as a MIME charset. - - * mm-bodies.el (mm-decode-content-transfer-encoding): Protect - against the case where the 2nd arg TYPE is nil. - -2005-12-09 Reiner Steib - - * gnus-start.el (gnus-no-server-1): Mention - `gnus-level-default-subscribed' in doc string. - -2005-11-26 Dave Love - - * tls.el (open-tls-stream): Rename arg SERVICE to PORT. - (tls-program, tls-success): Provide openssl alternative. - - * starttls.el: Doc fixes. - (starttls-open-stream-gnutls, starttls-open-stream): Rename arg - SERVICE to PORT. - -2005-12-09 Reiner Steib - - * gnus-start.el (gnus-start-draft-setup): Enforce - `gnus-draft-mode' for nndraft:drafts at startup. - - * gnus.el (gnus-splash): Change custom group. - (gnus-group-get-parameter, gnus-group-parameter-value): Describe - allow-list argument. - - * gnus-agent.el (gnus-agent-article-alist-save-format): Format doc - string. - -2005-12-09 ARISAWA Akihiro (tiny change) - - * mm-decode.el (mm-display-external): Add missing cdr. - -2005-12-12 Richard M. Stallman - - * mm-url.el (mm-url-load-url): Require url-parse and url-vars. - -2005-12-08 Reiner Steib - - * mm-decode.el (mm-discouraged-alternatives): Fix custom type. - Suggest image/.* in the doc string. - -2005-12-07 Katsumi Yamaoka - - * mm-decode.el (mm-display-external): Use nametemplate (defined in - RFC1524) if it is in mailcap or add a suffix according to - mailcap-mime-extensions when generating a temp filename; postpone - deleting a temp file for 2 seconds for some wrappers, shell - scripts, and so on, which might exit right after having started a - viewer command as a background job. - -2005-12-06 Reiner Steib - - * gnus-art.el (gnus-default-article-saver): Add user-defined - `function' to custom type. - -2005-12-02 ARISAWA Akihiro (tiny change) - - * mm-view.el (mm-inline-text-html-render-with-w3m): Fix misplaced - parens. - -2005-12-01 Katsumi Yamaoka - - * gnus-xmas.el (gnus-use-toolbar): Revert. - (gnus-xmas-setup-toolbar): Use global default-toolbar if - gnus-use-toolbar is default. - - * messagexmas.el (message-use-toolbar): Revert. - (message-setup-toolbar): Use global default-toolbar if - message-use-toolbar is default. - -2005-11-30 Katsumi Yamaoka - - * gnus-xmas.el (gnus-use-toolbar): Determine the default value - according to default-toolbar-visible-p. - - * messagexmas.el (message-use-toolbar): Ditto. - -2005-11-29 Reiner Steib - - * gnus-cache.el (gnus-cache-rename-group): Wrap doc strings and - long lines. - (gnus-cache-delete-group): Wrap doc strings. - - * gnus-agent.el (gnus-agent-rename-group) - (gnus-agent-delete-group): Wrap doc strings. - -2005-11-24 Pascal Rigaux (tiny change) - - * rfc2231.el (rfc2231-parse-string): Support non-ascii chars. - -2005-11-22 Katsumi Yamaoka - - * nnmail.el (nnmail-fancy-expiry-target): Use current-time instead - of current-time-string. - -2005-11-20 Stefan Schimanski (tiny change) - - * nnmail.el (nnmail-fancy-expiry-target): Protect against invalid - date header. - -2005-11-16 Boris Samorodov (tiny change) - - * imap.el (imap-kerberos4-open): Ignore SSL stuff. - -2005-11-14 Kevin Greiner - - * gnus-agent.el (gnus-agent-article-alist-save-format): Changed - internal variable to a custom variable. Changed default value - from compressed(2) to uncompressed(1). - (gnus-agent-read-agentview): Reversed revision 7.8 to restore - support for uncompressed agentview files. Taken together, reading - the agentview file should now be 6-7 times faster. - (gnus-agent-long-article, - gnus-agent-short-article, gnus-agent-score): Renamed category - keywords to match gnus-cus. - (gnus-agent-summary-fetch-series): Modified to protect against - gnus-agent-summary-fetch-group clearing processable flags. - (gnus-agent-synchronize-group-flags): Update live group buffer as - synchronization may occur due to the user toggling the plugged - status. - (gnus-agent-braid-nov): Now tests new nov entries - for duplicates which are removed. The invalid sort check then - triggers a rescan after the sort as sorting may have moved - duplicate entries such that they can be cheaply detected. - (gnus-agent-read-local): Trivial fix to format of - error message to display actual error condition. - (gnus-agent-save-local): Avoid saving symbols that are bound to - nil as they simply result in a warning message in - gnus-agent-read-local. - (gnus-agent-fetch-group-1): Clear downloadable flag when article - successfully downloaded. - (gnus-agent-regenerate-group): Use - gnus-agent-synchronize-group-flags to reset read status in both - gnus and server. - - * nntp.el (nntp-end-of-line): Doc fix. - (nntp-authinfo-rejected): New error condition. - (nntp-wait-for): Use new error condition to signal authentication - error. - (nntp-retrieve-data): Rethrow new error condition to break out of - recursive call to nntp-send-authinfo. - -2005-11-13 Katsumi Yamaoka - - * gnus-start.el (gnus-dribble-read-file): Use make-local-variable - rather than make-variable-buffer-local for file-precious-flag. - -2005-11-13 Katsumi Yamaoka - - * gnus-start.el (gnus-dribble-read-file): Quote file-precious-flag. - -2005-11-11 Jan Nieuwenhuizen - - * gnus-start.el (gnus-dribble-read-file): Set file-precious-flag, - as a buffer-local variable. This avoids creating truncated - dribble files as a result of a hang up, eg. - -2005-11-04 Ken Manheimer - - * pgg-pgp.el (pgg-pgp-encrypt-region, pgg-pgp-decrypt-region) - (pgg-pgp-encrypt-symmetric-region, pgg-pgp-encrypt-symmetric) - (pgg-pgp-encrypt, pgg-pgp-decrypt-region, pgg-pgp-decrypt) - (pgg-pgp-sign-region, pgg-pgp-sign): Add optional 'passphrase' - argument to all these routines, so the passphrase can be managed - externally and passed in to the system. - (pgg-pgp-decrypt-region, pgg-pgp-sign-region): Use new name for - pgg-add-passphrase-to-cache function. - - * pgg-pgp5.el (pgg-pgp5-encrypt-region, pgg-pgp5-decrypt-region) - (pgg-pgp5-encrypt-symmetric-region, pgg-pgp5-encrypt-symmetric) - (pgg-pgp5-encrypt, pgg-pgp5-decrypt-region, pgg-pgp5-decrypt) - (pgg-pgp5-sign-region, pgg-pgp5-sign): Add optional 'passphrase' - argument to all these routines, so the passphrase can be managed - externally and passed in to the system. - (pgg-pgp5-sign-region): Use new name of pgg-add-passphrase-to-cache - function. - -2005-10-30 Chong Yidong - - * imap.el (imap-open): Handle case where buffer is a buffer - object. - -2005-10-29 Ken Manheimer - - * pgg-gpg.el (pgg-gpg-select-matching-key): Fix: look at the right - part of the decoded armor to find the key-identifier. - (pgg-gpg-lookup-key-owner): New function to return the - human-readable identifier of a key owner. - (pgg-gpg-lookup-id-from-key-owner): Make it easy to identify the - key itself. - (pgg-gpg-decrypt-region): Prompt with the key owner (rather than - the key value) if we have a key and can match it against a secret - key. Also, added a note pointing out fact that the prompt only - indicates the first matching key. - - * pgg.el (pgg-decrypt): Passing along 'passphrase' in call to - pgg-decrypt-region. - (pgg-pending-timers): A new hash for tracking the passphrase cache - timers, so that new ones supercede old ones. - (pgg-add-passphrase-to-cache): Rename from - `pgg-add-passphrase-cache' to reduce confusion (all callers - changed). Modified to cancel old timers when new ones are added. - (pgg-remove-passphrase-from-cache): Rename from - `pgg-remove-passphrase-cache' to reduce confusion (all callers - changed). Modified to cancel old timers when their keys are - removed from the cache. - (pgg-cancel-timer): In Emacs, an alias for cancel-timer; in - XEmacs, an indirection to delete-itimer. - (pgg-read-passphrase-from-cache, pgg-read-passphrase): - Extract pgg-read-passphrase-from-cache from pgg-read-passphrase so - users can only check cache without risk of prompting. Correct bug in - notruncate behavior. - (pgg-read-passphrase-from-cache, pgg-read-passphrase) - (pgg-add-passphrase-cache, pgg-remove-passphrase-cache): - Add informative docstrings. - (pgg-decrypt): Convey provided passphrase in subordinate call to - pgg-decrypt-region. - -2005-10-20 Ken Manheimer - - * pgg.el (pgg-encrypt-region, pgg-encrypt-symmetric-region) - (pgg-encrypt-symmetric, pgg-encrypt, pgg-decrypt-region) - (pgg-decrypt, pgg-sign-region, pgg-sign): Add optional - 'passphrase' argument, so the passphrase can be managed externally - and then passed in to the system. - - * pgg.el (pgg-read-passphrase, pgg-add-passphrase-cache) - (pgg-remove-passphrase-cache): Add optional 'notruncate' argument, - so the passphrase cache can be used reliably with identifiers - besides a pgp packet's key id. - - * pgg-gpg.el (pgg-pgp-encrypt-region) - (pgg-pgp-encrypt-symmetric-region, pgg-pgp-encrypt-symmetric) - (pgg-pgp-encrypt, pgg-pgp-decrypt-region, pgg-pgp-decrypt) - (pgg-pgp-sign-region, pgg-pgp-sign): Add optional 'passphrase' - argument to all these routines, so the passphrase can be managed - externally and passed in to the system. - - * pgg-gpg.el (pgg-gpg-possibly-cache-passphrase): Add optional - 'notruncate' argument, so the passphrase cache can be used - reliably with identifiers besides a pgp packet's key id. - -2005-10-29 Sascha Wilde - - * pgg-gpg.el (pgg-gpg-encrypt-symmetric-region): New function for - symmetric encryption. - (pgg-gpg-symmetric-key-p): New function to check for an symmetric - encrypted session key. - (pgg-gpg-decrypt-region): When decrypting a symmetric encrypted - message ask for the passphrase in a proper way. - - * pgg.el (pgg-encrypt-symmetric, pgg-encrypt-symmetric-region): - New user commands for symmetric encryption. - -2005-11-10 Katsumi Yamaoka - - * messagexmas.el (message-use-toolbar): Change the valid values - into default, top, bottom, left, and right. - (message-toolbar-thickness): New variable. - (message-xmas-setup-toolbar): Locate gnus-xmas-glyph-directory as - well. - (message-setup-toolbar): Make it work. - - * gnus-xmas.el (gnus-xmas-update-toolbars): New function. - (gnus-use-toolbar): Change the valid values into default, top, - bottom, left, and right. - (gnus-toolbar-thickness): New variable. - (gnus-xmas-setup-toolbar): New function. - (gnus-xmas-setup-group-toolbar): Use it. - (gnus-xmas-setup-summary-toolbar): Use it. - -2005-11-30 Stefan Monnier - - * gnus-delay.el (gnus-delay-group): Don't autoload. - It's useless and could trigger a bug in cus-dep.el causing ldefs-boot - to be re-loaded when customizing the `gnus-delay' group. - -2005-11-19 Chong Yidong - - * message.el: Revert last changes. - (message-insert-citation-line): Use newlines. - -2005-11-17 Chong Yidong - - * message.el (message-courtesy-message) - (message-mark-insert-begin, message-mark-insert-end) - (message-elide-ellipsis, message-cancel-message) - (message-add-header, message-change-subject) - (message-cross-post-followup-to-header) - (message-cross-post-insert-note, message-reduce-to-to-cc) - (message-widen-reply, message-delete-not-region) - (message-kill-to-signature, message-insert-signature) - (message-insert-importance-high, message-insert-importance-low) - (message-insert-or-toggle-importance) - (message-insert-disposition-notification-to) - (message-indent-citation, message-yank-original) - (message-cite-original-without-signature, message-cite-original) - (message-insert-citation-line, message-position-on-field) - (message-fix-before-sending, message-send-mail-partially) - (message-send-mail, message-send-mail-with-sendmail) - (message-send-mail-with-qmail, message-send-news) - (message-check-news-header-syntax, message-generate-headers) - (message-insert-courtesy-copy, message-fill-address) - (message-fill-header, message-shorten-references) - (message-setup-1, message-cancel-news) - (message-forward-make-body-plain, message-forward-make-body-mime) - (message-forward-make-body-mml, message-encode-message-body) - (message-forward-make-body-digest-plain) - (message-forward-make-body-digest-mime) - (message-use-alternative-email-as-from): Insert `hard-newline' - instead of ordinary newlines. - -2005-11-09 Katsumi Yamaoka - - * message.el (message-generate-headers): Downcase the argument - given to message-check-element. - -2005-11-01 Katsumi Yamaoka - - * gnus.el (gnus-parameters-case-fold-search): New variable. - (gnus-parameters-get-parameter): Use it. - - * gnus-score.el (gnus-home-score-file): Doc fix. - -2005-11-01 Xavier Maillard (tiny change) - - * gnus-score.el (gnus-update-score-entry-dates): Doc fix. - -2005-10-31 Katsumi Yamaoka - - * mml.el (mml-preview): Doc fix. - -2005-10-27 Reiner Steib - - * flow-fill.el (fill-flowed-encode-tests): Restore trailing - whitespace removed in revision 7.8. Use concatenated string to - protect trailing whitespace. - -2005-10-27 Jouni K. Sepp,Ad(Bnen - - * nnimap.el (nnimap-search-uids-not-since-is-evil): Add variable. - (nnimap-request-expire-articles): Use it to avoid sending 'UID - SEARCH UID ... NOT SINCE' queries, for inefficient servers like - Courier IMAP ("some version from 2004"). Mostly based on similar - code in the same function. - -2005-10-26 Katsumi Yamaoka - - * message.el (message-display-completion-list): New function. - (message-expand-group): Use it; make sure the Completions buffer - is modifiable. - -2005-10-23 Chong Yidong - - * gnus-sum.el (gnus-ignored-from-addresses): Handle case where - user-mail-name is an empty string. - -2005-10-25 Reiner Steib - - * gnus-score.el (gnus-default-adaptive-score-alist): Set defaults - depending on gnus-score-decay-constant. - -2005-10-25 Lars Magne Ingebrigtsen - - * nnslashdot.el (nnslashdot-request-article) - (nnslashdot-retrieve-headers-1): Update to new HTML. - -2005-10-23 Simon Josefsson - - * imap.el (imap-gssapi-program): Align command line parameters - with latest GNU SASL. - (imap-gssapi-open): Ignore 'Trying ...' messages from GNU SASL. - -2005-10-20 Hiroshi Fujishima (tiny change) - - * mail-source.el (mail-source-fetch-pop): Require pop3. - (mail-source-check-pop): Ditto. - -2005-10-20 Katsumi Yamaoka - - * rfc2047.el (rfc2047-decode-encoded-words): Fix the handling of - errors. - -2005-10-19 Reiner Steib - - * gnus-art.el (gnus-treat-strip-trailing-blank-lines) - (gnus-treat-strip-leading-blank-lines): Improve doc string. - - * message.el (message-tool-bar-local-item-from-menu): Fix comment. - -2005-10-19 Katsumi Yamaoka - - * rfc2047.el (rfc2047-allow-incomplete-encoded-text): New variable. - (rfc2047-charset-to-coding-system): New function. - (rfc2047-decode-encoded-words): New function. - (rfc2047-decode-region): Use them. - (rfc2047-decode-cte): Remove. - (rfc2047-parse-and-decode): Remove. - (rfc2047-decode): Remove. - -2005-10-15 Kenichi Handa - - * rfc2047.el (rfc2047-decode-cte): New function. - (rfc2047-decode-region): Change the way to decode successive - encoded-words: decode B- or Q-encoding in each encoded-word, - concatenate them, and decode it as charset. - -2005-10-17 Chong Yidong - - * gnus-cus.el (gnus-custom-map): New variable. Bind mouse-1 to - widget-move-and-invoke. - (gnus-custom-mode): Use gnus-custom-map. - -2005-10-15 Bill Wohler - - * message.el (message-tool-bar-map): Renamed image file from - mail_send to mail/send. - -2005-10-16 Masatake YAMATO - - * message.el (message-expand-group): Pass the common - prefix substring of completion to `display-completion-list'. - -2005-10-09 Daniel Brockman - - * format-spec.el (format-spec): Propagate text properties of % spec. - -2005-01-21 Derek Atkins (tiny change) - - * pgg-pgp.el (pgg-pgp-decrypt-region): Use passphrase cache. - -2005-10-08 Simon Josefsson - - * pgg-parse.el (top-level): Don't require custom, it is - autoloaded. (To sync with No Gnus.) - -2005-05-09 Georg C. F. Greve (tiny change) - - * pgg-gpg.el (pgg-gpg-possibly-cache-passphrase): Fix PIN caching. - -2005-10-08 Simon Josefsson - - * pgg-def.el (top-level): Don't require custom, it is - autoloaded. (To sync with No Gnus.) - -2005-10-07 Katsumi Yamaoka - - * Makefile.in (list-installed-shadows): New entry. - (install): Use it. - (remove-installed-shadows): New entry. - - * dgnushack.el (dgnushack-default-load-path): New variable. - (dgnushack-find-lisp-shadows): New function. - (dgnushack-remove-lisp-shadows): New function. - -2005-10-04 David Hansen - - * nnrss.el (nnrss-request-article): Add support for the comments tag. - (nnrss-check-group): Ditto. - -2005-10-04 Reiner Steib - - * mm-url.el (mm-url-predefined-programs): Add switches for curl. - - * gnus-util.el (gnus-remove-duplicates): Remove. - - * nnmail.el (nnmail-article-group): Use mm-delete-duplicates - instead of gnus-remove-duplicates. - - * message.el (message-remove-duplicates): Remove. - (message-idna-to-ascii-rhs-1): Use mm-delete-duplicates instead of - message-remove-duplicates. - - * mm-util.el (mm-delete-duplicates): Use `delete-dups' if - available, else use implementation from `delete-dups'. - -2005-10-02 Katsumi Yamaoka - - * Makefile.in (install-el-elc): New entry. - (install): Use it so that .el files are necessarily installed. - -2005-09-30 Katsumi Yamaoka - - * time-date.el: Autoload parse-time-string, XEmacs needs it. - -2005-09-30 Stefan Monnier - - * mm-decode.el (mm-inline-media-tests): Check presence of the diff-mode - function rather than the diff-mode.el package. - (mm-display-external): Use with-current-buffer. - (mm-viewer-completion-map, mm-viewer-completion-map): - Move initialization inside declaration. - -2005-09-28 Reiner Steib - - * message.el: Remove useless autoloads. - -2005-09-28 Simon Josefsson - - * message.el (message-use-idna): Default to t. - (message-use-idna): Test whether encoding works too. Doc fix. - -2005-09-28 Katsumi Yamaoka - - * nntp.el (nntp-warn-about-losing-connection): Remove. - -2005-09-27 Reiner Steib - - * mm-uu.el (mm-uu-emacs-sources-regexp): Make variable - customizable. Change default value. - (mm-uu-diff-groups-regexp): Change default value. - (mm-uu-type-alist): Add doc string. - (mm-uu-configure): Add doc string. Make it interactive. - (mm-uu-diff-groups-regexp): Fix missing quotes from previous commit. - -2005-09-27 Simon Josefsson - - * message.el (message-idna-to-ascii-rhs-1): Reformat. - -2005-09-27 Arne J,Ax(Brgensen - - * message.el (message-remove-duplicates): New function. - Implementation borrowed from `gnus-remove-duplicates'. - (message-idna-to-ascii-rhs): Also encode idna addresses in - Reply-To:, Mail-Reply-To: and Mail-Followup-To:. - (message-idna-to-ascii-rhs-1): When `message-use-idna' is 'ask - only ask about the same idna domain once per header and also tell - in what header to replace the idna domain. - - * gnus-art.el (article-decode-idna-rhs): Also decode idna - addresses in Reply-To:, Mail-Reply-To: and Mail-Followup-To:. - (article-decode-idna-rhs): Fix regexp so that all idna-address in - a header is decoded and not just the last one. - -2005-09-27 Katsumi Yamaoka - - * gnus-art.el (gnus-mime-display-single): Don't modify text if it - has been decoded. - - * mm-decode.el (mm-insert-part): Don't modify text if it has been - decoded. - - * mm-view.el (mm-inline-text): Don't strip text props unless - decoding enriched or richtext parts. - -2005-09-25 Romain Francoise - - * gnus-agent.el (gnus-agent-expire-group, gnus-agent-expire): - * gnus-start.el (gnus-subscribe-interactively): - * gnus-uu.el (gnus-uu-grab-articles): - End `yes-or-no-p' and `y-or-n-p' prompts with question mark and - space. - -2005-09-24 Emilio C. Lopes - - * smime.el (smime-sign-buffer, smime-decrypt-buffer): - * mm-view.el (mm-view-pkcs7-decrypt): - * gnus-sum.el (gnus-summary-limit-to-extra) - (gnus-summary-respool-article, gnus-read-move-group-name): - * gnus-score.el (gnus-summary-increase-score): - * gnus-util.el (gnus-completing-read-with-default): - * gnus-art.el (gnus-read-save-file-name) - (gnus-summary-save-in-rmail, gnus-summary-save-in-mail) - (gnus-summary-save-in-file, gnus-summary-save-body-in-file): - * message.el (message-check-news-header-syntax): - Follow convention for reading with the minibuffer. - -2005-09-22 Reiner Steib - - * spam-report.el (spam-report-url-ping-plain): - Use gnus-extended-version as User-Agent. - - * gnus-agent.el (gnus-agent-synchronize-flags): Explain why the - default value is nil. - -2005-09-20 Lars Magne Ingebrigtsen - - * gnus-agent.el (gnus-agent-synchronize-flags): Switch the - default to nil, to be able to use Gnus at all. If the default - switches to something else, then the function should be fixed not - be exceedingly slow. - -2005-09-19 Reiner Steib - - * mm-url.el (mm-url-decode-entities): Fix regexp. - -2005-09-18 Deepak Goel - - * sieve.el (sieve-help): Fix `message' call: first arg should be a - format spec. - -2005-09-16 Katsumi Yamaoka - - * gnus.el (gnus-group-startup-message): Bind image-load-path. - -2005-09-14 Katsumi Yamaoka - - * gnus-art.el (gnus-mime-display-part): Protect against broken - MIME messages. - -2005-09-13 Katsumi Yamaoka - - * gnus-sum.el (gnus-summary-edit-article-done): Remove text props - before parsing header. - -2005-09-10 Reiner Steib - - * spam-report.el (spam-report-gmane): Fix generation of spam - report URL. - -2005-09-10 Simon Josefsson - - * gnus-agent.el (gnus-agent-synchronize-flags): Make the default - t, based on discussion on the ding list with Robert Epprecht - . - -2005-09-07 Reiner Steib - - * spam-report.el (spam-report-gmane): Make it work without - X-Report-Spam header. Gmane now only provides Archived-At. - This is only used if `spam-report-gmane-use-article-number' is nil. - (spam-report-gmane-spam-header): Remove. Not used anymore. - - * nnweb.el (nnweb-google-wash-article): Print a message if article - is not available. - -2005-09-07 TSUCHIYA Masatoshi - - * gnus-art.el (gnus-mime-display-single): Decode text/* parts - content before displaying. - -2005-09-06 Reiner Steib - - * mml-smime.el: Remove defvar of gnus-extract-address-components. - -2005-09-06 Katsumi Yamaoka - - * mm-view.el (mm-display-inline-fontify): Disable support modes. - - * lpath.el: Don't bind mc-pgp-always-sign, url-current-object, - url-package-name, url-package-version, - w3m-cid-retrieve-function-alist, w3m-current-buffer, - w3m-display-inline-images, and w3m-minor-mode-map. - -2005-09-05 Reiner Steib - - * message.el (message-tab-body-function): Fixed mismatched custom - type. - - * gnus.el (gnus-group-change-level-function): Ditto. - - * gnus-msg.el (gnus-outgoing-message-group): Ditto. - - * gnus-art.el (gnus-signature-limit) - (gnus-article-mime-part-function): Ditto. - -2005-09-04 Reiner Steib - - * nnweb.el (nnweb-type-definition, nnweb-google-wash-article): - Make fetching article by MID work again for Google Groups. Added - FIXME concerning gnus-group-make-web-group. - - * mml-smime.el (mml-smime-sign-query, mml-smime-get-dns-cert): - Don't depend on Gnus by using mail-extract-address-components if - gnus-extract-address-components is not bound. - - * gnus.el (gnus-user-agent): Use list of symbols instead of - symbols. Display full version number for (S)XEmacs. Optionally - display (S)XEmacs codename. - - * gnus-util.el (gnus-emacs-version): Update for new - `gnus-user-agent'. - - * gnus-msg.el (gnus-extended-version): Make it possible to omit - Gnus version. - -2005-09-02 Hrvoje Niksic - - * mm-encode.el (mm-encode-content-transfer-encoding): Likewise - when encoding. - - * mm-bodies.el (mm-decode-content-transfer-encoding): - De-canonicalize CRLF for all text content types, not just - text/plain. - -2005-09-02 Katsumi Yamaoka - - * gnus-sum.el (gnus-thread-hide-subtree): Doc fix. - - * gnus-msg.el (gnus-inews-insert-gcc): Fix the mistake of using - list, not listp. - -2005-08-29 Romain Francoise - - * gnus-fun.el (gnus-convert-image-to-face-command): Fix typo in - docstring. - (gnus-face-from-file): Likewise. - -2005-08-31 Juanma Barranquero - - * gnus-art.el (w3m-minor-mode-map): - * gnus-spec.el (gnus-newsrc-file-version): - * gnus-util.el (nnmail-active-file-coding-system) - (gnus-original-article-buffer, gnus-user-agent): - * gnus.el (gnus-ham-process-destinations) - (gnus-parameter-ham-marks-alist) - (gnus-parameter-spam-marks-alist, gnus-spam-autodetect) - (gnus-spam-autodetect-methods, gnus-spam-newsgroup-contents) - (gnus-spam-process-destinations, gnus-spam-process-newsgroups): - * mm-decode.el (gnus-current-window-configuration): - * mm-extern.el (gnus-article-mime-handles): - * mm-url.el (url-current-object, url-package-name) - (url-package-version): - * mm-view.el (gnus-article-mime-handles, gnus-newsgroup-charset) - (smime-keys, w3m-cid-retrieve-function-alist) - (w3m-current-buffer, w3m-display-inline-images) - (w3m-minor-mode-map): - * mml-smime.el (gnus-extract-address-components): - * mml.el (gnus-article-mime-handles, gnus-mouse-2) - (gnus-newsrc-hashtb, message-default-charset) - (message-deletable-headers, message-options) - (message-posting-charset, message-required-mail-headers) - (message-required-news-headers): - * mml1991.el (mc-pgp-always-sign): - * mml2015.el (mc-pgp-always-sign): - * nnheader.el (nnmail-extra-headers): - * rfc1843.el (gnus-decode-encoded-word-function) - (gnus-decode-header-function, gnus-newsgroup-name): - * spam-stat.el (gnus-original-article-buffer): Add defvars. - -2005-08-22 Karl Chen - - * gnus-art.el (gnus-treatment-function-alist): Move date-lapsed to - the end of the date treatments. - -2005-08-15 Simon Josefsson - - * pgg.el (url-insert-file-contents): Don't autoload it, Emacs has - it in url-handlers.el and XEmacs in url.el. Reported by Luca - Capello and Romain Francoise. - (pgg-fetch-key-function): Removed, not used? - (pgg-insert-url-with-w3): Require url, to get - url-insert-file-contents regardless of where it is defined. - -2005-08-08 Simon Josefsson - - * pgg.el: Autoload url-insert-file-contents instead of loading - w3/url. - (pgg-insert-url-with-w3): Don't load url here. - -2005-08-05 Daiki Ueno - - * mml2015.el (mml2015-pgg-sign): Make sure micalg is correct. - - * pgg-parse.el (pgg-parse-hash-algorithm-alist): Add SHA-2. - -2005-08-06 Romain Francoise - - * message.el: Fix typo in docstring. - -2005-08-05 Katsumi Yamaoka - - * mm-bodies.el (mm-encode-body): Use coding system rather than - charset to encode text. - - * mm-util.el (mm-find-mime-charset-region): Attempt to reduce the - number of charsets if utf-8 is available (XEmacs). - -2005-08-04 Lars Magne Ingebrigtsen - - * gnus-art.el (article-unsplit-urls): Don't anchor urls to the - start of the lines. - (gnus-picon-databases): Add /usr/share/picons. - -2005-08-04 Reiner Steib - - * gnus-art.el (gnus-button-valid-localpart-regexp): New variable - taken from `gnus-button-mid-or-mail-regexp'. - (gnus-button-mid-or-mail-regexp, gnus-button-alist): Use it. - (gnus-button-alist): Improve regexp for domain part of the MIDs - for news:localpart@domain buttons. - (gnus-button-ctan-directory-regexp): Update. - - * message.el (message-kill-buffer): Raise the current frame. - (message-bury): Use `window-dedicated-p'. - -2005-08-02 Katsumi Yamaoka - - * sieve-manage.el (sieve-manage-interactive-login): Use - make-local-variable rather than make-variable-buffer-local. - (sieve-manage-open): Ditto. - (sieve-manage-authenticate): Ditto. - - * mml.el (mml-generate-mime-1): Make the content type default to - text/plain if the filename is not specified. - -2005-08-01 Katsumi Yamaoka - - * gnus-uu.el (gnus-uu-save-article): Use insert-buffer-substring - instead of insert-buffer. - - * message.el (message-yank-original): Ditto; set the mark at the - end of the yanked message. - -2005-07-29 Katsumi Yamaoka - - * gnus-art.el (gnus-article-next-page-1): Reduce the number of - lines to scroll rather than to stop it. - - * mml.el (mml-generate-default-type): Add doc string. - (mml-generate-mime-1): Use mm-default-file-encoding or make it - default to application/octet-stream when determining the content - type if it is not specified for the part or the mml contents; add - a comment about mml-generate-default-type. - -2005-07-29 Reiner Steib - - * mml.el (mml-generate-mime-1): Use mm-default-file-encoding or - make it default to application/octet-stream when determining the - content type if it is not specified for the external contents. - -2005-07-28 Katsumi Yamaoka - - * rfc2231.el (rfc2231-parse-string): Take care that not only a - segmented parameter but also other parameters might be there. - -2005-07-27 Katsumi Yamaoka - - * mm-decode.el (mm-display-external): Delete temp file, directory - and buffer immediately if the external process is exited. - -2005-07-26 Katsumi Yamaoka - - * gnus-art.el (gnus-article-next-page-1): Don't scroll if there're - fewer lines than that of scroll-margin. - (gnus-article-prev-page): Narrow the range to bind scroll-in-place. - -2005-07-25 Katsumi Yamaoka - - * gnus-art.el (gnus-article-next-page): Revert. - (gnus-article-beginning-of-window): New macro. - (gnus-article-next-page-1): Use it. - (gnus-article-prev-page): Ditto. - (gnus-mime-save-part-and-strip): Use insert-buffer-substring - instead of insert-buffer. - (gnus-mime-delete-part): Ditto. - (gnus-article-edit-exit): Ditto. - - * gnus-util.el (gnus-beginning-of-window): Remove. - (gnus-end-of-window): Remove. - - * lpath.el: Don't bind scroll-margin. - -2005-07-25 Simon Josefsson - - * pgg.el (pgg-insert-url-with-w3): Don't load w3, it is possible - to have the url package without w3. Reported by Daiki Ueno - and Luigi Panzeri . - -2005-07-21 Stefan Monnier - - * mml.el (mml-minibuffer-read-disposition): Don't use inline by default - for text/rtf. Display default in prompt. Pass default for M-n. - - * mm-uu.el (mm-uu-copy-to-buffer): Use with-current-buffer. - -2005-07-16 Romain Francoise - - * gnus-uu.el (gnus-uu-save-article): Use `message-make-date' - instead of `current-time-string' as the latter creates a time - string that is not RFC 2822 compliant (it lacks the zone). - -2005-07-16 Lars Magne Ingebrigtsen - - * gnus-msg.el (gnus-button-mailto): Remove - save-selected-window-window hackery because it relies on - save-selected-window internals. - -2005-07-15 Katsumi Yamaoka - - * gnus-art.el (gnus-article-next-page): Use gnus-end-of-window. - (gnus-article-next-page-1): Use gnus-beginning-of-window. - (gnus-article-prev-page): Ditto. - - * gnus-util.el (gnus-beginning-of-window): New function. - (gnus-end-of-window): New function. - - * lpath.el: Bind scroll-margin for XEmacs. - -2005-07-13 Katsumi Yamaoka - - * gnus-salt.el (gnus-pick-mode): Remove the 5th arg of - gnus-add-minor-mode. - (gnus-binary-mode): Ditto. - - * gnus-topic.el (gnus-topic-mode): Ditto. - -2005-07-08 Ralf Angeli - - * gnus-art.el (gnus-article-next-page, gnus-article-next-page-1) - (gnus-article-prev-page): Take scroll-margin into consideration. - -2005-07-04 Lute Kamstra - - Update FSF's address in GPL notices. - -2005-07-04 Juanma Barranquero - - * gnus.el (gnus-exit): - * gnus-group.el (gnus-group-icons): - * nnmail.el (nnmail-prepare): Fix typos in docstrings. - - * gnus-nocem.el (gnus-nocem): - * message.el (message-various, message-buffers, message-sending) - (message-interface, message-forwarding, message-insertion) - (message-headers, message-news, message-mail): - * pgg-gpg.el (pgg-gpg): - * pgg-parse.el (pgg-parse): - * pgg-pgp.el (pgg-pgp): - * pgg-pgp5.el (pgg-pgp5): - * pop3.el (pop3): Finish `defgroup' description with period. - -2005-07-01 Katsumi Yamaoka - - * gnus-art.el (article-display-face): Improve the efficiency. - (article-display-x-face): Ditto; remove grey x-face stuff. - -2005-06-30 Katsumi Yamaoka - - * gnus-art.el (article-display-face): Correct the position in - which Faces are inserted; use dolist. - -2005-06-29 Didier Verna - - * gnus-art.el (article-display-face): Display faces in correct - order. - -2005-06-29 Katsumi Yamaoka - - * gnus-nocem.el (gnus-nocem-verifyer): Default to pgg-verify. - (gnus-nocem-check-article): Fetch the Type header. - (gnus-nocem-message-wanted-p): Fix the way to examine types. - (gnus-nocem-verify-issuer): Use functionp instead of fboundp. - (gnus-nocem-enter-article): Make sure gnus-nocem-hashtb is initialized. - - * pgg.el (pgg-verify): Return the verification result. - -2005-06-24 Juanma Barranquero - - * gnus-art.el (gnus-article-mode): Set `nobreak-char-display', not - `show-nonbreak-escape'. - -2005-06-23 Lute Kamstra - - * gnus-art.el (gnus-article-mode): Use kill-all-local-variables. - - * dig.el (dig-mode): - * smime.el (smime-mode): Use gnus-run-mode-hooks. - -2005-06-21 Juanma Barranquero - - * nnimap.el (nnimap-split-download-body): Fix spellings. - -2005-06-16 Juanma Barranquero - - * gnus-art.el (gnus-article-encrypt-body): - * gnus-cus.el (gnus-score-customize): - * mm-extern.el (mm-extern-local-file, mm-inline-external-body): - * pop3.el (pop3-user): Don't use `format' on `error' arguments. - -2005-06-16 Miles Bader - - * spam.el (spam): Remove "-face" suffix from face name. - (spam-face): New backward-compatibility alias for renamed face. - (spam-face, spam-initialize): Use renamed spam face. - - * message.el (message-header-to, message-header-cc) - (message-header-subject, message-header-newsgroups) - (message-header-other, message-header-name) - (message-header-xheader, message-separator, message-cited-text) - (message-mml): Remove "-face" suffix from face names. - (message-header-to-face, message-header-cc-face) - (message-header-subject-face, message-header-newsgroups-face) - (message-header-other-face, message-header-name-face) - (message-header-xheader-face, message-separator-face) - (message-cited-text-face, message-mml-face): - New backward-compatibility aliases for renamed faces. - (message-font-lock-keywords): Use renamed message faces. - - * sieve-mode.el (sieve-control-commands, sieve-action-commands) - (sieve-test-commands, sieve-tagged-arguments): - Remove "-face" suffix from face names. - (sieve-control-commands-face, sieve-action-commands-face) - (sieve-test-commands-face, sieve-tagged-arguments-face): - New backward-compatibility aliases for renamed faces. - (sieve-control-commands-face, sieve-action-commands-face) - (sieve-test-commands-face, sieve-tagged-arguments-face): - Use renamed sieve faces. - - * gnus.el (gnus-group-news-1, gnus-group-news-1-empty) - (gnus-group-news-2, gnus-group-news-2-empty, gnus-group-news-3) - (gnus-group-news-3-empty, gnus-group-news-4) - (gnus-group-news-4-empty, gnus-group-news-5) - (gnus-group-news-5-empty, gnus-group-news-6) - (gnus-group-news-6-empty, gnus-group-news-low) - (gnus-group-news-low-empty, gnus-group-mail-1) - (gnus-group-mail-1-empty, gnus-group-mail-2) - (gnus-group-mail-2-empty, gnus-group-mail-3) - (gnus-group-mail-3-empty, gnus-group-mail-low) - (gnus-group-mail-low-empty, gnus-summary-selected) - (gnus-summary-cancelled, gnus-summary-high-ticked) - (gnus-summary-low-ticked, gnus-summary-normal-ticked) - (gnus-summary-high-ancient, gnus-summary-low-ancient) - (gnus-summary-normal-ancient, gnus-summary-high-undownloaded) - (gnus-summary-low-undownloaded) - (gnus-summary-normal-undownloaded, gnus-summary-high-unread) - (gnus-summary-low-unread, gnus-summary-normal-unread) - (gnus-summary-high-read, gnus-summary-low-read) - (gnus-summary-normal-read, gnus-splash): - Remove "-face" suffix from face names. - (gnus-group-news-1-face, gnus-group-news-1-empty-face) - (gnus-group-news-2-face, gnus-group-news-2-empty-face) - (gnus-group-news-3-face, gnus-group-news-3-empty-face) - (gnus-group-news-4-face, gnus-group-news-4-empty-face) - (gnus-group-news-5-face, gnus-group-news-5-empty-face) - (gnus-group-news-6-face, gnus-group-news-6-empty-face) - (gnus-group-news-low-face, gnus-group-news-low-empty-face) - (gnus-group-mail-1-face, gnus-group-mail-1-empty-face) - (gnus-group-mail-2-face, gnus-group-mail-2-empty-face) - (gnus-group-mail-3-face, gnus-group-mail-3-empty-face) - (gnus-group-mail-low-face, gnus-group-mail-low-empty-face) - (gnus-summary-selected-face, gnus-summary-cancelled-face) - (gnus-summary-high-ticked-face, gnus-summary-low-ticked-face) - (gnus-summary-normal-ticked-face) - (gnus-summary-high-ancient-face, gnus-summary-low-ancient-face) - (gnus-summary-normal-ancient-face) - (gnus-summary-high-undownloaded-face) - (gnus-summary-low-undownloaded-face) - (gnus-summary-normal-undownloaded-face) - (gnus-summary-high-unread-face, gnus-summary-low-unread-face) - (gnus-summary-normal-unread-face, gnus-summary-high-read-face) - (gnus-summary-low-read-face, gnus-summary-normal-read-face) - (gnus-splash-face): - New backward-compatibility aliases for renamed faces. - (gnus-group-startup-message): Use renamed gnus faces. - - * gnus-srvr.el (gnus-server-agent, gnus-server-opened) - (gnus-server-closed, gnus-server-denied, gnus-server-offline) - (gnus-server-agent): Remove "-face" suffix from face names. - (gnus-server-agent-face, gnus-server-opened-face) - (gnus-server-closed-face, gnus-server-denied-face) - (gnus-server-offline-face): - New backward-compatibility aliases for renamed faces. - (gnus-server-agent-face, gnus-server-opened-face) - (gnus-server-closed-face, gnus-server-denied-face) - (gnus-server-offline-face): Use renamed gnus faces. - - * gnus-picon.el (gnus-picon-xbm, gnus-picon): - Remove "-face" suffix from face names. - (gnus-picon-xbm-face, gnus-picon-face): - New backward-compatibility aliases for renamed faces. - - * gnus-cite.el (gnus-cite-attribution, gnus-cite-1, gnus-cite-2) - (gnus-cite-3, gnus-cite-4, gnus-cite-5, gnus-cite-6) - (gnus-cite-7, gnus-cite-8, gnus-cite-9, gnus-cite-10) - (gnus-cite-11): Remove "-face" suffix from face names. - (gnus-cite-attribution-face, gnus-cite-face-1, gnus-cite-face-2) - (gnus-cite-face-3, gnus-cite-face-4, gnus-cite-face-5) - (gnus-cite-face-6, gnus-cite-face-7, gnus-cite-face-8) - (gnus-cite-face-9, gnus-cite-face-10, gnus-cite-face-11): - New backward-compatibility aliases for renamed faces. - (gnus-cite-attribution-face, gnus-cite-face-list) - (gnus-article-boring-faces): Use renamed gnus faces. - - * gnus-art.el (gnus-signature, gnus-header-from) - (gnus-header-subject, gnus-header-newsgroups, gnus-header-name) - (gnus-header-content): Remove "-face" suffix from face names. - (gnus-signature-face, gnus-header-from-face) - (gnus-header-subject-face, gnus-header-newsgroups-face) - (gnus-header-name-face, gnus-header-content-face): - New backward-compatibility aliases for renamed faces. - (gnus-signature-face, gnus-header-face-alist): Use renamed gnus faces. - - * gnus-sum.el (gnus-summary-selected-face) - (gnus-summary-highlight): Use renamed gnus faces. - * gnus-group.el (gnus-group-highlight): Likewise. - -2005-06-14 Juanma Barranquero - - * gnus-sieve.el (gnus-sieve-article-add-rule): - * legacy-gnus-agent.el (gnus-agent-unlist-expire-days): - * spam-stat.el (spam-stat-buffer-change-to-spam) - (spam-stat-buffer-change-to-non-spam): Follow error conventions. - - * message.el (message-is-yours-p): - * gnus-sum.el (gnus-auto-select-subject): Fix quoting in docstring. - -2005-06-14 Katsumi Yamaoka - - * mm-view.el (mm-inline-text): Withdraw the last change. - -2005-06-09 Katsumi Yamaoka - - * mm-view.el (mm-inline-text): Turn off adaptive-fill-mode while - executing enriched-decode. - -2005-06-04 Luc Teirlinck - - * gnus-art.el (article-update-date-lapsed): Use `save-match-data'. - -2005-06-04 Lute Kamstra - - * nnfolder.el (nnfolder-read-folder): Make sure that undo - information is never recorded. - -2005-06-03 Stefan Monnier - - * gnus-art.el (gnus-emphasis-alist): Disable the strikethru thingy. - -2005-06-02 Katsumi Yamaoka - - * pop3.el (pop3-md5): Run md5 in the binary mode. - (pop3-md5-program-args): New variable. - - * starttls.el (starttls-set-process-query-on-exit-flag): - Use eval-and-compile. - -2005-05-31 Katsumi Yamaoka - - * gnus-art.el (article-display-x-face): Replace - process-kill-without-query by gnus-set-process-query-on-exit-flag. - - * gnus-group.el: Bind gnus-cache-active-hashtb when compiling. - - * gnus-util.el (gnus-set-process-query-on-exit-flag): Alias to - set-process-query-on-exit-flag or process-kill-without-query. - - * html2text.el (html2text-fix-paragraphs): Use `while - re-search' - loop instead of replace-regexp. - - * imap.el (imap-ssl-open): Use set-process-query-on-exit-flag - instead of process-kill-without-query if it is available. - - * mm-util.el (mm-insert-file-contents): Bind find-file-hook - instead of find-file-hooks if it is available. - - * mml1991.el: Bind pgg-default-user-id when compiling. - - * mml2015.el: Bind pgg-default-user-id when compiling. - - * nndraft.el (nndraft-request-associate-buffer): - Use write-contents-functions instead of write-contents-hooks if it is - available. - - * nnheader.el (nnheader-find-file-noselect): Bind find-file-hook - instead of find-file-hooks if it is available. - - * nntp.el (nntp-open-connection): Replace - process-kill-without-query by gnus-set-process-query-on-exit-flag. - (nntp-open-ssl-stream): Ditto. - (nntp-open-tls-stream): Ditto. - - * pgg.el: Don't bind itimer vars; don't autoload itimer functions. - (pgg-run-at-time-1): New macro. - (pgg-run-at-time): Use it. - - * starttls.el (starttls-set-process-query-on-exit-flag): Alias to - set-process-query-on-exit-flag or process-kill-without-query. - (starttls-open-stream-gnutls): Use it instead of - process-kill-without-query. - (starttls-open-stream): Ditto. - -2005-05-31 Simon Josefsson - - * imap.el (imap-ssl-open): Use imap-process-connection-type, - instead of hard coding to nil. - -2005-05-31 Kevin Greiner - - * gnus-group.el: Require gnus-sum and autoload functions to - resolve warnings when gnus-group.el compiled alone. - -2005-05-30 Reiner Steib - - * gnus-agent.el (gnus-agent-regenerate-group) - (gnus-agent-fetch-articles): Replace `string-to-int' by - `string-to-number'. - * gnus-art.el (gnus-button-fetch-group): Ditto. - * gnus-cache.el (gnus-cache-generate-active) - (gnus-cache-articles-in-group): Ditto. - * gnus-group.el (gnus-group-set-current-level) - (gnus-group-insert-group-line): Ditto. - * gnus-score.el (gnus-score-set-expunge-below) - (gnus-score-set-mark-below, gnus-summary-score-effect) - (gnus-summary-score-entry): Ditto. - * gnus-soup.el (gnus-soup-send-packet, gnus-soup-parse-areas) - (gnus-soup-pack): Ditto. - * gnus-spec.el (gnus-xmas-format): Ditto. - * gnus-start.el (gnus-newsrc-to-gnus-format): Ditto. - * gnus-sum.el (gnus-create-xref-hashtb): Ditto. - * gnus-uu.el (gnus-uu-expand-numbers): Ditto. - * nnbabyl.el (nnbabyl-article-group-number): Ditto. - * nndb.el (nndb-get-remote-expire-response): Ditto. - * nndiary.el (nndiary-parse-schedule-value) - (nndiary-string-to-number, nndiary-request-replace-article) - (nndiary-request-article): Ditto. - * nndoc.el (nndoc-rnews-body-end, nndoc-mbox-body-end): Ditto. - * nndraft.el (nndraft-articles, nndraft-request-group): Ditto. - * nneething.el (nneething-make-head): Ditto. - * nnfolder.el (nnfolder-request-article) - (nnfolder-retrieve-headers): Ditto. - * nnheader.el (nnheader-file-to-number): Ditto. - * nnkiboze.el (nnkiboze-request-article): Ditto. - * nnmail.el (nnmail-process-unix-mail-format) - (nnmail-process-babyl-mail-format): Ditto. - * nnmbox.el (nnmbox-read-mbox, nnmbox-article-group-number): Ditto. - * nnmh.el (nnmh-update-gnus-unreads, nnmh-active-number) - (nnmh-request-create-group, nnmh-request-list-1) - (nnmh-request-group, nnmh-request-article): Ditto. - * nnml.el (nnml-request-replace-article, nnml-request-article): Ditto. - * nnrss.el (nnrss-find-rss-via-syndic8): Ditto. - * nnsoup.el (nnsoup-make-active): Ditto. - * nnspool.el (nnspool-find-id, nnspool-request-group): Ditto. - * nntp.el (nntp-find-group-and-number) - (nntp-retrieve-headers-with-xover): Ditto. - * pgg-gpg.el (pgg-gpg-snarf-keys-region): Ditto. - * pgg-parse.el (pgg-read-body, pgg-read-bytes) - (pgg-format-key-identifier): Ditto. - * pop3.el (pop3-last, pop3-stat): Ditto. - * qp.el (quoted-printable-decode-region): Ditto. - - * spam-report.el (spam-report-url-ping-mm-url): Use format instead - of concat. - -2005-05-30 Katsumi Yamaoka - - * gnus-agent.el (gnus-category-mode): Use gnus-run-mode-hooks. - - * gnus-art.el (gnus-article-mode): Use gnus-run-mode-hooks. - - * gnus-cus.el (gnus-custom-mode): Use gnus-run-mode-hooks. - - * gnus-eform.el (gnus-edit-form-mode): Use gnus-run-mode-hooks. - - * gnus-group.el (gnus-group-mode): Use gnus-run-mode-hooks. - - * gnus-kill.el (gnus-kill-file-mode): Use gnus-run-mode-hooks. - - * gnus-salt.el (gnus-tree-mode): Use gnus-run-mode-hooks. - (gnus-carpal-mode): Ditto. - - * gnus-srvr.el (gnus-server-mode): Use gnus-run-mode-hooks. - (gnus-browse-mode): Ditto. - - * gnus-sum.el (gnus-summary-mode): Use gnus-run-mode-hooks. - - * gnus-util.el (gnus-run-mode-hooks): Save current buffer. - -2005-05-29 Richard M. Stallman - - * gnus-cite.el (gnus-cite-add-face): Set overlay's evaporate property. - -2005-05-27 Katsumi Yamaoka - - * gnus-util.el (gnus-run-mode-hooks): New function. - - * score-mode.el (gnus-score-mode): Use gnus-run-mode-hooks. - - * dgnushack.el: Advise byte-optimize-form-code-walker to avoid the - ``...called for effect'' warnings for Emacs 21.4 as well as 21.3. - -2005-05-26 Luc Teirlinck - - * gnus-agent.el (gnus-agent-make-mode-line-string): - Use mode-line-highlight as mouse-face. - -2005-05-17 Katsumi Yamaoka - - * canlock.el (canlock): Change the parent group to news. - - * deuglify.el (gnus-outlook-deuglify): Add :group. - - * dig.el (dig): Add :group. - - * gnus-art.el (gnus-inhibit-mime-unbuttonizing): Add :group. - - * gnus-cite.el (gnus-cite-attribution-face): Add :group. - (gnus-cite-face-1, gnus-cite-face-2, gnus-cite-face-3): Ditto. - (gnus-cite-face-4, gnus-cite-face-5, gnus-cite-face-6): Ditto. - (gnus-cite-face-7, gnus-cite-face-8, gnus-cite-face-9): Ditto. - (gnus-cite-face-10, gnus-cite-face-11): Ditto. - - * gnus-diary.el (gnus-diary): Add :group. - - * gnus.el (gnus-group-news-1-face): Add :group. - (gnus-group-news-1-empty-face): Ditto. - (gnus-group-news-2-face, gnus-group-news-2-empty-face): Ditto. - (gnus-group-news-3-face, gnus-group-news-3-empty-face): Ditto. - (gnus-group-news-4-face, gnus-group-news-4-empty-face): Ditto. - (gnus-group-news-5-face, gnus-group-news-5-empty-face): Ditto. - (gnus-group-news-6-face, gnus-group-news-6-empty-face): Ditto. - (gnus-group-news-low-face, gnus-group-news-low-empty-face): Ditto. - (gnus-group-mail-1-face, gnus-group-mail-1-empty-face): Ditto. - (gnus-group-mail-2-face, gnus-group-mail-2-empty-face): Ditto. - (gnus-group-mail-3-face, gnus-group-mail-3-empty-face): Ditto. - (gnus-group-mail-low-face, gnus-group-mail-low-empty-face): Ditto. - (gnus-summary-selected-face, gnus-summary-cancelled-face): Ditto. - (gnus-summary-high-ticked-face): Ditto. - (gnus-summary-low-ticked-face): Ditto. - (gnus-summary-normal-ticked-face): Ditto. - (gnus-summary-high-ancient-face): Ditto. - (gnus-summary-low-ancient-face): Ditto. - (gnus-summary-normal-ancient-face): Ditto. - (gnus-summary-high-undownloaded-face): Ditto. - (gnus-summary-low-undownloaded-face): Ditto. - (gnus-summary-normal-undownloaded-face): Ditto. - (gnus-summary-high-unread-face): Ditto. - (gnus-summary-low-unread-face): Ditto. - (gnus-summary-normal-unread-face): Ditto. - (gnus-summary-high-read-face, gnus-summary-low-read-face): Ditto. - (gnus-summary-normal-read-face, gnus-splash-face): Ditto. - - * message.el (message-minibuffer-local-map): Add :group. - - * sieve-manage.el (sieve-manage-log): Add :group. - (sieve-manage-default-user): Diito. - (sieve-manage-server-eol, sieve-manage-client-eol): Ditto. - (sieve-manage-streams, sieve-manage-stream-alist): Ditto. - (sieve-manage-authenticators): Ditto. - (sieve-manage-authenticator-alist): Ditto. - (sieve-manage-default-port): Ditto. - - * sieve-mode.el (sieve-control-commands-face): Add :group. - (sieve-action-commands-face): Ditto. - (sieve-test-commands-face): Ditto. - (sieve-tagged-arguments-face): Ditto. - - * smime.el (smime): Add :group. - - * spam-report.el (spam-report): Add :group. - - * spam.el (spam, spam-face): Add :group. - -2005-05-26 Lute Kamstra - - * score-mode.el (gnus-score-mode): Use run-mode-hooks. - -2005-05-16 Katsumi Yamaoka - - * dgnushack.el: Autoload mail-extract-address-components for XEmacs. - - * gnus-art.el: Don't autoload mail-extract-address-components. - - * gnus.el: Use eval-and-compile to autoload message-y-or-n-p. - - * nndb.el: Don't declare the nndb back end two or more times; don't - autoload news-reply-mode, news-setup, cancel-timer and telnet. - - * nntp.el: Autoload format-spec instead of format; use - eval-and-compile to evaluate autoload forms. - - * spam-report.el (spam-report-process-queue): Use gnus-point-at-eol. - -2005-04-28 Katsumi Yamaoka - - * gnus-art.el (article-date-ut): Support converting date in - forwarded parts as well. - (gnus-article-save-original-date): New macro. - (gnus-display-mime): Use it. - -2005-04-28 David Hansen - - * nnrss.el (nnrss-check-group, nnrss-request-article): Support the - enclosure element of . - -2005-04-24 Teodor Zlatanov - - * spam-report.el (spam-report-unplug-agent) - (spam-report-plug-agent, spam-report-deagentize) - (spam-report-agentize, spam-report-url-ping-temp-agent-function): - support for the Agent in spam-report: when unplugged, report to a - file; when plugged, submit all the requests. - [Added missing offline functionality from trunk.] - -2005-04-24 Reiner Steib - - * spam-report.el (spam-report-url-to-file) - (spam-report-requests-file): New function and variable for offline - reporting. - (spam-report-url-ping-function): Add `spam-report-url-to-file' - and user defined function. - (spam-report-process-queue): New function. - Process requests from `spam-report-requests-file'. - (spam-report-url-ping-mm-url): Autoload. - [Added missing offline functionality from trunk.] - -2005-04-18 Katsumi Yamaoka - - * qp.el (quoted-printable-encode-region): Save excursion. - -2005-04-13 Katsumi Yamaoka - - * gnus-art.el (gnus-mime-inline-part): Use mm-string-to-multibyte. - - * lpath.el: Fbind display-time-event-handler; don't fbind - string-to-multibyte. - - * qp.el (quoted-printable-encode-region): Use mm-string-to-multibyte. - -2005-04-13 Miles Bader - - * mm-util.el (mm-string-to-multibyte): Use Gnus trunk definition. - -2005-04-12 Katsumi Yamaoka - - * nnrss.el (nnrss-node-text): Replace CRLFs (which might be - contained in text because xml.el decodes entities) with LFs. - -2005-04-11 Lute Kamstra - - * message.el (message-make-date): Handle byte-compiler warnings - differently. - * nnimap.el (nnimap-date-days-ago): Ditto. - -2005-04-10 Stefan Monnier - - * mm-util.el (mm-string-to-multibyte): New function. - (mm-detect-coding-region): Typo. - -2005-04-11 Katsumi Yamaoka - - * gnus-art.el (gnus-article-read-summary-keys): Fix misplaced parens. - -2005-04-06 Katsumi Yamaoka - - * mm-util.el (mm-coding-system-p): Don't return binary for the nil - argument in XEmacs. - - * nnrss.el (nnrss-compatible-encoding-alist): New variable. - (nnrss-request-group): Decode group name first. - (nnrss-request-article): Make a text/plain article if mml-to-mime - failed. - (nnrss-get-encoding): Return a compatible encoding according to - nnrss-compatible-encoding-alist. - (nnrss-opml-export): Use dolist. - (nnrss-find-el): Use consp instead of listp. - (nnrss-order-hrefs): Use dolist. - -2005-04-06 Arne J,Ax(Brgensen - - * nnrss.el (nnrss-verbose): Remove. - (nnrss-request-group): Use `nnheader-message' instead. - -2005-04-06 Mark Plaksin (tiny change) - - * nnrss.el (nnrss-verbose): New variable. - (nnrss-request-group): Make it say nnrss is requesting a group. - -2005-04-06 Katsumi Yamaoka - - * dgnushack.el: Autoload sgml-mode for XEmacs. - - * gnus-agent.el (gnus-agent-group-path): Decode group name. - (gnus-agent-group-pathname): Ditto. - - * gnus-cache.el (gnus-cache-file-name): Decode group name. - - * gnus-group.el (gnus-group-line-format-alist): Use decoded group - name for only %g and %c. - (gnus-group-insert-group-line): Bind gnus-tmp-decoded-group - instead of gnus-tmp-group to decoded group name. - (gnus-group-make-group): Decode group name. - (gnus-group-delete-group): Ditto. - (gnus-group-make-rss-group): Exclude `/'s from group names; - register the group data after opening the nnrss group; unify - non-ASCII group names; encode group name. - (gnus-group-catchup-current): Decode group name. - (gnus-group-expire-articles-1): Ditto. - (gnus-group-set-current-level): Ditto. - (gnus-group-kill-group): Ditto. - - * gnus-spec.el (gnus-update-format-specifications): Flush the - group format spec cache if it doesn't support decoded group names. - - * lpath.el: Fbind detect-coding-string. - - * mm-url.el (mm-url-predefined-programs): Add --silent arg to curl. - - * nnrss.el: Require rfc2047 and mml. - (nnrss-file-coding-system): New variable. - (nnrss-format-string): Redefine it as an inline function. - (nnrss-decode-group-name): New function. - (nnrss-string-as-multibyte): Remove. - (nnrss-retrieve-headers): Decode group name; don't use - nnrss-format-string. - (nnrss-request-group): Decode group name. - (nnrss-request-article): Decode group name; allow a Message-ID as - well as an article number; don't use nnrss-format-string; encode a - Message-ID string which may contain non-ASCII characters; use - mml-to-mime to compose a MIME article; use search-forward instead - of re-search-forward. - (nnrss-request-expire-articles): Decode group name. - (nnrss-request-delete-group): Delete entries in nnrss-group-alist - as well; decode group name. - (nnrss-get-encoding): Fix regexp. - (nnrss-fetch): Clarify error message. - (nnrss-read-server-data): Use insert-file-contents instead of load; - bind file-name-coding-system; use multibyte buffer. - (nnrss-save-server-data): Insert newline; bind - coding-system-for-write to the value of nnrss-file-coding-system; - bind file-name-coding-system; add coding cookie. - (nnrss-read-group-data): Use insert-file-contents instead of load; - bind file-name-coding-system; use multibyte buffer. - (nnrss-save-group-data): Bind coding-system-for-write to the - value of nnrss-file-coding-system; bind file-name-coding-system. - (nnrss-decode-entities-string): Rename from n-d-e-unibyte-string; - make it work with non-ASCII text. - (nnrss-opml-export): Use mm-set-buffer-file-coding-system instead - of set-buffer-file-coding-system. - (nnrss-find-el): Check carefully whether there's a list of string - which old xml.el may return rather than a string; make it work - with old xml.el as well. - - * time-date.el (time-to-seconds): Don't use the #xhhhh syntax - which Emacs 20 doesn't support. - (seconds-to-time, days-to-time, time-subtract, time-add): Ditto. - -2005-04-06 Tsuyoshi AKIHO - - * gnus-sum.el (gnus-summary-walk-group-buffer): Decode group name. - - * nnrss.el (nnrss-get-encoding): New function. - (nnrss-fetch): Use unibyte buffer initially; bind - coding-system-for-read while performing mm-url-insert; remove ^Ms; - decode contents according to the encoding attribute. - (nnrss-save-group-data): Add coding cookie. - (nnrss-mime-encode-string): New function. - (nnrss-check-group): Use it to encode subject and author. - -2005-04-06 Maciek Pasternacki (tiny change) - - * nnrss.el (nnrss-fetch): Signal an error if w3-parse-buffer also - failed. - -2005-04-06 Joakim Verona (tiny change) - - * nnrss.el (nnrss-read-group-data): Fix off-by-one error. - -2005-04-06 Jesper Harder - - * mm-util.el (mm-subst-char-in-string): Support inplace. - - * nnrss.el: Pedantic docstring and whitespace fixes (courtesy of - checkdoc.el). - (nnrss-request-article): Cleanup. - (nnrss-request-delete-group): Use nnrss-make-filename. - (nnrss-read-server-data): Use nnrss-make-filename; use load. - (nnrss-save-server-data): Use nnrss-make-filename; use gnus-prin1. - (nnrss-read-group-data): hash on description if link is missing; - use nnrss-make-filename; use load. - (nnrss-save-group-data): Use nnrss-make-filename; use gnus-prin1. - (nnrss-make-filename): New function. - (nnrss-close): New function. - (nnrss-check-group): Hash on description if link is missing. - (nnrss-get-namespace-prefix): Use string= to compare strings! - Reported by David D. Smith . - (nnrss-opml-export): Turn on sgml-mode. - -2005-04-06 Mark A. Hershberger - - * nnrss.el (nnrss-opml-import, nnrss-opml-export): New functions. - -2005-04-04 Reiner Steib - - * message.el (message-make-date): Add defvars in order to silence - the byte compiler inside the defun. - - * nnimap.el (nnimap-date-days-ago): Ditto. - - * gnus-demon.el (parse-time-string): Add autoload. - - * gnus-delay.el (parse-time-string): Add autoload. - - * gnus-art.el (parse-time-string): Add autoload. - - * nnultimate.el (parse-time): Require for `parse-time-string'. - -2005-04-03 Katsumi Yamaoka - - * gnus-sum.el (gnus-summary-make-menu-bar): Avoid the - "Unrecognized menu descriptor" error in XEmacs. - -2005-03-25 Katsumi Yamaoka - - * message.el (message-resend): Bind rfc2047-encode-encoded-words. - - * mm-util.el (mm-replace-in-string): New function. - (mm-xemacs-find-mime-charset-1): Ignore errors while loading - latin-unity, which cannot be used with XEmacs 21.1. - - * rfc2047.el (rfc2047-encode-function-alist): Rename from - rfc2047-encoding-function-alist in order to avoid conflicting with - the old version. - (rfc2047-encode-message-header): Remove useless goto-char. - (rfc2047-encodable-p): Don't move point. - (rfc2047-syntax-table): Treat `(' and `)' as is. - (rfc2047-encode-region): Concatenate words containing non-ASCII - characters in structured fields; don't encode space-delimited - ASCII words even in unstructured fields; don't break words at - char-category boundaries; encode encoded words in structured - fields; treat text within parentheses as special; show the - original text when error has occurred; move point to the end of - the region after encoding, suggested by IRIE Tetsuya - ; treat backslash-quoted characters as - non-special; check carefully whether to encode special characters; - fix some kind of misconfigured headers; signal a real error if - debug-on-quit or debug-on-error is non-nil; don't infloop, - suggested by Hiroshi Fujishima ; assume - the close parenthesis may be included in the encoded word; encode - bogus delimiters. - (rfc2047-encode-string): Use mm-with-multibyte-buffer. - (rfc2047-encode-max-chars): New variable. - (rfc2047-encode-1): New function. - (rfc2047-encode): Use it; encode text so that it occupies the - maximum width within 76-column; work correctly on Q encoding for - iso-2022-* charsets; fold the line before encoding; don't append a - space if the encoded word includes close parenthesis. - (rfc2047-fold-region): Use existing whitespace for LWSP; make it - sure not to break a line just after the header name. - (rfc2047-b-encode-region): Remove. - (rfc2047-b-encode-string): New function. - (rfc2047-q-encode-region): Remove. - (rfc2047-q-encode-string): New function. - (rfc2047-encode-parameter): New function. - (rfc2047-encoded-word-regexp): Don't use shy group. - (rfc2047-decode-region): Follow rfc2047-encoded-word-regexp change. - (rfc2047-parse-and-decode): Ditto. - (rfc2047-decode): Treat the ascii coding-system as raw-text by default. - -2005-03-25 Lars Magne Ingebrigtsen - - * rfc2047.el (rfc2047-encode-encoded-words): New variable. - (rfc2047-field-value): Strip props. - (rfc2047-encode-message-header): Disable header folding -- not - all headers can be folded, and this should be done by the message - composition mode. Probably. I think. - (rfc2047-encodable-p): Say that =? needs encoding. - (rfc2047-encode-region): Encode =? strings. - -2005-03-25 Jesper Harder - - * rfc2047.el (rfc2047-encoded-word-regexp): Support RFC 2231 - language tags; remove unnecessary '+'. Reported by Stefan Wiens - . - (rfc2047-decode-string): Don't cons a string unnecessarily. - (rfc2047-parse-and-decode, rfc2047-decode): Use a character for - the encoding to avoid consing a string. - (rfc2047-decode): Use mm-subst-char-in-string instead of - mm-replace-chars-in-string. - -2005-03-25 TSUCHIYA Masatoshi - - * rfc2047.el (rfc2047-encode): Use uppercase letters to specify - encodings of MIME-encoded words, in order to improve - interoperability with several broken MUAs. - -2005-03-21 Reiner Steib - - * gnus-srvr.el (gnus-browse-select-group): Add NUMBER argument and - pass it to `gnus-browse-read-group'. - (gnus-browse-read-group): Add NUMBER argument and pass it to - `gnus-group-read-ephemeral-group'. - - * gnus-group.el (gnus-group-read-ephemeral-group): Add NUMBER - argument and pass it to `gnus-group-read-group'. - -2005-03-19 Aidan Kehoe - - * mm-util.el (mm-xemacs-find-mime-charset): Only call - mm-xemacs-find-mime-charset-1 if we have the mule feature - available at runtime. - -2005-03-25 Werner Lemberg - - * nnmaildir.el: Replace `illegal' with `invalid'. - -2005-03-23 Lute Kamstra - - * time-date.el: Add comment on time value formats. - Don't require parse-time. - (with-decoded-time-value): New macro. - (encode-time-value): New function. - (time-to-seconds, time-less-p, time-subtract, time-add): Use them. - (days-to-time): Return a valid time value when arg is huge. - (time-since): Use time-subtract. - (time-to-number-of-days): Use time-to-seconds. - -2005-03-22 Stefan Monnier - - * gnus-start.el (gnus-display-time-event-handler): - Check display-time-timer at runtime rather than only at load time - in case display-time-mode is turned off in the mean time. - -2005-03-16 Reiner Steib - - * nnimap.el (nnimap-open-connection): Print which authinfo file is - used. - - * nneething.el (nneething-map-file-directory): Derive from - `gnus-directory'. - - * gnus-art.el (gnus-header-button-alist): Use `gnus-msg-mail' for - the To/Cc button. - -2005-03-15 Reiner Steib - - * nnmaildir.el (nnmaildir-request-accept-article): - Use `nnheader-cancel-timer' for compatibility with current XEmacs. - -2005-03-13 Andrey Slusar (tiny change) - - * gnus.el: Don't try and mark `gnus-agent-save-groups' as an - autoloaded function. - -2005-03-13 Steve Youngs - - * mm-url.el: Require timer-funcs at compile time when in XEmacs - for `with-timeout'. - - * mail-source.el: Require timer-funcs at compile time when in - XEmacs for `run-with-idle-timer'. - - * gnus-async.el: Ditto. - - * dgnushack.el: No need to ignore `run-with-idle-timer', XEmacs - has this function now. - -2005-03-16 Lute Kamstra - - * message.el (message-make-date): Require parse-time. - -2005-03-10 Stefan Monnier - - * nnimap.el (nnimap-retrieve-headers-from-server): Fix last change. - -2005-03-10 Arne J,Ax(Brgensen (tiny change) - - * nnimap.el (nnimap-retrieve-headers-from-server): Fix off-by-one flaw. - -2005-03-08 Bjorn Solberg (tiny change) - - * nnimap.el (nnimap-retrieve-headers-from-server): Sort NOV - buffer (since IMAP server might return FETCH response out of - order, and the nntp buffer must be sorted). - -2005-03-04 Reiner Steib - - * message.el: Don't autoload former message-utils variables. - (message-strip-subject-trailing-was): Change doc string. - - * nnweb.el: Fixes for `gnus-group-make-web-group'. - (nnweb-type-definition): Don't add "hl=en" in `address'. Add `base'. - (nnweb-google-search): Add "hl=en" here. - (nnweb-google-parse-1, nnweb-google-create-mapping): - Don't hardcode URL. - -2005-03-03 Reiner Steib - - * message.el (message-get-reply-headers, message-followup): - Mention related variables `message-use-followup-to' and - `message-use-mail-followup-to', in the information buffer. - - * nnweb.el (nnweb-type-definition): Use groups.google.de instead - of broken groups(-beta).google.com. - -2005-03-01 Stefan Monnier - - * gnus-sum.el (gnus-summary-exit): Undo last change and fix it in - a more conservative way. - -2005-02-27 Arne J,Ax(Brgensen - - * mm-decode.el (mm-dissect-buffer): Pass the from field on to - `mm-dissect-multipart' and receive the from field as an (optional) - argument from `mm-dissect-multipart'. - (mm-dissect-multipart): Receive the from field as an argument and - pass it on when we call `mm-dissect-buffer' on MIME parts. - Fixes verification/decryption of signed/encrypted MIME parts. - -2005-02-26 Stefan Monnier - - * gnus-sum.el (gnus-summary-exit): Move point after displaying the - buffer, so it moves the window's cursor. - -2005-02-24 Reiner Steib - - * nnheader.el (nnheader-find-file-noselect): Add doc string. - - * nnfolder.el (nnfolder-read-folder): Use RAWFILE for - `nnheader-find-file-noselect' to avoid `large-file-warning-threshold'. - - * gnus-sum.el (gnus-summary-caesar-message): - Apply `gnus-treat-article' after rotation. - - * gnus-group.el (gnus-group-clear-data): Mention process/prefix in - doc string. - -2005-02-22 Arne J,Ax(Brgensen - - * smime.el (smime-sign-buffer): Signal an error if - `smime-sign-region' fails. - (smime-encrypt-buffer): Signal an error if `smime-encrypt-region' - fails. - -2005-02-21 Reiner Steib - - * gnus-art.el (gnus-parse-news-url, gnus-button-handle-news): - Handle news URL with given port correctly. - -2005-02-19 Katsumi Yamaoka - - * gnus-msg.el (gnus-copy-article-buffer): Quote decoded words - containing special characters. - - * gnus-sum.el (gnus-summary-edit-article): Ditto. - - * mml.el (mime-to-mml): Ditto. - - * rfc2047.el (rfc2047-quote-decoded-words-containing-tspecials): - New variable. - (rfc2047-decode-region): Quote decoded words containing special - characters when rfc2047-quote-decoded-words-containing-tspecials - is non-nil. - -2005-02-16 Teodor Zlatanov - - * gnus-registry.el (gnus-registry-delete-group): Minor bug fix. - - * gnus.el (gnus-install-group-spam-parameters): Doc fix. - -2005-02-15 Simon Josefsson - - * nnimap.el (nnimap-debug): Doc fix. - - * imap.el (imap-debug): Doc fix. - -2005-02-14 Reiner Steib - - * gnus-group.el (gnus-group-make-doc-group): Mention prefix - argument in doc string. Make query for type more clear. - -2005-02-13 Reiner Steib - - * gnus.el (gnus-group-startup-message): Search for gnus images in - etc/images/gnus. - * mm-util.el (mm-image-load-path): Likewise. - * smiley.el (smiley-data-directory): Search for smilies in - etc/images/smilies. - -2005-02-09 Kim F. Storm - - Change Emacs release version from 21.4 to 22.1 throughout. - Change Emacs development version from 21.3.50 to 22.0.50. - -2005-02-08 Simon Josefsson - - * imap.el (imap-log): Doc fix. - -2005-02-03 Katsumi Yamaoka - - * gnus-art.el (gnus-mime-inline-part): Show the raw contents if a - prefix arg is neither nil nor a number, as info specifies. - -2005-01-30 Stefan Monnier - - * gnus-art.el (gnus-article-mode): Turn off the "\ " non-break space. - -2005-01-28 Stefan Monnier - - * message.el (message-beginning-of-line): Change the behavior when - invoked between BOL and : so that it first moves backward. - -2005-01-28 Katsumi Yamaoka - - * gnus-art.el (gnus-article-setup-buffer): Kill and re-create the - article buffer when editing of the article is discarded. - (gnus-article-prepare): Revert. - -2005-01-28 Katsumi Yamaoka - - * gnus-art.el (gnus-article-prepare): - Remove message-strip-forbidden-properties from the local hook. - -2005-01-24 Katsumi Yamaoka - - * mml.el (mml-generate-mime-1): Convert string into unibyte when - inserting " *mml*" buffer's contents into a unibyte temp buffer. - -2005-01-20 Katsumi Yamaoka - - * mm-decode.el (mm-insert-part): Switch the multibyteness of data - which will be inserted according to the multibyteness of a buffer - rather than the type of contents. Suggested by ARISAWA Akihiro - . - -2005-01-05 Reiner Steib - - * spam.el (spam-face): New face. Don't use `gnus-splash-face' - which is unreadable in some setups. - -2004-12-27 Simon Josefsson - - * mm-bodies.el (mm-body-encoding): Don't permit 7-bit to be used when - mm-use-ultra-safe-encoding is enabled (e.g., for PGP/MIME) and we have - trailing white space. Reported by Werner Koch . - -2004-12-17 Kim F. Storm - - * gnus-group.el (gnus-group-mode-map): Map follow-link to mouse-face. - - * gnus-sum.el (gnus-summary-mode-map): Likewise. - -2004-12-22 Katsumi Yamaoka - - * gnus-spec.el (gnus-spec-tab): Make a Lisp form which works - correctly even if there are wide characters. - -2004-12-21 Katsumi Yamaoka - - * rfc2231.el (rfc2231-parse-string): Decode encoded value after - concatenating segments rather than before concatenating them. - Suggested by ARISAWA Akihiro . - -2004-12-17 Katsumi Yamaoka - - * mm-util.el (mm-xemacs-find-mime-charset): New macro. - -2004-12-17 Aidan Kehoe - - * mm-util.el (mm-xemacs-find-mime-charset-1): New function used to - unify Latin characters in XEmacs. - (mm-find-mime-charset-region): Use it. - -2004-12-17 Katsumi Yamaoka - - * gnus-util.el (gnus-delete-directory): New function. - - * gnus-agent.el (gnus-agent-delete-group): Use it. - - * gnus-cache.el (gnus-cache-delete-group): Use it. - -2004-12-08 Stefan Monnier - - * gnus-art.el (gnus-narrow-to-page): Don't hardcode point-min. - -2004-12-13 Katsumi Yamaoka - - * gnus-group.el (gnus-group-make-rss-group): - Use gnus-group-make-group instead of gnus-group-unsubscribe-group. - - * gnus-start.el (gnus-setup-news): Honor user's setting to - gnus-message-archive-method. Suggested by Lute Kamstra - . - -2004-12-02 Katsumi Yamaoka - - * message.el (message-forward-make-body-mml): Remove headers - according to message-forward-ignored-headers if a message is decoded. - -2004-12-02 Romain Francoise - - * message.el (message-forward-make-body-plain): Always remove - headers according to message-forward-ignored-headers. - -2004-11-26 Katsumi Yamaoka - - * lpath.el: Remove bbdb-create-internal, bbdb-records, - spam-BBDB-register-routine and spam-enter-ham-BBDB. - - * nnrss.el (nnrss-string-as-multibyte): Redefine it as a macro in - order to silence the byte compiler. - - * pop3.el (pop3-md5): Define it before being used. - - * spam.el: Fix the way to silence the byte compiler, which - complained about bbdb-buffer, bbdb-create-internal, - bbdb-search-simple, mail-check-payment, spam-BBDB-register-routine, - spam-enter-ham-BBDB, spam-stat-buffer-change-to-non-spam, - spam-stat-buffer-change-to-spam, spam-stat-buffer-is-non-spam, - spam-stat-buffer-is-spam, spam-stat-load, - spam-stat-register-ham-routine, spam-stat-register-spam-routine, - spam-stat-save and spam-stat-split-fancy. - -2004-11-26 Katsumi Yamaoka - - * canlock.el (canlock-password): Remove `:size 0' or `:size 1' - which may confuse users. - (canlock-password-for-verify): Ditto. - - * deuglify.el (gnus-outlook-deuglify-unwrap-stop-chars): Ditto. - - * gnus-art.el (gnus-emphasis-alist): Ditto. - - * gnus-registry.el (gnus-registry-max-entries): Ditto. - - * gnus-score.el (gnus-adaptive-word-length-limit): Ditto. - - * gnus-start.el (gnus-save-killed-list): Ditto. - - * gnus-sum.el (gnus-thread-hide-subtree): Ditto. - (gnus-sum-thread-tree-root): Ditto. - (gnus-sum-thread-tree-false-root): Ditto. - (gnus-sum-thread-tree-single-indent): Ditto. - - * message.el (message-courtesy-message): Ditto. - (message-archive-note): Ditto. - (message-subscribed-address-file): Ditto. - (message-user-fqdn): Ditto. - - * spam-report.el (spam-report-gmane-regex): Ditto. - - * spam.el (spam-blackhole-good-server-regex): Ditto. - -2004-11-25 Reiner Steib - - * message.el (message-forbidden-properties): Fix typo in doc string. - -2004-11-25 Lars Magne Ingebrigtsen - - * message.el (message-strip-forbidden-properties): - Bind buffer-read-only (etc) to nil. - -2004-11-25 Reiner Steib - - * gnus-util.el (gnus-replace-in-string): Add doc string. - - * nnmail.el (nnmail-split-header-length-limit): Increase to 2048 - to avoid problems when splitting mails with many recipients. - -2004-11-23 Katsumi Yamaoka - - * rfc2047.el (rfc2047-header-encoding-alist): Add In-Reply-To to - address-mime. Suggested by ARISAWA Akihiro . - -2004-11-22 Marek Martin (tiny change) - - * nnfolder.el (nnfolder-request-create-group): Save current buffer. - -2004-11-22 Stefan Monnier - - * gnus-sum.el (gnus-summary-exit): Remove redundant and harmful - pop-to-buffer, covered by the subsequent gnus-configure-windows. - -2004-11-14 Luc Teirlinck - - * nnfolder.el (nnfolder-save-marks): Add missing format field in - call to `error'. - * nnml.el (nnml-save-marks): Ditto. - -2004-11-14 Reiner Steib - - * gnus.el (gnus-version-number): Bump version to 5.10.7. - - * gnus-start.el (gnus-convert-old-newsrc): - Assign legacy-gnus-agent to 5.10.7. - -2004-11-10 Katsumi Yamaoka - - * gnus-art.el (gnus-emphasis-alist): Don't hide asterisks by - default; improve customization type. - (gnus-emphasis-custom-with-format): New macro. - (gnus-emphasis-custom-value-to-external): New function. - (gnus-emphasis-custom-value-to-internal): New function. - -2004-11-07 Katsumi Yamaoka - - * gnus-msg.el (gnus-configure-posting-styles): Don't cause the - "Args out of range" error. Reported by Arnaud Giersch - . - -2004-11-04 Richard M. Stallman - - * spam.el (spam group): Add :version. - - * pgg-def.el (pgg group): Add :version. - -2004-11-04 Katsumi Yamaoka - - * gnus-art.el (gnus-article-edit-article): Don't associate the - article buffer with a draft file. This is a temporary measure - against the 2004-08-22 change to gnus-article-edit-mode. - -2004-11-02 Ilya N. Golubev . - - * mm-util.el (mm-mime-mule-charset-alist): Add the windows-1251 - entry. - -2004-11-02 Katsumi Yamaoka - - * html2text.el (html2text-get-attr): Remove unused argument `tag'. - (html2text-format-tags): Remove unused variable `attr'. - - * mm-util.el (mm-enrich-utf-8-by-mule-ucs): Fix cleaning of - after-load-alist. - - * mm-util.el (mm-enrich-utf-8-by-mule-ucs): New function run when - Mule-UCS is loaded under XEmacs. - (mm-mime-mule-charset-alist): Avoid duplicated entries. - - * mm-util.el (mm-coding-system-p): Return a coding-system. - (mm-mime-mule-charset-alist): Use shift_jis instead of - iso-2022-jp-2 for the katakana-jisx0201 mule charset; add new - entries for the mime charsets iso-2022-jp-3 and shift_jis. - (mm-coding-system-priorities): Use shift_jis and iso-8859-1 - instead of japanese-shift-jis and iso-latin-1 respectively in - order to share the default value with both Emacs and XEmacs-mule. - (mm-mule-charset-to-mime-charset): - Make mm-coding-system-priorities effective. - (mm-sort-coding-systems-predicate): Canonicalize coding-systems - while predicating of candidates upon the priorities. - -2004-11-01 Reiner Steib - - * gnus-msg.el (gnus-summary-resend-default-address): Add :version. - - * tls.el (tls-process-connection-type, tls-success) - (tls-certtool-program): Add :version. - - * starttls.el (starttls-gnutls-program, starttls-use-gnutls) - (starttls-extra-arguments, starttls-process-connection-type) - (starttls-connect, starttls-failure, starttls-success): - - * spam-stat.el (spam-stat): Add :version. - - * sieve.el (sieve): Add :version. - - * sha1.el (sha1): Add :version. - (sha1-use-external): Remove redundant version. - - * nnmail.el (nnmail-split-fancy-with-parent-ignore-groups) - (nnmail-cache-ignore-groups, nnmail-spool-hook) - (nnmail-split-fancy-match-partial-words) - (nnmail-split-lowercase-expanded): Add :version. - - * nndiary.el (nndiary): Add :version. - - * mml2015.el (mml2015-unabbrev-trust-alist): Add :version. - - * mml-sec.el (mml-default-sign-method) - (mml-default-encrypt-method, mml-signencrypt-style-alist): - Add :version. - - * mm-uu.el (mm-uu-diff-groups-regexp): Add :version. - - * mm-url.el (mm-url-use-external, mm-url-program) - (mm-url-arguments): Add :version. - - * mm-decode.el (mm-inline-text-html-with-w3m-keymap) - (mm-attachment-file-modes, mm-decrypt-option) - (mm-w3m-safe-url-regexp): Add :version. - - * message.el (message-cite-prefix-regexp) - (message-sendmail-envelope-from, message-minibuffer-local-map) - (message-user-fqdn, message-completion-alist): Add :version. - - * gnus-win.el (gnus-configure-windows-hook) - (gnus-use-frames-on-any-display): Add :version. - - * gnus-art.el (gnus-article-address-banner-alist) - (gnus-treat-unsplit-urls, gnus-treat-unfold-headers) - (gnus-treat-from-picon, gnus-treat-mail-picon) - (gnus-treat-x-pgp-sig): Add :version. - - * gnus-sum.el (gnus-spam-mark, gnus-recent-mark) - (gnus-undownloaded-mark, gnus-summary-article-move-hook) - (gnus-summary-article-delete-hook) - (gnus-summary-display-while-building): Add :version. - - * gnus-start.el (gnus-subscribe-newsgroup-hooks) - (gnus-get-top-new-news-hook):Add :version. - - * gnus-srvr.el (gnus-server-agent-face, gnus-server-opened-face) - (gnus-server-closed-face, gnus-server-denied-face): Add :version. - - * gnus-registry.el (gnus-registry): Add :version. - - * gnus-spec.el (gnus-use-correct-string-widths) - (gnus-make-format-preserve-properties): Add :version. - - * gnus.el (gnus-group-charter-alist) - (gnus-group-fetch-control-use-browse-url) - (gnus-install-group-spam-parameters): Add :version. - - * gnus-diary.el (gnus-diary): Add :version. - - * gnus-delay.el (gnus-delay): Add :version. - - * gnus-cite.el (gnus-cite-unsightly-citation-regexp) - (gnus-cite-ignore-quoted-from, gnus-cite-attribution-face) - (gnus-cite-blank-line-after-header, gnus-article-boring-faces): - Add :version. - - * gnus-agent.el (gnus-agent-max-fetch-size) - (gnus-agent-enable-expiration, gnus-agent-queue-mail) - (gnus-agent-prompt-send-queue): Add :version. - - * deuglify.el (gnus-outlook-deuglify): Add :version. - - * html2text.el: Beautify code. Improve doc strings. Some - checkdoc cleanup. - (html2text-get-attr, html2text-fix-paragraph): Simplify code. - -2004-11-01 Alfred M. Szmidt (tiny change) - - * html2text.el (html2text-format-tag-list): Add "strong" and "em". - -2004-10-29 Katsumi Yamaoka - - * gnus-msg.el (gnus-configure-posting-styles): Work with empty - signature file. Suggested by Manoj Srivastava - . - - * mm-util.el (mm-coding-system-priorities): Prefer iso-8859-1 than - iso-2022-jp even in the Japanese language environment. - Suggested by Jason Rumney . - -2004-10-28 Katsumi Yamaoka - - * gnus-sum.el (gnus-update-summary-mark-positions): Allow users to - use the same characters as the dummy marks; make it free from - getting affected by the language environment. - (gnus-summary-read-group-1): Update mark positions only when the - format spec is updated. - - * gnus-spec.el (gnus-update-format-specifications): Return a list - of updated types. - -2004-10-26 Katsumi Yamaoka - - * nnspool.el (nnspool-spool-directory): Use news-path if the - news-directory variable is not bound. - - * gnus-group.el (gnus-group-line-format-alist): Convert the value - of gnus-tmp-news-method into string if it may be passed to - gnus-correct-length which takes only a string argument. - -2004-10-25 Reiner Steib - - * html2text.el (html2text-buffer-head): Remove. Use `goto-char' - instead. - -2004-10-24 Kevin Greiner - - * gnus-start.el (gnus-convert-old-newsrc): Fix numeric - comparison on string. - -2004-10-21 Katsumi Yamaoka - - * mm-view.el (mm-display-inline-fontify): Inhibit font-lock when - running the major-mode function. - -2004-10-21 Kevin Greiner - - * gnus-start.el (gnus-convert-old-newsrc): Two of the converters - have been backported to 'Gnus v5.11' from 'No Gnus v0.2'. Added a - boolean check to not apply converters that apply to future - versions of gnus. - -2004-10-19 Katsumi Yamaoka - - * gnus-sum.el (gnus-update-summary-mark-positions): Search for - dummy marks in the right way. - -2004-10-18 Kevin Greiner - - * nnagent.el (nnagent-request-type): Bind gnus-agent to nil to - avoid infinite recursion via gnus-get-function. - -2004-10-18 Kevin Greiner - - * gnus-agent.el (gnus-agent-synchronize-group-flags): - When necessary, pass full group name to gnus-request-set-marks. - (gnus-agent-synchronize-group-flags): Add support for sync'ing - tick marks. - (gnus-agent-synchronize-flags-server): Be silent when writing file. - -2004-10-18 Kevin Greiner - - * gnus-agent.el (gnus-agent-synchronize-group-flags): - Replace gnus-request-update-info with explicit code to sync the - in-memory info read flags with the marks being sync'd to the backend. - -2004-10-18 Kevin Greiner - - * gnus-agent.el (gnus-agent-possibly-synchronize-flags): Ignore servers - that are offline. Avoids having gnus-agent-toggle-plugged first ask if - you want to open a server and then, even when you responded with no, - asking if you want to synchronize the server's flags. - (gnus-agent-synchronize-flags-server): Rewrite read loop to handle - multi-line expressions. - (gnus-agent-synchronize-group-flags): New internal function. - Updates marks in memory (in the info structure) AND in the backend. - (gnus-agent-check-overview-buffer): Fix range of - deletion to remove entire duplicate line. Fixes merged article - number bug. - - * gnus-util.el (gnus-remassoc): Fix typo in documentation. - - * nnagent.el (nnagent-request-set-mark): - Use gnus-agent-synchronize-group-flags, not backend's request-set-mark - method, to ensure that synchronization updates marks in the - backend and in the info (in memory) structure. - -2004-10-18 Kevin Greiner - - * gnus-agent.el (gnus-agent-synchronize-flags-server): Do nothing - unless plugged. Disable the agent so that an open failure causes - an error. - -2004-10-18 Reiner Steib - - * gnus-agent.el (gnus-agent-fetched-hook): Add :version. - (gnus-agent-go-online): Change :version. - (gnus-agent-expire-unagentized-dirs) - (gnus-agent-auto-agentize-methods): Add :version. - -2004-10-18 Kevin Greiner - - * legacy-gnus-agent.el - (gnus-agent-convert-to-compressed-agentview-prompt): - New function. Used internally to only display 'gnus converting - files' message when actually necessary. - - * gnus-sum.el: Remove (require 'gnus-agent) as required - methods now autoloaded. - - * gnus-int.el (gnus-request-move-article): - Use gnus-agent-unfetch-articles in place of gnus-agent-expire to - improve performance. - -2004-10-18 Kevin Greiner - - * gnus-agent.el (gnus-agent-cat-groups): Rewrite avoiding defsetf - to avoid run-time CL dependencies. - (gnus-agent-unfetch-articles): New function. - (gnus-agent-fetch-headers): Use gnus-agent-braid-nov to validate - article numbers even when local .overview file is missing. - (gnus-agent-read-article-number): New function. Only accepts - 27-bit article numbers. - (gnus-agent-copy-nov-line, gnus-agent-uncached-articles): - Use gnus-agent-read-article-number. - (gnus-agent-braid-nov): Rewrote to validate article numbers coming - from backend while recognizing that article numbers in .overview - must be valid. - - * gnus-start.el (gnus-convert-old-newsrc): Change message text as - some users confused by references to .newsrc when they only have a - .newsrc.eld file. - (gnus-convert-mark-converter-prompt) - (gnus-convert-converter-needs-prompt): Fix use of property list. - -2004-10-18 Katsumi Yamaoka - - * gnus-agent.el (gnus-agent-restore-gcc): Use ^ and regexp-quote. - -2004-10-18 Lars Magne Ingebrigtsen - - * gnus-start.el (gnus-get-unread-articles-in-group): Don't do - stuff for non-living groups. - -2004-10-18 Lars Magne Ingebrigtsen - - * gnus-agent.el (gnus-agent-synchronize-flags): Default to nil. - (gnus-agent-regenerate-group): Using nil messages aren't valid. - -2004-10-18 Lars Magne Ingebrigtsen - - * gnus-agent.el (gnus-agent-read-agentview): - Inline gnus-uncompress-range. - -2004-10-18 Kevin Greiner - - * legacy-gnus-agent.el - (gnus-agent-convert-to-compressed-agentview): Fix typos with - help from Florian Weimer - - * gnus-agent.el (gnus-agentize): - gnus-agent-send-mail-real-function no longer set to current value - of message-send-mail-function but rather a lambda that calls - message-send-mail-function. The change makes the agent real-time - responsive to user changes to message-send-mail-function. - -2004-10-18 Reiner Steib - - * gnus-start.el (gnus-get-unread-articles): Fix last commit. - -2004-10-18 Kevin Greiner - - * gnus-cache.el (gnus-cache-rename-group): New function. - (gnus-cache-delete-group): New function. - - * gnus-agent.el (gnus-agent-rename-group): New function. - (gnus-agent-delete-group): New function. - (gnus-agent-save-group-info): Use gnus-command-method when - `method' parameter is nil. Don't write nil entries into the - active file. - (gnus-agent-get-group-info): New function. - (gnus-agent-get-local): Add optional parameters to avoid calling - gnus-group-real-name and gnus-find-method-for-group. - (gnus-agent-set-local): Delete stored entry if either min, or max, - are nil. - (gnus-agent-fetch-session): Reword error/quit messages. - On quit, use gnus-agent-regenerate-group to record existance of any - articles fetched to disk before the quit occurred. - - * gnus-int.el (gnus-request-delete-group): - Use gnus-cache-delete-group and gnus-agent-delete-group to keep the - local disk in sync with the server. - (gnus-request-rename-group): - Use gnus-cache-rename-group and gnus-agent-rename-group to keep the - local disk in sync with the server. - - * gnus-start.el (gnus-get-unread-articles): - Cosmetic simplification to logic. - - * gnus-group.el (gnus-group-delete-group): No longer update - gnus-cache-active-altered as gnus-request-delete-group now keeps - the cache in sync. - (gnus-group-list-active): Let the agent store a server's active - list if currently plugged. - - * gnus-util.el (gnus-rename-file): New function. - -2004-10-18 Katsumi Yamaoka - - * gnus-agent.el (gnus-agent-regenerate-group): Activate the group - when the group's active is not available. - -2004-10-18 Katsumi Yamaoka - - * gnus-agent.el (gnus-agent-read-agentview): Add a missing arg to - error. - -2004-10-18 Kevin Greiner - - * gnus-start.el (gnus-convert-old-newsrc): Only write the conversion - message to newsrc-dribble when an actual conversion is performed. - -2004-10-18 Kevin Greiner - - * gnus-agent.el (gnus-agent-read-local): - Bind nnheader-file-coding-system to gnus-agent-file-coding-system to - avoid the implicit assumption that they will always be equal. - (gnus-agent-save-local): Bind buffer-file-coding-system, not - coding-system-for-write, as the with-temp-file macro first prints - to a buffer then saves the buffer. - -2004-10-18 Kevin Greiner - - * legacy-gnus-agent.el (): New. Provides converters that are only - loaded when gnus-convert-old-newsrc needs to call them. - - * gnus-agent.el (gnus-agent-read-agentview): Remove support for - old file versions. - (gnus-group-prepare-hook): Remove function that converted list - form of gnus-agent-expire-days to group properties. - - * gnus-start.el (gnus-convert-old-newsrc): Register new - converters to handle old agent file formats. Added logic for a - "backup before upgrading warning". - (gnus-convert-mark-converter-prompt): Developers can mark - functions as needing (default), or not needing, - gnus-convert-old-newsrc's "backup before upgrading warning". - (gnus-convert-converter-needs-prompt): Tests whether the user - should be protected from potentially irreversable changes by the - function. - -2004-10-18 Kevin Greiner - - * gnus-int.el (gnus-request-accept-article): Inform the agent that - articles are being added to a group. - (gnus-request-replace-article): Inform the agent that articles - need to be uncached as the cached contents are no longer valid. - - * gnus-agent.el (gnus-agent-file-header-cache): Remove. - (gnus-agent-possibly-alter-active): Avoid null in numeric comparison. - (gnus-agent-set-local): Refuse to save null in local object table. - (gnus-agent-regenerate-group): The REREAD parameter can now be a - list of articles that will be marked as unread. - -2004-10-18 Kevin Greiner - - * gnus-range.el (gnus-sorted-range-intersection): Now accepts - single-interval range of the form (min . max). Previously the - range had to look like ((min . max)). Likewise, return - (min . max) rather than ((min . max)). - (gnus-range-map): Use gnus-range-normalize to accept - single-interval range. - - * gnus-sum.el (gnus-summary-highlight-line): Articles stored in - the cache, but not the agent, now appear with their usual face. - -2004-10-18 Kevin Greiner - - * gnus-sum.el (gnus-adjust-marks): Now correctly handles a list of - marks consisting of a single range {for example, (3 . 5)} rather - than a list of a single range { ((3 . 5)) }. - -2004-10-18 Kevin Greiner - - * gnus-sum.el (gnus-adjust-marks): Avoid splicing null INTO the - uncompressed list. - -2004-10-18 Kevin Greiner - - * gnus-draft.el (gnus-group-send-queue): Pass the group name - "nndraft:queue" along to gnus-draft-send. - Use gnus-agent-prompt-send-queue. - (gnus-draft-send): Rebind gnus-agent-queue-mail to nil when group - is "nndraft:queue". Suggested by Gaute Strokkenes - - - * gnus-group.el (gnus-group-catchup): Use new - gnus-sequence-of-unread-articles, not - gnus-list-of-unread-articles, to avoid exhausting memory with huge - numbers of articles. Use gnus-range-map to avoid having to - uncompress the unread list. - (gnus-group-archive-directory) - (gnus-group-recent-archive-directory): Fix invalid ange-ftp reference. - - * gnus-range.el (gnus-range-map): Iterate over list or sequence. - (gnus-sorted-range-intersection): Intersection of two ranges - without requiring that they first be uncompressed. - - * gnus-start.el (gnus-activate-group): Unless blocked by the - caller, possibly expand the active range to include both cached - and agentized articles. - (gnus-convert-old-newsrc): Rewrote in anticipation of having - multiple version-dependent converters. - (gnus-groups-to-gnus-format): Replace gnus-agent-save-groups with - gnus-agent-save-active. - (gnus-save-newsrc-file): Save dirty agent range limits. - - * gnus-sum.el (gnus-select-newgroup): Replace inline code with - gnus-agent-possibly-alter-active. - (gnus-adjust-marked-articles): Faster handling of simple lists. - -2004-10-18 David Edmondson - - * mm-view.el (mm-w3m-cid-retrieve-1): Don't use recursive call - excessively. - -2004-10-18 Reiner Steib - - * mml.el (mml-preview): Use `pop-to-buffer'. - - * message.el (message-goto-mail-followup-to): Insert after "To". - (message-carefully-insert-headers): Add comment. - - * gnus-sum.el (gnus-summary-make-menu-bar): Add help texts. - - * gnus-art.el (gnus-button-alist): - Improve `gnus-button-handle-library' entry. - - * gnus-art.el (gnus-button-alist): Fix regexp for manual links. - - * gnus-group.el (gnus-group-get-new-news-this-group): Add doc-string. - - * gnus-start.el (gnus-activate-group): Add doc-string. - - * gnus-art.el (gnus-button-handle-man, gnus-button-alist): Try to - handle manual section. - - * imap.el (imap-store-password): New variable. - (imap-interactive-login): Use it. - Suggested by Mark Plaksin . - - * gnus-art.el (gnus-button-alist, gnus-header-button-alist): - Allow / in mailto URLs. - - * spam.el (spam-directory): Derive from `gnus-directory'. - - * gnus-sum.el (gnus-pick-line-number): Add autoload. - -2004-10-17 Richard M. Stallman - - * gnus-registry.el (gnus-registry-unload-hook): - Set as a variable with add-hook. - - * nnspool.el (nnspool-spool-directory): Use news-directory instead - of news-path. - - * spam-stat.el (spam-stat-unload-hook): Set as a variable w/ add-hook. - - * spam.el: Delete duplicate `provide'. - (spam-unload-hook): Set as a variable with add-hook. - -2004-10-15 Reiner Steib - - * pop3.el (pop3-leave-mail-on-server): Describe possible problems - in the doc string. - - * message.el (message-ignored-news-headers) - (message-ignored-supersedes-headers) - (message-ignored-resent-headers) - (message-forward-ignored-headers): Improve custom type. - -2004-10-15 Simon Josefsson - - * pop3.el (top-level): Don't require nnheader. - (pop3-read-timeout): Add. - (pop3-accept-process-output): Add. - (pop3-read-response, pop3-retr): Use it. - -2004-10-13 Katsumi Yamaoka - - * message.el (message-tokenize-header): Fix 2004-09-06 change - which used point-min in the wrong place. - -2004-10-12 Simon Josefsson - - * tls.el (tls-certtool-program): New variable. - (tls-certificate-information): New function, based on - ssl-certificate-information. - -2004-10-11 Reiner Steib - - * message.el (message-bury): Use `window-dedicated-p'. - -2004-10-10 Reiner Steib - - * gnus-sum.el: Mention that multibyte characters don't work as marks. - - * gnus.el (message-y-or-n-p): Autoload. - - * pop3.el (pop3-maildrop, pop3-mailhost, pop3-port) - (pop3-password-required, pop3-authentication-scheme) - (pop3-leave-mail-on-server): Made customizable. - (pop3): New custom group. - (pop3-retr): Remove `sleep-for' statements. - Suggested by Dave Love . - - * nnheader.el (nnheader-read-timeout): Explain 1.0 timeout for - Windows/DOS. - - * imap.el (imap-parse-flag-list, imap-parse-body-extension) - (imap-parse-body): Fix incorrect use of `assert'. Suggested by - Dave Love . - - * mml.el (mml-minibuffer-read-disposition): Require match. - Suggested by Dave Love . - -2004-10-06 Katsumi Yamaoka - - * gnus-group.el (gnus-update-group-mark-positions): - * gnus-sum.el (gnus-update-summary-mark-positions): - * message.el (message-check-news-body-syntax): - * gnus-msg.el (gnus-debug): Use mm-string-as-multibyte instead - of string-as-multibyte. - - * gnus-sum.el (gnus-summary-insert-subject): Remove redundant setq. - -2004-10-05 Juri Linkov - - * gnus-group.el (gnus-update-group-mark-positions): - * gnus-sum.el (gnus-update-summary-mark-positions): - * message.el (message-check-news-body-syntax): - * gnus-msg.el (gnus-debug): Use `string-as-multibyte' to convert - 8-bit unibyte values to a multibyte string for search functions. - -2004-10-01 Katsumi Yamaoka - - * gnus-sum.el (gnus-summary-toggle-header): Make it work even if - there's no visible header. - -2004-10-01 Simon Josefsson - - * mailcap.el (mailcap-mime-data): Add pdf. Remove non-free - acroread. - -2004-09-29 Jesper Harder - - * gnus.el (gnus-method-to-server): Oops, move it don't delete it. - -2004-09-28 Jesper Harder - - * gnus-picon.el: Require cl. - - * mml-sec.el (mml-signencrypt-style): Don't depend on Gnus. - - * mml-smime.el: Require cl. Autoload message-fetch-field. - - * gnus-fun.el: Require gnus-ems and gnus-util. - - * gnus-diary.el (gnus-diary-header-schedule): caddr -> car (cddr). - - * gnus-art.el (gnus-article-edit-mode): Define before first reference. - - * gnus.el (gnus-method-to-server): Move defsubst before first use. - - * spam.el (spam-check-spamoracle, spam-spamoracle-learn): - Fix format string mismatch. - * nnml.el (nnml-request-set-mark, nnml-save-marks): Do. - * nnfolder.el (nnfolder-request-set-mark, nnfolder-save-marks): Do. - -2004-09-27 Katsumi Yamaoka - - * mm-decode.el (mm-copy-to-buffer): Don't use set-buffer-multibyte. - -2004-09-26 Christian Neukirchen (tiny change) - - * mm-util.el (mm-image-load-path): Handle nil in load-path. - -2004-09-26 Jesper Harder - - * gnus-msg.el (gnus-post-news): Use blank Newsgroups line if - GROUP is a virtual group. - - * mm-util.el (mm-charset-synonym-alist): Remove obsolete entries - for big5 and gb2312. - - * rfc2047.el (rfc2047-pad-base64): Deal with more cases of invalid - padding. - - * mm-bodies.el (mm-7bit-chars): Don't include \r. - - * mml.el (mml-compute-boundary-1): Don't uncompress files. - - * rfc2047.el (rfc2047-qp-or-base64): New function to reduce - dependencies. - (rfc2047-encode): Use it. - - * flow-fill.el: Typo. - - * mml.el (mml-generate-mime-1): Don't use format=flowed with - inline PGP. - - * gnus.el (gnus-getenv-nntpserver): Strip whitespace. - - * gnus-cache.el (gnus-cache-save-buffers): Check if buffer is - alive. Reported by Laurent Martelli . - - * html2text.el (html2text-replace-list): Add & and '. - - * nnheader.el (nnheader-max-head-length): Increase to 8192. - - * message.el (message-clone-locals): Clone sendmail and smtp - variables. - -2004-09-23 Reiner Steib - - * gnus-msg.el (gnus-configure-posting-styles): Narrow to headers - in `header' match. Reported by Svend Tollak Munkejord. - -2004-09-20 Stefan Monnier - - * mm-decode.el (mm-copy-to-buffer): Preserve the data's unibyteness. - -2004-09-20 Reiner Steib - - * uudecode.el (uudecode-use-external): Add :version. - - * smime.el (smime-CA-file, smime-encrypt-cipher) - (smime-dns-server): Add :version. - - * smiley.el (gnus-smiley-file-types): Add :version. - - * sha1.el (sha1-use-external): Add :version. - - * pgg-def.el (pgg-query-keyserver): Add :version. - - * nnmail.el (nnmail-fancy-expiry-targets) - (nnmail-mail-splitting-charset, nnmail-mail-splitting-decodes): - Add :version. - - * nnimap.el (nnimap-split-download-body, nnimap-dont-close) - (nnimap-retrieve-groups-asynchronous): Add :version. - (nnimap-close-asynchronous): Add :version. Fixed typo in doc string. - - * mml.el (mml-content-disposition-parameters) - (mml-insert-mime-headers-always): Add :version. - - * mm-util.el (mm-coding-system-priorities): Add :version. - - * mm-decode.el (mm-inline-text-html-with-images) - (mm-keep-viewer-alive-types, mm-external-terminal-program) - (mm-verify-option): Add :version. - (mm-text-html-renderer): Change :version. - - * message.el (message-fcc-externalize-attachments) - (message-required-headers, message-draft-headers) - (message-subject-trailing-was-query) - (message-subject-trailing-was-ask-regexp) - (message-subject-trailing-was-regexp, message-mark-insert-begin) - (message-mark-insert-end, message-archive-header) - (message-archive-note, message-cross-post-default) - (message-cross-post-note, message-followup-to-note) - (message-cross-post-note-function, message-use-mail-followup-to) - (message-subscribed-address-functions) - (message-subscribed-address-file, message-subscribed-addresses) - (message-subscribed-regexps, message-allow-no-recipients) - (message-yank-cited-prefix, message-signature-insert-empty-line) - (message-hidden-headers, message-hierarchical-addresses) - (message-mail-user-agent, message-use-idna) - (message-valid-fqdn-regexp) - (message-strip-special-text-properties, message-header-synonyms) - (message-beginning-of-line, message-tab-body-function): Add :version. - (message-insert-canlock, message-wide-reply-confirm-recipients): - Change :version. - - * mail-source.el (mail-source-ignore-errors): Add :group, :type - and :version. - (mail-source-delete-old-incoming-confirm) - (mail-source-movemail-program): Add :version. - - * gnus.el (gnus-parameters, gnus-user-agent): Add :version. - (gnus-agent-cache, gnus-agent): Change :version. - - * gnus-util.el (gnus-use-byte-compile): Change :version. - - * gnus-sum.el (gnus-summary-make-false-root-always) - (gnus-summary-default-high-score) - (gnus-summary-default-low-score, gnus-auto-goto-ignores) - (gnus-forwarded-mark, gnus-unseen-mark, gnus-no-mark) - (gnus-read-all-available-headers, gnus-article-emulate-mime) - (gnus-sum-thread-tree-root, gnus-sum-thread-tree-false-root) - (gnus-sum-thread-tree-single-indent) - (gnus-sum-thread-tree-vertical, gnus-sum-thread-tree-indent) - (gnus-sum-thread-tree-leaf-with-other) - (gnus-sum-thread-tree-single-leaf): Add :version. - (gnus-summary-display-arrow, gnus-summary-muttprint-program) - (gnus-article-loose-mime): Change :version. - - * gnus-start.el (gnus-backup-startup-file) - (gnus-save-startup-file-via-temp-buffer): Add :version. - - * gnus-srvr.el (gnus-server-browse-in-group-buffer) - (gnus-server-offline-face): Add :version. - - * gnus-score.el (gnus-adaptive-word-length-limit): Add :version. - - * gnus-msg.el (gnus-gcc-externalize-attachments) - (gnus-debug-files, gnus-debug-exclude-variables) - (gnus-discouraged-post-methods): Change :version. - (gnus-confirm-mail-reply-to-news) - (gnus-confirm-treat-mail-like-news): Add :version. - - * gnus-int.el (gnus-server-unopen-status): Add :version. - - * gnus-group.el (gnus-group-jump-to-group-prompt) - (gnus-large-ephemeral-newsgroup) - (gnus-fetch-old-ephemeral-headers): Add :version. - - * gnus-fun.el (gnus-x-face-directory) - (gnus-convert-pbm-to-x-face-command) - (gnus-convert-image-to-x-face-command) - (gnus-convert-image-to-face-command): Add :version. - - * gnus-delay.el (gnus-delay-default-hour): Add :version. - - * gnus-cite.el (gnus-cite-blank-line-after-header) - (gnus-article-boring-faces): Add :version. - - * gnus-art.el (gnus-buttonized-mime-types) - (gnus-inhibit-mime-unbuttonizing) - (gnus-treat-display-face) - (gnus-treat-body-boundary): Change :version. - (gnus-body-boundary-delimiter, gnus-picon-databases) - (gnus-treat-strip-cr, gnus-treat-leading-whitespace) - (gnus-treat-date-english, gnus-treat-fold-headers) - (gnus-article-skip-boring, gnus-treat-fold-newsgroups) - (gnus-treat-mail-picon, gnus-treat-wash-html) - (gnus-article-encrypt-protocol) - (gnus-use-idna, gnus-article-over-scroll) - (gnus-mime-display-multipart-alternative-as-mixed) - (gnus-mime-display-multipart-related-as-mixed) - (gnus-button-valid-fqdn-regexp, gnus-button-man-handler) - (gnus-ctan-url, gnus-button-ctan-handler) - (gnus-button-handle-ctan-bogus-regexp) - (gnus-button-ctan-directory-regexp) - (gnus-button-mid-or-mail-regexp, gnus-button-prefer-mid-or-mail) - (gnus-button-mid-or-mail-heuristic-alist, gnus-button-tex-level) - (gnus-button-man-level, gnus-button-emacs-level) - (gnus-button-message-level, gnus-button-browse-level): Add :version. - - * gnus-agent.el (gnus-agent-fetched-hook): Add :version. - (gnus-agent-go-online): Change :version. - (gnus-agent-expire-unagentized-dirs) - (gnus-agent-auto-agentize-methods): Add :version. - - * flow-fill.el (fill-flowed-display-column) - (fill-flowed-encode-column): Add :version. - - * deuglify.el (gnus-outlook-deuglify-unwrap-min) - (gnus-outlook-deuglify-unwrap-max) - (gnus-outlook-deuglify-cite-marks) - (gnus-outlook-deuglify-unwrap-stop-chars) - (gnus-outlook-deuglify-no-wrap-chars) - (gnus-outlook-deuglify-attrib-cut-regexp) - (gnus-outlook-deuglify-attrib-verb-regexp) - (gnus-outlook-deuglify-attrib-end-regexp) - (gnus-outlook-display-hook): Add :version. - - * binhex.el (binhex-use-external): Add :version. - -2004-09-16 Reiner Steib - - * gnus-sum.el (gnus-fetch-old-headers): Add custom choices `t' - and `invisible'. - -2004-09-13 Simon Josefsson - - * nnimap.el (nnimap-demule): Revert 2004-08-30 change. - -2004-09-13 Reiner Steib - - * gnus-sum.el (gnus-summary-copy-article): Fix doc string. - -2004-09-10 Miles Bader - - * nnimap.el (nnimap-open-connection): Remove extraneous end-paren. - -2004-09-10 Teodor Zlatanov - - * nnimap.el (nnimap-open-connection): Allow 'imaps' as a synonym - for the 'imap' port in netrc files. - - * gnus-registry.el (gnus-registry-trim): Watch out for negatives - in gnus-registry-trim. - -2004-09-10 Simon Josefsson - - * nndb.el (require): Remove tcp and duplicate cl. - -2004-09-08 Reiner Steib - - * nntp.el (nntp): New customization group. - (nntp-authinfo-file): Add customization group. - - * mml2015.el (mml2015-unabbrev-trust-alist): Add customization group. - - * mml-sec.el (mml-signencrypt-style-alist): Ditto. - - * gnus.el (to-address, to-list, subscribed) - (large-newsgroup-initial): Ditto. - - * flow-fill.el (fill-flowed-display-column) - (fill-flowed-encode-column): Ditto. - -2004-09-06 Stefan Monnier - - * message.el (message-tokenize-header, message-send-mail-with-qmail): - Use point-min rather than 1. - (message-send-mail): Use buffer-size rather than point-max. - - * gnus-sum.el (gnus-summary-search-article-forward): - Signal a specific `search-failed' rather than a generic `error'. - - * gnus-salt.el (gnus-pick-mouse-pick-region): Switch 1 => point-min. - (gnus-generate-vertical-tree): Usue `bobp' rather than compare to 1. - (gnus-highlight-selected-tree): Use point-min rather than 1 and 2. - -2004-09-03 Katsumi Yamaoka - - * gnus-sum.el (gnus-summary-insert-subject): Remove list identifiers. - -2004-09-03 Hiroshi Fujishima (tiny change) - - * spam-stat.el (spam-stat-reduce-size): Set spam-stat-dirty. - (spam-stat-save): Accept prefix argument. - -2004-09-01 Simon Josefsson - - * message.el (message-canlock-generate): Require sha1, not - sha1-el. (Can we get rid of this require alltogheter? It is ugly - to require within a function. Sadly, if sha1.el isn't loaded, the - let binding in m-c-g will hide the defcustom definition, which is - bad.) - - * canlock.el: Require sha1, not sha1-el. - - * message.el: Don't autoload sha1 (there is a autoload cookie in - sha1.el). - - * sha1-el.el: Renamed to sha1.el. - -2004-05-19 Lars Magne Ingebrigtsen - - * pgg-pgp.el (pgg-pgp-verify-region): Clean up. - -2004-05-19 Michael Schierl (tiny change) - - * pgg-pgp.el (pgg-pgp-verify-region): Default when signature - isn't a string. - -2004-03-05 Jesper Harder - - * sha1-el.el (sha1-maximum-internal-length): Doc fix. - -2004-03-04 Katsumi Yamaoka - - * canlock.el: Don't autoload mail-fetch-field. - -2004-01-19 Katsumi Yamaoka - - * canlock.el (base64-encode-string): Don't autoload it. - -2004-01-14 Katsumi Yamaoka - - * canlock.el: Always require sha1-el. - (canlock-sha1): Bind sha1-maximum-internal-length to nil. - -2004-01-13 Katsumi Yamaoka - - * message.el (message-canlock-generate): Require sha1-el. - -2004-01-08 Katsumi Yamaoka - - * canlock.el (canlock-insert-header): Remove excessive grouping in - regexp. - -2004-01-07 Katsumi Yamaoka - - * sha1-el.el (sha1-string-external): Use with-temp-buffer. - -2004-01-07 Katsumi Yamaoka - - * canlock.el (canlock-sha1-function): Remove. - (canlock-sha1-function-for-verify): Remove. - (canlock-openssl-program): Remove. - (canlock-openssl-args): Remove. - (canlock-ignore-errors): Remove. - (canlock-sha1-with-openssl): Remove. - (canlock-sha1): Use sha1 instead of to call canlock-sha1-function. - (canlock-verify): Don't use canlock-ignore-errors. - - * sha1-el.el (sha1-string-external): Make it can return a string - in binary form. - (sha1-region-external): Ditto. - (sha1-string-internal): Ditto. - (sha1-region-internal): Ditto. - (sha1-region): Ditto. - (sha1-string): Ditto. - (sha1): Ditto. - -2003-11-15 Simon Josefsson - - * pgg-gpg.el (pgg-gpg-lookup-all-secret-keys) - (pgg-gpg-lookup-key): Use regexp match instead of - split-string (split-string is different between emacs 21.2 and - 22.1). Reported by ultrasoul@ultrasoul.com (David D. Smith). - -2004-07-28 Simon Josefsson - - * pgg-pgp5.el (pgg-pgp5-encrypt-region): Accept sign - parameter (but don't use it, for now). - -2004-02-03 Jesper Harder - - * sieve.el (sieve-deactivate-all): Fix format string mismatch. - -2004-05-26 Simon Josefsson - - * starttls.el: Merge with my GNUTLS based starttls.el. - (starttls-gnutls-program, starttls-use-gnutls) - (starttls-extra-arguments, starttls-process-connection-type) - (starttls-connect, starttls-failure, starttls-success): New variables. - (starttls-program, starttls-extra-args): Doc fix. - (starttls-negotiate-gnutls, starttls-open-stream-gnutls): - New functions. - (starttls-negotiate, starttls-open-stream): - Check `starttls-use-gnutls' and pass on to corresponding *-gnutls - function if it is set. - -2004-08-30 Juanma Barranquero - - * ietf-drums.el (ietf-drums-remove-whitespace): Fix character constant. - -2004-08-30 Andreas Schwab - - * nnlistserv.el (nnlistserv-kk-wash-article): Fix paren nesting. - - * gnus-score.el (gnus-summary-increase-score): Fix format string. - -2004-08-30 Stefan Monnier - - * nnimap.el (nnimap-demule): Avoid string-as-multibyte. - -2004-08-30 Kim F. Storm - - * nntp.el (nntp-authinfo-file): Add :group 'nntp. - - * nnimap.el (nnimap-authinfo-file, nnimap-prune-cache): - Add :group 'nnimap. - -2004-08-30 Andreas Schwab - - * rfc2231.el (rfc2231-parse-string): Restore whitespace syntax for - ?* and ?\;. - -2004-08-30 Andreas Schwab - - * rfc2231.el (rfc2231-parse-string): Restore whitespace syntax for - ?* and ?\;. - - * ietf-drums.el (ietf-drums-syntax-table): Set syntax of ?* ?\; - and ?\' to symbol instead of whitespace. - -2004-06-23 Jesper Harder - - * message.el (message-idna-to-ascii-rhs-1): Don't choke on - invalid addresses. - -2004-05-18 Reiner Steib - - * message.el (message-idna-to-ascii-rhs-1): Fix typo. - -2004-05-18 Lars Magne Ingebrigtsen - - * message.el (message-idna-to-ascii-rhs-1): Don't use equalp. - -2004-05-17 Lars Magne Ingebrigtsen - - * gnus-art.el (article-decode-idna-rhs): Don't use - message-idna-inside-rhs-p. - -2004-05-16 Lars Magne Ingebrigtsen - - * message.el (message-idna-inside-rhs-p): Remove. - (message-idna-to-ascii-rhs-1): Use proper address parsing. - -2004-08-30 Katsumi Yamaoka - - * gnus-agent.el (gnus-agent-restore-gcc): Use ^ and regexp-quote. - -2004-08-30 Helmut Waitzmann (tiny change) - - * gnus-sum.el (gnus-newsgroup-variables): Doc fix. - -2004-08-26 YAGI Tatsuya (tiny change) - - * gnus-art.el (gnus-article-next-page): Fix the way to find a real - end-of-buffer. - -2004-08-26 Stefan Wiens (tiny change) - - * gnus-sum.el (gnus-read-header): Don't remove a header for the - parent article of a sparse article in the thread hashtb. - -2004-08-26 David Hedbor (tiny change) - - * nnmail.el (nnmail-split-lowercase-expanded): New user option. - (nnmail-expand-newtext): Lowercase expanded entries if - nnmail-split-lowercase-expanded is non-nil. - -2004-08-26 Katsumi Yamaoka - - * gnus-agent.el (gnus-agent-regenerate-group): Activate the group - when the group's active is not available. - - * gnus-art.el (article-hide-headers): Refer to the values for - gnus-ignored-headers and gnus-visible-headers in the summary - buffer since a user may have set them as group parameters. - (gnus-article-read-summary-keys): Restore new window-start and - hscroll to summary window. - (gnus-prev-page-map): Remove duplicated one. - - * gnus-cite.el (gnus-cite-ignore-quoted-from): New user option. - (gnus-cite-parse): Ignore quoted envelope From_. Suggested by - Karl Chen and Reiner Steib - . - - * gnus-cus.el (gnus-agent-cat-prepare-category-field): - Replace pp-to-string with gnus-pp-to-string. - - * gnus-eform.el (gnus-edit-form): Replace pp with gnus-pp. - - * gnus-group.el (gnus-group-make-kiboze-group): Replace pp with - gnus-pp. - - * gnus-msg.el (gnus-setup-message): Ignore an article copy while - parsing gnus-posting-styles when the message is not for replying. - (gnus-summary-resend-message-edit): Call mime-to-mml. - Suggested by Hiroshi Fujishima . - (gnus-debug): Replace pp with gnus-pp. - - * gnus-score.el (gnus-score-save): Replace pp with gnus-pp. - - * gnus-spec.el (gnus-update-format): Replace pp-to-string with - gnus-pp-to-string. - - * gnus-util.el (gnus-bind-print-variables): New macro. - (gnus-prin1): Use it. - (gnus-prin1-to-string): Use it. - (gnus-pp): New function. - (gnus-pp-to-string): New function. - - * gnus.el: Don't make unnecessary *Group* buffer when loading. - - * mail-source.el (mail-source-touch-pop): Doc fix. - - * message.el (message-mode): Don't modify paragraph-separate there. - (message-setup-fill-variables): Add mml tags to paragraph-start - and paragraph-separate. Suggested by Andrew Korty . - (message-smtpmail-send-it): Doc fix. - (message-exchange-point-and-mark): Don't activate region if it was - inactive. Suggested by Hiroshi Fujishima - and Jesper Harder . - - * mm-decode.el (mm-save-part): Bind enable-multibyte-characters to - t while entering a file name using the mm-with-multibyte macro. - Suggested by Hiroshi Fujishima . - - * mm-encode.el (mm-content-transfer-encoding-defaults): - Use qp-or-base64 for the application/* types. - (mm-safer-encoding): Consider 7bit is safe. - - * mm-util.el (mm-with-multibyte-buffer): New macro. - (mm-with-multibyte): New macro. - - * mm-view.el (mm-inline-render-with-function): Use multibyte - buffer; decode html source by charset. - - * nndoc.el (nndoc-type-alist): Improve regexp for article-begin, - add generate-head-function and generate-article-function to the - rfc822-forward entry. - (nndoc-forward-type-p): Recognize envelope From_. - (nndoc-rfc822-forward-generate-article): New function. - (nndoc-rfc822-forward-generate-head): New function. - - * score-mode.el (gnus-score-pretty-print): Replace pp with gnus-pp. - - * webmail.el (webmail-debug): Replace pp with gnus-pp. - -2004-08-25 Katsumi Yamaoka - - * gnus-art.el (gnus-article-wash-html-with-w3m): - Bind w3m-safe-url-regexp as the value for mm-w3m-safe-url-regexp; - use w3m-minor-mode-map instead of mm-w3m-local-map-property. - (gnus-mime-save-part-and-strip): Use mm-complicated-handles - instead of mm-multiple-handles. - (gnus-mime-delete-part): Ditto. - - * lpath.el: Fbind w3m-detect-meta-charset; don't fbind - w3m-charset-to-coding-system; don't bind - w3m-meta-content-type-charset-regexp. - - * mm-decode.el (mm-multiple-handles): Recognize a string as a mime - handle, as well as a list. - (mm-complicated-handles): Former definition of mm-multiple-handles. - - * mm-view.el (mm-w3m-mode-map): Remove. - (mm-w3m-local-map-property): Remove. - (mm-w3m-cid-retrieve-1): Call itself recursively. Suggested by - ARISAWA Akihiro . - (mm-w3m-cid-retrieve): Simplify. - (mm-inline-text-html-render-with-w3m): Decode html source by - charset; check META tags only when charsets are not specified in - headers; specify charset to w3m-region; use w3m-minor-mode-map - instead of mm-w3m-local-map-property. - -2004-08-22 Katsumi Yamaoka - - * gnus-art.el (article-hide-list-identifiers): - Bind inhibit-read-only as t. - -2004-08-22 Reiner Steib - - * gnus-mlspl.el (gnus-group-split-update): Fix docstring. - -2004-08-22 Stefan Monnier - - * gnus-art.el: Use inhibit-read-only instead of buffer-read-only. - (gnus-narrow-to-page): Don't assume point-min == 1. - (gnus-article-edit-mode): Derive from message-mode. - - * gnus-score.el (gnus-score-find-bnews): Simplify and don't assume - point-min == 1. - - * imap.el (imap-parse-address-list, imap-parse-body-ext): - Disable incorrect use of `assert'. - - * message.el (message-mode): Set comment-start-skip. - -2004-08-22 Sam Steingold - - * pop3.el (pop3-leave-mail-on-server): New user variable. - (pop3-movemail): Delete mail only when it is nil. - -2004-08-16 Reiner Steib - - * mailcap.el (mailcap-mime-data): Mark as risky. - -2004-08-05 Reiner Steib - - * gnus.el (gnus-group, gnus-summary, gnus-summary-sort): - Fix custom-manual entries. - - * gnus-art.el (gnus-article): Fix custom-manual entries. - -2004-08-02 Reiner Steib - - * gnus.el (gnus-group, gnus-summary, gnus-summary-sort): Fix - custom-manual entries. - -2004-05-23 Katsumi Yamaoka - - * mm-decode.el (mm-text-html-renderer): Make sure w3m exists in - addition to emacs-w3m. - -2004-05-19 Reiner Steib - - * gnus-msg.el (gnus-summary-followup-with-original): - Document yanking of region when active. - -2004-04-13 Kevin Greiner - - * gnus-agent.el: Merged 7.3 through 7.7 updates into branch. - Revision 7.2 changes excluded to maintain compatibility with all - targeted emacs versions. - - * gnus-cus.el: Merged revisions 7.2 through 7.5 into branch to support - gnus-agent.el update and incorporate bug fixes. - -See ChangeLog.2 for earlier changes. - - Copyright (C) 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - - This file is part of GNU Emacs. - - GNU Emacs is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3, or (at your option) - any later version. - - GNU Emacs is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with GNU Emacs; see the file COPYING. If not, write to the - Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, - Boston, MA 02110-1301, USA. - -;; Local Variables: -;; coding: iso-2022-7bit -;; fill-column: 79 -;; add-log-time-zone-rule: t -;; End: - -;;; arch-tag: 3f33a3e7-090d-492b-bedd-02a1417d32b4 diff --git a/xemacs-packages/gnus/lisp/GNUS-NEWS b/xemacs-packages/gnus/lisp/GNUS-NEWS deleted file mode 100644 index 4d47d084..00000000 --- a/xemacs-packages/gnus/lisp/GNUS-NEWS +++ /dev/null @@ -1,549 +0,0 @@ -GNUS NEWS -- history of user-visible changes. - -Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, - 2006, 2007, 2008 Free Software Foundation, Inc. -See the end of the file for license conditions. - -Please send Gnus bug reports to bugs@gnus.org. -For older news, see Gnus info node "New Features". - - -* Installation changes - -** Upgrading from previous (stable) version if you have used Oort. - -If you have tried Oort (the unstable Gnus branch leading to this -release) but went back to a stable version, be careful when upgrading to -this version. In particular, you will probably want to remove all -`.marks' (nnml) and `.mrk' (nnfolder) files, so that flags are read from -your `.newsrc.eld' instead of from the `.marks'/`.mrk' file where this -release store flags. See a later entry for more information about -marks. Note that downgrading isn't save in general. - -** Lisp files are now installed in `.../site-lisp/gnus/' by default. It -defaulted to `.../site-lisp/' formerly. In addition to this, the new -installer issues a warning if other Gnus installations which will shadow -the latest one are detected. You can then remove those shadows manually -or remove them using `make remove-installed-shadows'. - -** The installation directory name is allowed to have spaces and/or tabs. - -** New `make.bat' for compiling and installing Gnus under MS Windows - -Use `make.bat' if you want to install Gnus under MS Windows, the first -argument to the batch-program should be the directory where `xemacs.exe' -respectively `emacs.exe' is located, if you want to install Gnus after -compiling it, give `make.bat' `/copy' as the second parameter. - -`make.bat' has been rewritten from scratch, it now features automatic -recognition of XEmacs and GNU Emacs, generates `gnus-load.el', checks if -errors occur while compilation and generation of info files and reports -them at the end of the build process. It now uses `makeinfo' if it is -available and falls back to `infohack.el' otherwise. `make.bat' should -now install all files which are necessary to run Gnus and be generally a -complete replacement for the `configure; make; make install' cycle used -under Unix systems. - -The new `make.bat' makes `make-x.bat' and `xemacs.mak' superfluous, so -they have been removed. - -** `~/News/overview/' not used. - -As a result of the following change, the `~/News/overview/' directory is -not used any more. You can safely delete the entire hierarchy. - -** `(require 'gnus-load)' - -If you use a stand-alone Gnus distribution, you'd better add `(require -'gnus-load)' into your `~/.emacs' after adding the Gnus lisp directory -into load-path. - -File `gnus-load.el' contains autoload commands, functions and variables, -some of which may not be included in distributions of Emacsen. - - - -* New packages and libraries within Gnus - -** The revised Gnus FAQ is included in the manual, *Note Frequently Asked -Questions::. - -** TLS wrapper shipped with Gnus - -TLS/SSL is now supported in IMAP and NNTP via `tls.el' and GNUTLS. The -old TLS/SSL support via (external third party) `ssl.el' and OpenSSL -still works. - -** Improved anti-spam features. - -Gnus is now able to take out spam from your mail and news streams using -a wide variety of programs and filter rules. Among the supported -methods are RBL blocklists, bogofilter and white/blacklists. Hooks for -easy use of external packages such as SpamAssassin and Hashcash are also -new. *Note Thwarting Email Spam::. - -** Gnus supports server-side mail filtering using Sieve. - -Sieve rules can be added as Group Parameters for groups, and the -complete Sieve script is generated using `D g' from the Group buffer, -and then uploaded to the server using `C-c C-l' in the generated Sieve -buffer. *Note Sieve Commands::, and the new Sieve manual *Note Top: -(sieve)Top. - - - -* Changes in group mode - -** `gnus-group-read-ephemeral-group' can be called interactively, using `G -M'. - -** Retrieval of charters and control messages - -There are new commands for fetching newsgroup charters (`H c') and -control messages (`H C'). - -** The new variable `gnus-parameters' can be used to set group parameters. - -Earlier this was done only via `G p' (or `G c'), which stored the -parameters in `~/.newsrc.eld', but via this variable you can enjoy the -powers of customize, and simplified backups since you set the variable -in `~/.gnus.el' instead of `~/.newsrc.eld'. The variable maps regular -expressions matching group names to group parameters, a'la: -(setq gnus-parameters - '(("mail\\..*" - (gnus-show-threads nil) - (gnus-use-scoring nil)) - ("^nnimap:\\(foo.bar\\)$" - (to-group . "\\1")))) - -** Unread count correct in nnimap groups. - -The estimated number of unread articles in the group buffer should now -be correct for nnimap groups. This is achieved by calling -`nnimap-fixup-unread-after-getting-new-news' from the -`gnus-setup-news-hook' (called on startup) and -`gnus-after-getting-new-news-hook'. (called after getting new mail). If -you have modified those variables from the default, you may want to add -`nnimap-fixup-unread-after-getting-new-news' again. If you were happy -with the estimate and want to save some (minimal) time when getting new -mail, remove the function. - -** Group names are treated as UTF-8 by default. - -This is supposedly what USEFOR wanted to migrate to. See -`gnus-group-name-charset-group-alist' and -`gnus-group-name-charset-method-alist' for customization. - -** `gnus-group-charset-alist' and `gnus-group-ignored-charsets-alist'. - -The regexps in these variables are compared with full group names -instead of real group names in 5.8. Users who customize these variables -should change those regexps accordingly. For example: -("^han\\>" euc-kr) -> ("\\(^\\|:\\)han\\>" euc-kr) - -** Old intermediate incoming mail files (`Incoming*') are deleted after a -couple of days, not immediately. *Note Mail Source Customization::. -(New in Gnus 5.10.10 / Emacs 22.2) - - -* Changes in summary and article mode - -** `F' (`gnus-article-followup-with-original') and `R' -(`gnus-article-reply-with-original') only yank the text in the region if -the region is active. - -** In draft groups, `e' is now bound to `gnus-draft-edit-message'. Use `B -w' for `gnus-summary-edit-article' instead. - -** Article Buttons - -More buttons for URLs, mail addresses, Message-IDs, Info links, man -pages and Emacs or Gnus related references. *Note Article Buttons::. -The variables `gnus-button-*-level' can be used to control the -appearance of all article buttons. *Note Article Button Levels::. - -** Single-part yenc encoded attachments can be decoded. - -** Picons - -The picons code has been reimplemented to work in GNU Emacs--some of the -previous options have been removed or renamed. - -Picons are small "personal icons" representing users, domain and -newsgroups, which can be displayed in the Article buffer. *Note -Picons::. - -** If the new option `gnus-treat-body-boundary' is non-`nil', a boundary -line is drawn at the end of the headers. - -** Signed article headers (X-PGP-Sig) can be verified with `W p'. - -** The Summary Buffer uses an arrow in the fringe to indicate the current -article. Use `(setq gnus-summary-display-arrow nil)' to disable it. - -** Warn about email replies to news - -Do you often find yourself replying to news by email by mistake? Then -the new option `gnus-confirm-mail-reply-to-news' is just the thing for -you. - -** If the new option `gnus-summary-display-while-building' is non-`nil', -the summary buffer is shown and updated as it's being built. - -** The new `recent' mark `.' indicates newly arrived messages (as opposed -to old but unread messages). - -** Gnus supports RFC 2369 mailing list headers, and adds a number of -related commands in mailing list groups. *Note Mailing List::. - -** The Date header can be displayed in a format that can be read aloud in -English. *Note Article Date::. - -** diffs are automatically highlighted in groups matching -`mm-uu-diff-groups-regexp' - -** Better handling of Microsoft citation styles - -Gnus now tries to recognize the mangled header block that some Microsoft -mailers use to indicate that the rest of the message is a citation, even -though it is not quoted in any way. The variable -`gnus-cite-unsightly-citation-regexp' matches the start of these -citations. - -The new command `W Y f' (`gnus-article-outlook-deuglify-article') allows -deuglifying broken Outlook (Express) articles. - -** `gnus-article-skip-boring' - -If you set `gnus-article-skip-boring' to `t', then Gnus will not scroll -down to show you a page that contains only boring text, which by default -means cited text and signature. You can customize what is skippable -using `gnus-article-boring-faces'. - -This feature is especially useful if you read many articles that consist -of a little new content at the top with a long, untrimmed message cited -below. - -** Smileys (`:-)', `;-)' etc) are now displayed graphically in Emacs too. - -Put `(setq gnus-treat-display-smileys nil)' in `~/.gnus.el' to disable -it. - -** Face headers handling. *Note Face::. - -** In the summary buffer, the new command `/ N' inserts new messages and `/ -o' inserts old messages. - -** Gnus decodes morse encoded messages if you press `W m'. - -** `gnus-summary-line-format' - -The default value changed to `%U%R%z%I%(%[%4L: %-23,23f%]%) %s\n'. -Moreover `gnus-extra-headers', `nnmail-extra-headers' and -`gnus-ignored-from-addresses' changed their default so that the users -name will be replaced by the recipient's name or the group name posting -to for NNTP groups. - -** Deleting of attachments. - -The command `gnus-mime-save-part-and-strip' (bound to `C-o' on MIME -buttons) saves a part and replaces the part with an external one. -`gnus-mime-delete-part' (bound to `d' on MIME buttons) removes a part. -It works only on back ends that support editing. - -** `gnus-default-charset' - -The default value is determined from the `current-language-environment' -variable, instead of `iso-8859-1'. Also the `.*' item in -`gnus-group-charset-alist' is removed. - -** Printing capabilities are enhanced. - -Gnus supports Muttprint natively with `O P' from the Summary and Article -buffers. Also, each individual MIME part can be printed using `p' on -the MIME button. - -** Extended format specs. - -Format spec `%&user-date;' is added into -`gnus-summary-line-format-alist'. Also, user defined extended format -specs are supported. The extended format specs look like `%u&foo;', -which invokes function `gnus-user-format-function-FOO'. Because `&' is -used as the escape character, old user defined format `%u&' is no longer -supported. - -** `/ *' (`gnus-summary-limit-include-cached') is rewritten. - -It was aliased to `Y c' (`gnus-summary-insert-cached-articles'). The -new function filters out other articles. - -** Some limiting commands accept a `C-u' prefix to negate the match. - -If `C-u' is used on subject, author or extra headers, i.e., `/ s', `/ -a', and `/ x' (`gnus-summary-limit-to-{subject,author,extra}') -respectively, the result will be to display all articles that do not -match the expression. - -** Gnus inlines external parts (message/external). - - - -* Changes in Message mode and related Gnus features - -** Delayed articles - -You can delay the sending of a message with `C-c C-j' in the Message -buffer. The messages are delivered at specified time. This is useful -for sending yourself reminders. *Note Delayed Articles::. - -** If the new option `nnml-use-compressed-files' is non-`nil', the nnml -back end allows compressed message files. - -** The new option `gnus-gcc-mark-as-read' automatically marks Gcc articles -as read. - -** Externalizing of attachments - -If `gnus-gcc-externalize-attachments' or -`message-fcc-externalize-attachments' is non-`nil', attach local files -as external parts. - -** The envelope sender address can be customized when using Sendmail. - *Note Mail Variables: (message)Mail Variables. - -** Gnus no longer generate the Sender: header automatically. - -Earlier it was generated when the user configurable email address was -different from the Gnus guessed default user address. As the guessing -algorithm is rarely correct these days, and (more controversially) the -only use of the Sender: header was to check if you are entitled to -cancel/supersede news (which is now solved by Cancel Locks instead, see -another entry), generation of the header has been disabled by default. -See the variables `message-required-headers', -`message-required-news-headers', and `message-required-mail-headers'. - -** Features from third party `message-utils.el' added to `message.el'. - -Message now asks if you wish to remove `(was: )' from -subject lines (see `message-subject-trailing-was-query'). `C-c M-m' and -`C-c M-f' inserts markers indicating included text. `C-c C-f a' adds a -X-No-Archive: header. `C-c C-f x' inserts appropriate headers and a -note in the body for cross-postings and followups (see the variables -`message-cross-post-*'). - -** References and X-Draft-From headers are no longer generated when you -start composing messages and `message-generate-headers-first' is `nil'. - -** Easy inclusion of X-Faces headers. *Note X-Face::. - -** Group Carbon Copy (GCC) quoting - -To support groups that contains SPC and other weird characters, groups -are quoted before they are placed in the Gcc: header. This means -variables such as `gnus-message-archive-group' should no longer contain -quote characters to make groups containing SPC work. Also, if you are -using the string `nnml:foo, nnml:bar' (indicating Gcc into two groups) -you must change it to return the list `("nnml:foo" "nnml:bar")', -otherwise the Gcc: line will be quoted incorrectly. Note that returning -the string `nnml:foo, nnml:bar' was incorrect earlier, it just didn't -generate any problems since it was inserted directly. - -** `message-insinuate-rmail' - -Adding `(message-insinuate-rmail)' and `(setq mail-user-agent -'gnus-user-agent)' in `.emacs' convinces Rmail to compose, reply and -forward messages in message-mode, where you can enjoy the power of MML. - -** `message-minibuffer-local-map' - -The line below enables BBDB in resending a message: -(define-key message-minibuffer-local-map [(tab)] - 'bbdb-complete-name) - -** `gnus-posting-styles' - -Add a new format of match like -((header "to" "larsi.*org") - (Organization "Somewhere, Inc.")) -The old format like the lines below is obsolete, but still accepted. -(header "to" "larsi.*org" - (Organization "Somewhere, Inc.")) - -** `message-ignored-news-headers' and `message-ignored-mail-headers' - -`X-Draft-From' and `X-Gnus-Agent-Meta-Information' have been added into -these two variables. If you customized those, perhaps you need add -those two headers too. - -** Gnus supports the "format=flowed" (RFC 2646) parameter. On composing -messages, it is enabled by `use-hard-newlines'. Decoding format=flowed -was present but not documented in earlier versions. - -** The option `mm-fill-flowed' can be used to disable treatment of -"format=flowed" messages. Also, flowed text is disabled when sending -inline PGP signed messages. (New in Gnus 5.10.7) - -** Gnus supports the generation of RFC 2298 Disposition Notification -requests. - -This is invoked with the `C-c M-n' key binding from message mode. - -** Message supports the Importance: (RFC 2156) header. - -In the message buffer, `C-c C-f C-i' or `C-c C-u' cycles through the -valid values. - -** Gnus supports Cancel Locks in News. - -This means a header `Cancel-Lock' is inserted in news posting. It is -used to determine if you wrote an article or not (for canceling and -superseding). Gnus generates a random password string the first time -you post a message, and saves it in your `~/.emacs' using the Custom -system. While the variable is called `canlock-password', it is not -security sensitive data. Publishing your canlock string on the web will -not allow anyone to be able to anything she could not already do. The -behavior can be changed by customizing `message-insert-canlock'. - -** Gnus supports PGP (RFC 1991/2440), PGP/MIME (RFC 2015/3156) and S/MIME -(RFC 2630-2633). - -It needs an external S/MIME and OpenPGP implementation, but no -additional Lisp libraries. This add several menu items to the -Attachments menu, and `C-c RET' key bindings, when composing messages. -This also obsoletes `gnus-article-hide-pgp-hook'. - -** MML (Mime compose) prefix changed from `M-m' to `C-c C-m'. - -This change was made to avoid conflict with the standard binding of -`back-to-indentation', which is also useful in message mode. - -** The default for `message-forward-show-mml' changed to the symbol `best'. - -The behavior for the `best' value is to show MML (i.e., convert to MIME) -when appropriate. MML will not be used when forwarding signed or -encrypted messages, as the conversion invalidate the digital signature. - -** If `auto-compression-mode' is enabled, attachments are automatically -decompressed when activated. - -** Support for non-ASCII domain names - -Message supports non-ASCII domain names in From:, To: and Cc: and will -query you whether to perform encoding when you try to send a message. -The variable `message-use-idna' controls this. Gnus will also decode -non-ASCII domain names in From:, To: and Cc: when you view a message. -The variable `gnus-use-idna' controls this. - -** You can now drag and drop attachments to the Message buffer. See -`mml-dnd-protocol-alist' and `mml-dnd-attach-options'. *Note MIME: -(message)MIME. - - - -* Changes in back ends - -** Gnus can display RSS newsfeeds as a newsgroup. *Note RSS::. - -** The nndoc back end now supports mailman digests and exim bounces. - -** Gnus supports Maildir groups. - -Gnus includes a new back end `nnmaildir.el'. *Note Maildir::. - -** The nnml and nnfolder back ends store marks for each groups. - -This makes it possible to take backup of nnml/nnfolder servers/groups -separately of `~/.newsrc.eld', while preserving marks. It also makes it -possible to share articles and marks between users (without sharing the -`~/.newsrc.eld' file) within e.g. a department. It works by storing the -marks stored in `~/.newsrc.eld' in a per-group file `.marks' (for nnml) -and `GROUPNAME.mrk' (for nnfolder, named GROUPNAME). If the -nnml/nnfolder is moved to another machine, Gnus will automatically use -the `.marks' or `.mrk' file instead of the information in -`~/.newsrc.eld'. The new server variables `nnml-marks-is-evil' and -`nnfolder-marks-is-evil' can be used to disable this feature. - - - -* Appearance - -** The menu bar item (in Group and Summary buffer) named "Misc" has been -renamed to "Gnus". - -** The menu bar item (in Message mode) named "MML" has been renamed to -"Attachments". Note that this menu also contains security related -stuff, like signing and encryption (*note Security: (message)Security.). - -** The tool bars have been updated to use GNOME icons in Group, Summary and -Message mode. You can also customize the tool bars: `M-x customize-apropos -RET -tool-bar$' should get you started. (Only for Emacs, not in XEmacs.) - -** The tool bar icons are now (de)activated correctly in the group buffer, -see the variable `gnus-group-update-tool-bar'. Its default value -depends on your Emacs version. This is a new feature in Gnus 5.10.9. - - -* Miscellaneous changes - -** `gnus-agent' - -The Gnus Agent has seen a major updated and is now enabled by default, -and all nntp and nnimap servers from `gnus-select-method' and -`gnus-secondary-select-method' are agentized by default. Earlier only -the server in `gnus-select-method' was agentized by the default, and the -agent was disabled by default. When the agent is enabled, headers are -now also retrieved from the Agent cache instead of the back ends when -possible. Earlier this only happened in the unplugged state. You can -enroll or remove servers with `J a' and `J r' in the server buffer. -Gnus will not download articles into the Agent cache, unless you -instruct it to do so, though, by using `J u' or `J s' from the Group -buffer. You revert to the old behavior of having the Agent disabled -with `(setq gnus-agent nil)'. Note that putting `(gnus-agentize)' in -`~/.gnus.el' is not needed any more. - -** Gnus reads the NOV and articles in the Agent if plugged. - -If one reads an article while plugged, and the article already exists in -the Agent, it won't get downloaded once more. `(setq gnus-agent-cache -nil)' reverts to the old behavior. - -** Dired integration - -`gnus-dired-minor-mode' (see *Note Other modes::) installs key bindings -in dired buffers to send a file as an attachment, open a file using the -appropriate mailcap entry, and print a file using the mailcap entry. - -** The format spec `%C' for positioning point has changed to `%*'. - -** `gnus-slave-unplugged' - -A new command which starts Gnus offline in slave mode. - - - -* For older news, see Gnus info node "New Features". - ----------------------------------------------------------------------- - -This file is part of GNU Emacs. - -GNU Emacs is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 3, or (at your option) -any later version. - -GNU Emacs is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with GNU Emacs; see the file COPYING. If not, write to the -Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -Boston, MA 02110-1301, USA. - - -Local variables: -mode: outline -paragraph-separate: "[ ]*$" -end: diff --git a/xemacs-packages/gnus/lisp/binhex.el b/xemacs-packages/gnus/lisp/binhex.el deleted file mode 100644 index 36a16325..00000000 --- a/xemacs-packages/gnus/lisp/binhex.el +++ /dev/null @@ -1,331 +0,0 @@ -;;; binhex.el --- elisp native binhex decode - -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Shenghuo Zhu -;; Keywords: binhex news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(autoload 'executable-find "executable") - -(eval-when-compile (require 'cl)) - -(eval-and-compile - (defalias 'binhex-char-int - (if (fboundp 'char-int) - 'char-int - 'identity))) - -(defcustom binhex-decoder-program "hexbin" - "*Non-nil value should be a string that names a binhex decoder. -The program should expect to read binhex data on its standard -input and write the converted data to its standard output." - :type 'string - :group 'gnus-extract) - -(defcustom binhex-decoder-switches '("-d") - "*List of command line flags passed to the command `binhex-decoder-program'." - :group 'gnus-extract - :type '(repeat string)) - -(defcustom binhex-use-external - (executable-find binhex-decoder-program) - "*Use external binhex program." - :version "22.1" - :group 'gnus-extract - :type 'boolean) - -(defconst binhex-alphabet-decoding-alist - '(( ?\! . 0) ( ?\" . 1) ( ?\# . 2) ( ?\$ . 3) ( ?\% . 4) ( ?\& . 5) - ( ?\' . 6) ( ?\( . 7) ( ?\) . 8) ( ?\* . 9) ( ?\+ . 10) ( ?\, . 11) - ( ?\- . 12) ( ?0 . 13) ( ?1 . 14) ( ?2 . 15) ( ?3 . 16) ( ?4 . 17) - ( ?5 . 18) ( ?6 . 19) ( ?8 . 20) ( ?9 . 21) ( ?@ . 22) ( ?A . 23) - ( ?B . 24) ( ?C . 25) ( ?D . 26) ( ?E . 27) ( ?F . 28) ( ?G . 29) - ( ?H . 30) ( ?I . 31) ( ?J . 32) ( ?K . 33) ( ?L . 34) ( ?M . 35) - ( ?N . 36) ( ?P . 37) ( ?Q . 38) ( ?R . 39) ( ?S . 40) ( ?T . 41) - ( ?U . 42) ( ?V . 43) ( ?X . 44) ( ?Y . 45) ( ?Z . 46) ( ?\[ . 47) - ( ?\` . 48) ( ?a . 49) ( ?b . 50) ( ?c . 51) ( ?d . 52) ( ?e . 53) - ( ?f . 54) ( ?h . 55) ( ?i . 56) ( ?j . 57) ( ?k . 58) ( ?l . 59) - ( ?m . 60) ( ?p . 61) ( ?q . 62) ( ?r . 63))) - -(defun binhex-char-map (char) - (cdr (assq char binhex-alphabet-decoding-alist))) - -;;;###autoload -(defconst binhex-begin-line - "^:...............................................................$") -(defconst binhex-body-line - "^[^:]...............................................................$") -(defconst binhex-end-line ":$") - -(defvar binhex-temporary-file-directory - (cond ((fboundp 'temp-directory) (temp-directory)) - ((boundp 'temporary-file-directory) temporary-file-directory) - ("/tmp/"))) - -(eval-and-compile - (defalias 'binhex-insert-char - (if (featurep 'xemacs) - 'insert-char - (lambda (char &optional count ignored buffer) - "Insert COUNT copies of CHARACTER into BUFFER." - (if (or (null buffer) (eq buffer (current-buffer))) - (insert-char char count) - (with-current-buffer buffer - (insert-char char count))))))) - -(defvar binhex-crc-table - [0 4129 8258 12387 16516 20645 24774 28903 - 33032 37161 41290 45419 49548 53677 57806 61935 - 4657 528 12915 8786 21173 17044 29431 25302 - 37689 33560 45947 41818 54205 50076 62463 58334 - 9314 13379 1056 5121 25830 29895 17572 21637 - 42346 46411 34088 38153 58862 62927 50604 54669 - 13907 9842 5649 1584 30423 26358 22165 18100 - 46939 42874 38681 34616 63455 59390 55197 51132 - 18628 22757 26758 30887 2112 6241 10242 14371 - 51660 55789 59790 63919 35144 39273 43274 47403 - 23285 19156 31415 27286 6769 2640 14899 10770 - 56317 52188 64447 60318 39801 35672 47931 43802 - 27814 31879 19684 23749 11298 15363 3168 7233 - 60846 64911 52716 56781 44330 48395 36200 40265 - 32407 28342 24277 20212 15891 11826 7761 3696 - 65439 61374 57309 53244 48923 44858 40793 36728 - 37256 33193 45514 41451 53516 49453 61774 57711 - 4224 161 12482 8419 20484 16421 28742 24679 - 33721 37784 41979 46042 49981 54044 58239 62302 - 689 4752 8947 13010 16949 21012 25207 29270 - 46570 42443 38312 34185 62830 58703 54572 50445 - 13538 9411 5280 1153 29798 25671 21540 17413 - 42971 47098 34713 38840 59231 63358 50973 55100 - 9939 14066 1681 5808 26199 30326 17941 22068 - 55628 51565 63758 59695 39368 35305 47498 43435 - 22596 18533 30726 26663 6336 2273 14466 10403 - 52093 56156 60223 64286 35833 39896 43963 48026 - 19061 23124 27191 31254 2801 6864 10931 14994 - 64814 60687 56684 52557 48554 44427 40424 36297 - 31782 27655 23652 19525 15522 11395 7392 3265 - 61215 65342 53085 57212 44955 49082 36825 40952 - 28183 32310 20053 24180 11923 16050 3793 7920]) - -(defun binhex-update-crc (crc char &optional count) - (if (null count) (setq count 1)) - (while (> count 0) - (setq crc (logxor (logand (lsh crc 8) 65280) - (aref binhex-crc-table - (logxor (logand (lsh crc -8) 255) - char))) - count (1- count))) - crc) - -(defun binhex-verify-crc (buffer start end) - (with-current-buffer buffer - (let ((pos start) (crc 0) (last (- end 2))) - (while (< pos last) - (setq crc (binhex-update-crc crc (char-after pos)) - pos (1+ pos))) - (if (= crc (binhex-string-big-endian (buffer-substring last end))) - nil - (error "CRC error"))))) - -(defun binhex-string-big-endian (string) - (let ((ret 0) (i 0) (len (length string))) - (while (< i len) - (setq ret (+ (lsh ret 8) (binhex-char-int (aref string i))) - i (1+ i))) - ret)) - -(defun binhex-string-little-endian (string) - (let ((ret 0) (i 0) (shift 0) (len (length string))) - (while (< i len) - (setq ret (+ ret (lsh (binhex-char-int (aref string i)) shift)) - i (1+ i) - shift (+ shift 8))) - ret)) - -(defun binhex-header (buffer) - (with-current-buffer buffer - (let ((pos (point-min)) len) - (vector - (prog1 - (setq len (binhex-char-int (char-after pos))) - (setq pos (1+ pos))) - (buffer-substring pos (setq pos (+ pos len))) - (prog1 - (setq len (binhex-char-int (char-after pos))) - (setq pos (1+ pos))) - (buffer-substring pos (setq pos (+ pos 4))) - (buffer-substring pos (setq pos (+ pos 4))) - (binhex-string-big-endian - (buffer-substring pos (setq pos (+ pos 2)))) - (binhex-string-big-endian - (buffer-substring pos (setq pos (+ pos 4)))) - (binhex-string-big-endian - (buffer-substring pos (setq pos (+ pos 4)))))))) - -(defvar binhex-last-char) -(defvar binhex-repeat) - -(defun binhex-push-char (char &optional count ignored buffer) - (cond - (binhex-repeat - (if (eq char 0) - (binhex-insert-char (setq binhex-last-char 144) 1 - ignored buffer) - (binhex-insert-char binhex-last-char (- char 1) - ignored buffer) - (setq binhex-last-char nil)) - (setq binhex-repeat nil)) - ((= char 144) - (setq binhex-repeat t)) - (t - (binhex-insert-char (setq binhex-last-char char) 1 ignored buffer)))) - -;;;###autoload -(defun binhex-decode-region-internal (start end &optional header-only) - "Binhex decode region between START and END without using an external program. -If HEADER-ONLY is non-nil only decode header and return filename." - (interactive "r") - (let ((work-buffer nil) - (counter 0) - (bits 0) (tmp t) - (lim 0) inputpos - (non-data-chars " \t\n\r:") - file-name-length data-fork-start - header - binhex-last-char binhex-repeat) - (unwind-protect - (save-excursion - (goto-char start) - (when (re-search-forward binhex-begin-line end t) - (let (default-enable-multibyte-characters) - (setq work-buffer (generate-new-buffer " *binhex-work*"))) - (beginning-of-line) - (setq bits 0 counter 0) - (while tmp - (skip-chars-forward non-data-chars end) - (setq inputpos (point)) - (end-of-line) - (setq lim (point)) - (while (and (< inputpos lim) - (setq tmp (binhex-char-map (char-after inputpos)))) - (setq bits (+ bits tmp) - counter (1+ counter) - inputpos (1+ inputpos)) - (cond ((= counter 4) - (binhex-push-char (lsh bits -16) 1 nil work-buffer) - (binhex-push-char (logand (lsh bits -8) 255) 1 nil - work-buffer) - (binhex-push-char (logand bits 255) 1 nil - work-buffer) - (setq bits 0 counter 0)) - (t (setq bits (lsh bits 6))))) - (if (null file-name-length) - (with-current-buffer work-buffer - (setq file-name-length (char-after (point-min)) - data-fork-start (+ (point-min) - file-name-length 22)))) - (if (and (null header) - (with-current-buffer work-buffer - (>= (buffer-size) data-fork-start))) - (progn - (binhex-verify-crc work-buffer - (point-min) data-fork-start) - (setq header (binhex-header work-buffer)) - (if header-only (setq tmp nil counter 0)))) - (setq tmp (and tmp (not (eq inputpos end))))) - (cond - ((= counter 3) - (binhex-push-char (logand (lsh bits -16) 255) 1 nil - work-buffer) - (binhex-push-char (logand (lsh bits -8) 255) 1 nil - work-buffer)) - ((= counter 2) - (binhex-push-char (logand (lsh bits -10) 255) 1 nil - work-buffer)))) - (if header-only nil - (binhex-verify-crc work-buffer - data-fork-start - (+ data-fork-start (aref header 6) 2)) - (or (markerp end) (setq end (set-marker (make-marker) end))) - (goto-char start) - (insert-buffer-substring work-buffer - data-fork-start (+ data-fork-start - (aref header 6))) - (delete-region (point) end))) - (and work-buffer (kill-buffer work-buffer))) - (if header (aref header 1)))) - -;;;###autoload -(defun binhex-decode-region-external (start end) - "Binhex decode region between START and END using external decoder." - (interactive "r") - (let ((cbuf (current-buffer)) firstline work-buffer status - (file-name (expand-file-name - (concat (binhex-decode-region-internal start end t) - ".data") - binhex-temporary-file-directory))) - (save-excursion - (goto-char start) - (when (re-search-forward binhex-begin-line nil t) - (let ((cdir default-directory) default-process-coding-system) - (unwind-protect - (progn - (set-buffer (setq work-buffer - (generate-new-buffer " *binhex-work*"))) - (buffer-disable-undo work-buffer) - (insert-buffer-substring cbuf firstline end) - (cd binhex-temporary-file-directory) - (apply 'call-process-region - (point-min) - (point-max) - binhex-decoder-program - nil - nil - nil - binhex-decoder-switches)) - (cd cdir) (set-buffer cbuf))) - (if (and file-name (file-exists-p file-name)) - (progn - (goto-char start) - (delete-region start end) - (let (format-alist) - (insert-file-contents-literally file-name))) - (error "Can not binhex"))) - (and work-buffer (kill-buffer work-buffer)) - (ignore-errors - (if file-name (delete-file file-name)))))) - -;;;###autoload -(defun binhex-decode-region (start end) - "Binhex decode region between START and END." - (interactive "r") - (if binhex-use-external - (binhex-decode-region-external start end) - (binhex-decode-region-internal start end))) - -(provide 'binhex) - -;;; arch-tag: 8476badd-1e76-4f1d-a640-f9a38c72eed8 -;;; binhex.el ends here diff --git a/xemacs-packages/gnus/lisp/canlock.el b/xemacs-packages/gnus/lisp/canlock.el deleted file mode 100644 index fec12723..00000000 --- a/xemacs-packages/gnus/lisp/canlock.el +++ /dev/null @@ -1,251 +0,0 @@ -;;; canlock.el --- functions for Cancel-Lock feature - -;; Copyright (C) 1998, 1999, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Katsumi Yamaoka -;; Keywords: news, cancel-lock, hmac, sha1, rfc2104 - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; Canlock is a library for generating and verifying Cancel-Lock and/or -;; Cancel-Key header in news articles. This is used to protect articles -;; from rogue cancel, supersede or replace attacks. The method is based -;; on draft-ietf-usefor-cancel-lock-01.txt which was released on November -;; 3rd 1998. For instance, you can add Cancel-Lock (and possibly Cancel- -;; Key) header in a news article by using a hook which will be evaluated -;; just before sending an article as follows: -;; -;; (add-hook '*e**a*e-header-hook 'canlock-insert-header t) -;; -;; Verifying Cancel-Lock is mainly a function of news servers, however, -;; you can verify your own article using the command `canlock-verify' in -;; the (raw) article buffer. You will be prompted for the password for -;; each time if the option `canlock-password' or `canlock-password-for- -;; verify' is nil. Note that setting these options is a bit unsafe. - -;;; Code: - -(eval-when-compile - (require 'cl)) - -(require 'sha1) - -(defvar mail-header-separator) - -(defgroup canlock nil - "The Cancel-Lock feature." - :group 'news) - -(defcustom canlock-password nil - "Password to use when signing a Cancel-Lock or a Cancel-Key header." - :type '(radio (const :format "Not specified " nil) - (string :tag "Password")) - :group 'canlock) - -(defcustom canlock-password-for-verify canlock-password - "Password to use when verifying a Cancel-Lock or a Cancel-Key header." - :type '(radio (const :format "Not specified " nil) - (string :tag "Password")) - :group 'canlock) - -(defcustom canlock-force-insert-header nil - "If non-nil, insert a Cancel-Lock or a Cancel-Key header even if the -buffer does not look like a news message." - :type 'boolean - :group 'canlock) - -(eval-when-compile - (defmacro canlock-string-as-unibyte (string) - "Return a unibyte string with the same individual bytes as STRING." - (if (fboundp 'string-as-unibyte) - (list 'string-as-unibyte string) - string))) - -(defun canlock-sha1 (message) - "Make a SHA-1 digest of MESSAGE as a unibyte string of length 20 bytes." - (let (sha1-maximum-internal-length) - (sha1 message nil nil 'binary))) - -(defun canlock-make-cancel-key (message-id password) - "Make a Cancel-Key header." - (when (> (length password) 20) - (setq password (canlock-sha1 password))) - (setq password (concat password (make-string (- 64 (length password)) 0))) - (let ((ipad (mapconcat (lambda (byte) - (char-to-string (logxor 54 byte))) - password "")) - (opad (mapconcat (lambda (byte) - (char-to-string (logxor 92 byte))) - password ""))) - (base64-encode-string - (canlock-sha1 - (concat opad - (canlock-sha1 - (concat ipad (canlock-string-as-unibyte message-id)))))))) - -(defun canlock-narrow-to-header () - "Narrow the buffer to the head of the message." - (let (case-fold-search) - (narrow-to-region - (goto-char (point-min)) - (goto-char (if (re-search-forward - (format "^$\\|^%s$" - (regexp-quote mail-header-separator)) - nil t) - (match-beginning 0) - (point-max)))))) - -(defun canlock-delete-headers () - "Delete Cancel-Key or Cancel-Lock headers in the narrowed buffer." - (let ((case-fold-search t)) - (goto-char (point-min)) - (while (re-search-forward "^Cancel-\\(Key\\|Lock\\):" nil t) - (delete-region (match-beginning 0) - (if (re-search-forward "^[^\t ]" nil t) - (goto-char (match-beginning 0)) - (point-max)))))) - -(defun canlock-fetch-fields (&optional key) - "Return a list of the values of Cancel-Lock header. -If KEY is non-nil, look for a Cancel-Key header instead. The buffer -is expected to be narrowed to just the headers of the message." - (let ((field (mail-fetch-field (if key "Cancel-Key" "Cancel-Lock"))) - fields rest - (case-fold-search t)) - (when field - (setq fields (split-string field "[\t\n\r ,]+")) - (while fields - (when (string-match "^sha1:" (setq field (pop fields))) - (push (substring field 5) rest))) - (nreverse rest)))) - -(defun canlock-fetch-id-for-key () - "Return a Message-ID in Cancel, Supersedes or Replaces header. -The buffer is expected to be narrowed to just the headers of the -message." - (or (let ((cancel (mail-fetch-field "Control"))) - (and cancel - (string-match "^cancel[\t ]+\\(<[^\t\n @<>]+@[^\t\n @<>]+>\\)" - cancel) - (match-string 1 cancel))) - (mail-fetch-field "Supersedes") - (mail-fetch-field "Replaces"))) - -;;;###autoload -(defun canlock-insert-header (&optional id-for-key id-for-lock password) - "Insert a Cancel-Key and/or a Cancel-Lock header if possible." - (let (news control key-for-key key-for-lock) - (save-excursion - (save-restriction - (canlock-narrow-to-header) - (when (setq news (or canlock-force-insert-header - (mail-fetch-field "Newsgroups"))) - (unless id-for-key - (setq id-for-key (canlock-fetch-id-for-key))) - (if (and (setq control (mail-fetch-field "Control")) - (string-match "^cancel[\t ]+<[^\t\n @<>]+@[^\t\n @<>]+>" - control)) - (setq id-for-lock nil) - (unless id-for-lock - (setq id-for-lock (mail-fetch-field "Message-ID")))) - (canlock-delete-headers) - (goto-char (point-max)))) - (when news - (if (not (or id-for-key id-for-lock)) - (message "There are no Message-ID(s)") - (unless password - (setq password (or canlock-password - (read-passwd - "Password for Canlock: ")))) - (if (or (not (stringp password)) (zerop (length password))) - (message "Password for Canlock is bad") - (setq key-for-key (when id-for-key - (canlock-make-cancel-key - id-for-key password)) - key-for-lock (when id-for-lock - (canlock-make-cancel-key - id-for-lock password))) - (if (not (or key-for-key key-for-lock)) - (message "Couldn't insert Canlock header") - (when key-for-key - (insert "Cancel-Key: sha1:" key-for-key "\n")) - (when key-for-lock - (insert "Cancel-Lock: sha1:" - (base64-encode-string (canlock-sha1 key-for-lock)) - "\n"))))))))) - -;;;###autoload -(defun canlock-verify (&optional buffer) - "Verify Cancel-Lock or Cancel-Key in BUFFER. -If BUFFER is nil, the current buffer is assumed. Signal an error if -it fails." - (interactive) - (let (keys locks errmsg id-for-key id-for-lock password - key-for-key key-for-lock match) - (save-excursion - (when buffer - (set-buffer buffer)) - (save-restriction - (widen) - (canlock-narrow-to-header) - (setq keys (canlock-fetch-fields 'key) - locks (canlock-fetch-fields)) - (if (not (or keys locks)) - (setq errmsg - "There are neither Cancel-Lock nor Cancel-Key headers") - (setq id-for-key (canlock-fetch-id-for-key) - id-for-lock (mail-fetch-field "Message-ID")) - (or id-for-key id-for-lock - (setq errmsg "There are no Message-ID(s)"))))) - (if errmsg - (error "%s" errmsg) - (setq password (or canlock-password-for-verify - (read-passwd "Password for Canlock: "))) - (if (or (not (stringp password)) (zerop (length password))) - (error "Password for Canlock is bad") - (when keys - (when id-for-key - (setq key-for-key (canlock-make-cancel-key id-for-key password)) - (while (and keys (not match)) - (setq match (string-equal key-for-key (pop keys))))) - (setq keys (if match "good" "bad"))) - (setq match nil) - (when locks - (when id-for-lock - (setq key-for-lock - (base64-encode-string - (canlock-sha1 (canlock-make-cancel-key id-for-lock - password)))) - (when (and locks (not match)) - (setq match (string-equal key-for-lock (pop locks))))) - (setq locks (if match "good" "bad"))) - (prog1 - (when (member "bad" (list keys locks)) - "bad") - (cond ((and keys locks) - (message "Cancel-Key is %s, Cancel-Lock is %s" keys locks)) - (locks - (message "Cancel-Lock is %s" locks)) - (keys - (message "Cancel-Key is %s" keys)))))))) - -(provide 'canlock) - -;;; arch-tag: 033c4f09-b9f1-459d-bd0d-254430283f78 -;;; canlock.el ends here diff --git a/xemacs-packages/gnus/lisp/compface.el b/xemacs-packages/gnus/lisp/compface.el deleted file mode 100644 index 2f81ab02..00000000 --- a/xemacs-packages/gnus/lisp/compface.el +++ /dev/null @@ -1,63 +0,0 @@ -;;; compface.el --- functions for converting X-Face headers - -;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -;;;### -(defun uncompface (face) - "Convert FACE to pbm. -Requires the external programs `uncompface', and `icontopbm'. On a -GNU/Linux system these might be in packages with names like `compface' -or `faces-xface' and `netpbm' or `libgr-progs', for instance." - (with-temp-buffer - (insert face) - (let ((coding-system-for-read 'raw-text) - ;; At least "icontopbm" doesn't work with Windows because - ;; the line-break code is converted into CRLF by default. - (coding-system-for-write 'binary)) - (and (eq 0 (apply 'call-process-region (point-min) (point-max) - "uncompface" - 'delete '(t nil) nil)) - (progn - (goto-char (point-min)) - (insert "/* Width=48, Height=48 */\n") - ;; I just can't get "icontopbm" to work correctly on its - ;; own in XEmacs. And Emacs doesn't understand un-raw pbm - ;; files. - (if (not (featurep 'xemacs)) - (eq 0 (call-process-region (point-min) (point-max) - "icontopbm" - 'delete '(t nil))) - (shell-command-on-region (point-min) (point-max) - "icontopbm | pnmnoraw" - (current-buffer) t) - t)) - (buffer-string))))) - -(provide 'compface) - -;;; arch-tag: f9c78e84-98c0-4142-9682-8ba4cf4c3441 -;;; compface.el ends here diff --git a/xemacs-packages/gnus/lisp/deuglify.el b/xemacs-packages/gnus/lisp/deuglify.el deleted file mode 100644 index 75880c8f..00000000 --- a/xemacs-packages/gnus/lisp/deuglify.el +++ /dev/null @@ -1,480 +0,0 @@ -;;; deuglify.el --- deuglify broken Outlook (Express) articles - -;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 -;; Free Software Foundation, Inc. - -;; Author: Raymond Scholz -;; Thomas Steffen (unwrapping algorithm, -;; based on an idea of Stefan Monnier) -;; Keywords: mail, news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; This file enables Gnus to repair broken citations produced by -;; common user agents like MS Outlook (Express). It may repair -;; articles of other user agents too. -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; -;; Outlook sometimes wraps cited lines before sending a message as -;; seen in this example: -;; -;; Example #1 -;; ---------- -;; -;; John Doe wrote: -;; -;; > This sentence no verb. This sentence no verb. This sentence -;; no -;; > verb. This sentence no verb. This sentence no verb. This -;; > sentence no verb. -;; -;; The function `gnus-article-outlook-unwrap-lines' tries to recognize those -;; erroneously wrapped lines and will unwrap them. I.e. putting the -;; wrapped parts ("no" in this example) back where they belong (at the -;; end of the cited line above). -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Note that some people not only use broken user agents but also -;; practice a bad citation style by omitting blank lines between the -;; cited text and their own text. -;: -;; Example #2 -;; ---------- -;; -;; John Doe wrote: -;; -;; > This sentence no verb. This sentence no verb. This sentence no -;; You forgot in all your sentences. -;; > verb. This sentence no verb. This sentence no verb. This -;; > sentence no verb. -;; -;; Unwrapping "You forgot in all your sentences." would be invalid as -;; this part wasn't intended to be cited text. -;; `gnus-article-outlook-unwrap-lines' will only unwrap lines if the resulting -;; citation line will be of a certain maximum length. You can control -;; this by adjusting `gnus-outlook-deuglify-unwrap-max'. Also -;; unwrapping will only be done if the line above the (possibly) -;; wrapped line has a minimum length of `gnus-outlook-deuglify-unwrap-min'. -;; -;; Furthermore no unwrapping will be undertaken if the last character -;; is one of the chars specified in -;; `gnus-outlook-deuglify-unwrap-stop-chars'. Setting this to ".?!" -;; inhibits unwrapping if the cited line ends with a full stop, -;; question mark or exclamation mark. Note that this variable -;; defaults to `nil', triggering a few false positives but generally -;; giving you better results. -;; -;; Unwrapping works on every level of citation. Thus you will be able -;; repair broken citations of broken user agents citing broken -;; citations of broken user agents citing broken citations... -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Citations are commonly introduced with an attribution line -;; indicating who wrote the cited text. Outlook adds superfluous -;; information that can be found in the header of the message to this -;; line and often wraps it. -;; -;; If that weren't enough, lots of people write their own text above -;; the cited text and cite the complete original article below. -;; -;; Example #3 -;; ---------- -;; -;; Hey, John. There's no in all your sentences! -;; -;; John Doe wrote in message -;; news:a87usw8$dklsssa$2@some.news.server... -;; > This sentence no verb. This sentence no verb. This sentence -;; no -;; > verb. This sentence no verb. This sentence no verb. This -;; > sentence no verb. -;; > -;; > Bye, John -;; -;; Repairing the attribution line will be done by function -;; `gnus-article-outlook-repair-attribution which calls other function that -;; try to recognize and repair broken attribution lines. See variable -;; `gnus-outlook-deuglify-attrib-cut-regexp' for stuff that should be -;; cut off from the beginning of an attribution line and variable -;; `gnus-outlook-deuglify-attrib-verb-regexp' for the verbs that are -;; required to be found in an attribution line. These function return -;; the point where the repaired attribution line starts. -;; -;; Rearranging the article so that the cited text appears above the -;; new text will be done by function -;; `gnus-article-outlook-rearrange-citation'. This function calls -;; `gnus-article-outlook-repair-attribution to find and repair an attribution -;; line. -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Well, and that's what the message will look like after applying -;; deuglification: -;; -;; Example #3 (deuglified) -;; ----------------------- -;; -;; John Doe wrote: -;; -;; > This sentence no verb. This sentence no verb. This sentence no -;; > verb. This sentence no verb. This sentence no verb. This -;; > sentence no verb. -;; > -;; > Bye, John -;; -;; Hey, John. There's no in all your sentences! -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Usage -;; ----- -;; -;; Press `W k' in the Summary Buffer. -;; -;; Non recommended usage :-) -;; --------------------- -;; -;; To automatically invoke deuglification on every article you read, -;; put something like that in your .gnus: -;; -;; (add-hook 'gnus-article-decode-hook 'gnus-article-outlook-unwrap-lines) -;; -;; or _one_ of the following lines: -;; -;; ;; repair broken attribution lines -;; (add-hook 'gnus-article-decode-hook 'gnus-article-outlook-repair-attribution) -;; -;; ;; repair broken attribution lines and citations -;; (add-hook 'gnus-article-decode-hook 'gnus-article-outlook-rearrange-citation) -;; -;; Note that there always may be some false positives, so I suggest -;; using the manual invocation. After deuglification you may want to -;; refill the whole article using `W w'. -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Limitations -;; ----------- -;; -;; As I said before there may (or will) be a few false positives on -;; unwrapping cited lines with `gnus-article-outlook-unwrap-lines'. -;; -;; `gnus-article-outlook-repair-attribution will only fix the first -;; attribution line found in the article. Furthermore it fixed to -;; certain kinds of attributions. And there may be horribly many -;; false positives, vanishing lines and so on -- so don't trust your -;; eyes. Again I recommend manual invocation. -;; -;; `gnus-article-outlook-rearrange-citation' carries all the limitations of -;; `gnus-article-outlook-repair-attribution. -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; See ChangeLog for other changes. -;; -;; Revision 1.5 2002/01/27 14:39:17 rscholz -;; * New variable `gnus-outlook-deuglify-no-wrap-chars' to inhibit -;; unwrapping if one these chars is first in the possibly wrapped line. -;; * Improved rearranging of the article. -;; * New function `gnus-outlook-repair-attribution-block' for repairing -;; those big "Original Message (following some headers)" attributions. -;; -;; Revision 1.4 2002/01/03 14:05:00 rscholz -;; Renamed `gnus-outlook-deuglify-article' to -;; `gnus-article-outlook-deuglify-article'. -;; Made it easier to deuglify the article while being in Gnus' Article -;; Edit Mode. (suggested by Phil Nitschke) -;; -;; -;; Revision 1.3 2002/01/02 23:35:54 rscholz -;; Fix a bug that caused succeeding long attribution lines to be -;; unwrapped. Minor doc fixes and regular expression tuning. -;; -;; Revision 1.2 2001/12/30 20:14:34 rscholz -;; Clean up source. -;; -;; Revision 1.1 2001/12/30 20:13:32 rscholz -;; Initial revision -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; Code: - -(require 'gnus-art) -(require 'gnus-sum) - -(defconst gnus-outlook-deuglify-version "1.5 Gnus version" - "Version of gnus-outlook-deuglify.") - -;;; User Customizable Variables: - -(defgroup gnus-outlook-deuglify nil - "Deuglify articles generated by broken user agents like MS Outlook (Express)." - :version "22.1" - :group 'gnus) - -(defcustom gnus-outlook-deuglify-unwrap-min 45 - "Minimum length of the cited line above the (possibly) wrapped line." - :version "22.1" - :type 'integer - :group 'gnus-outlook-deuglify) - -(defcustom gnus-outlook-deuglify-unwrap-max 95 - "Maximum length of the cited line after unwrapping." - :version "22.1" - :type 'integer - :group 'gnus-outlook-deuglify) - -(defcustom gnus-outlook-deuglify-cite-marks ">|#%" - "Characters that indicate cited lines." - :version "22.1" - :type 'string - :group 'gnus-outlook-deuglify) - -(defcustom gnus-outlook-deuglify-unwrap-stop-chars nil ;; ".?!" or nil - "Characters that inhibit unwrapping if they are the last one on the cited line above the possible wrapped line." - :version "22.1" - :type '(radio (const :format "None " nil) - (string :value ".?!")) - :group 'gnus-outlook-deuglify) - -(defcustom gnus-outlook-deuglify-no-wrap-chars "`" - "Characters that inhibit unwrapping if they are the first one in the possibly wrapped line." - :version "22.1" - :type 'string - :group 'gnus-outlook-deuglify) - -(defcustom gnus-outlook-deuglify-attrib-cut-regexp - "\\(On \\|Am \\)?\\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\),[^,]+, " - "Regular expression matching the beginning of an attribution line that should be cut off." - :version "22.1" - :type 'string - :group 'gnus-outlook-deuglify) - -(defcustom gnus-outlook-deuglify-attrib-verb-regexp - "wrote\\|writes\\|says\\|schrieb\\|schreibt\\|meinte\\|skrev\\|a écrit\\|schreef\\|escribió" - "Regular expression matching the verb used in an attribution line." - :version "22.1" - :type 'string - :group 'gnus-outlook-deuglify) - -(defcustom gnus-outlook-deuglify-attrib-end-regexp - ": *\\|\\.\\.\\." - "Regular expression matching the end of an attribution line." - :version "22.1" - :type 'string - :group 'gnus-outlook-deuglify) - -(defcustom gnus-outlook-display-hook nil - "A hook called after an deuglified article has been prepared. -It is run after `gnus-article-prepare-hook'." - :version "22.1" - :type 'hook - :group 'gnus-outlook-deuglify) - -;; Functions - -(defun gnus-outlook-display-article-buffer () - "Redisplay current buffer or article buffer." - (with-current-buffer (or gnus-article-buffer (current-buffer)) - ;; "Emulate" `gnus-article-prepare-display' without calling - ;; it. Calling `gnus-article-prepare-display' on an already - ;; prepared article removes all MIME parts. I'm unsure whether - ;; this is a bug or not. - (gnus-article-highlight t) - (gnus-treat-article nil) - (gnus-run-hooks 'gnus-article-prepare-hook - 'gnus-outlook-display-hook))) - -;;;###autoload -(defun gnus-article-outlook-unwrap-lines (&optional nodisplay) - "Unwrap lines that appear to be wrapped citation lines. -You can control what lines will be unwrapped by frobbing -`gnus-outlook-deuglify-unwrap-min' and `gnus-outlook-deuglify-unwrap-max', -indicating the minimum and maximum length of an unwrapped citation line. If -NODISPLAY is non-nil, don't redisplay the article buffer." - (interactive "P") - (save-excursion - (let ((case-fold-search nil) - (inhibit-read-only t) - (cite-marks gnus-outlook-deuglify-cite-marks) - (no-wrap gnus-outlook-deuglify-no-wrap-chars) - (stop-chars gnus-outlook-deuglify-unwrap-stop-chars)) - (gnus-with-article-buffer - (article-goto-body) - (while (re-search-forward - (concat - "^\\([ \t" cite-marks "]*\\)" - "\\([" cite-marks "].*[^\n " stop-chars "]\\)[ \t]?\n" - "\\1\\([^\n " cite-marks no-wrap "]+.*\\)$") - nil t) - (let ((len12 (- (match-end 2) (match-beginning 1))) - (len3 (- (match-end 3) (match-beginning 3)))) - (if (and (> len12 gnus-outlook-deuglify-unwrap-min) - (< (+ len12 len3) gnus-outlook-deuglify-unwrap-max)) - (progn - (replace-match "\\1\\2 \\3") - (goto-char (match-beginning 0))))))))) - (unless nodisplay (gnus-outlook-display-article-buffer))) - -(defun gnus-outlook-rearrange-article (attr-start) - "Put the text from ATTR-START to the end of buffer at the top of the article buffer." - (save-excursion - (let ((inhibit-read-only t) - (cite-marks gnus-outlook-deuglify-cite-marks)) - (gnus-with-article-buffer - (article-goto-body) - ;; article does not start with attribution - (unless (= (point) attr-start) - (gnus-kill-all-overlays) - (let ((cur (point)) - ;; before signature or end of buffer - (to (if (gnus-article-search-signature) - (point) - (point-max)))) - ;; handle the case where the full quote is below the - ;; signature - (if (< to attr-start) - (setq to (point-max))) - (transpose-regions cur attr-start attr-start to))))))) - -;; John Doe wrote in message -;; news:a87usw8$dklsssa$2@some.news.server... - -(defun gnus-outlook-repair-attribution-outlook () - "Repair a broken attribution line (Outlook)." - (save-excursion - (let ((case-fold-search nil) - (inhibit-read-only t) - (cite-marks gnus-outlook-deuglify-cite-marks)) - (gnus-with-article-buffer - (article-goto-body) - (if (re-search-forward - (concat "^\\([^" cite-marks "].+\\)" - "\\(" gnus-outlook-deuglify-attrib-verb-regexp "\\)" - "\\(.*\n?[^\n" cite-marks "].*\\)?" - "\\(" gnus-outlook-deuglify-attrib-end-regexp "\\)$") - nil t) - (progn - (gnus-kill-all-overlays) - (replace-match "\\1\\2\\4") - (match-beginning 0))))))) - - -;; ----- Original Message ----- -;; From: "John Doe" -;; To: "Doe Foundation" -;; Sent: Monday, November 19, 2001 12:13 PM -;; Subject: More Doenuts - -(defun gnus-outlook-repair-attribution-block () - "Repair a big broken attribution block." - (save-excursion - (let ((case-fold-search nil) - (inhibit-read-only t) - (cite-marks gnus-outlook-deuglify-cite-marks)) - (gnus-with-article-buffer - (article-goto-body) - (if (re-search-forward - (concat "^[" cite-marks " \t]*--* ?[^-]+ [^-]+ ?--*\\s *\n" - "[^\n:]+:[ \t]*\\([^\n]+\\)\n" - "\\([^\n:]+:[ \t]*[^\n]+\n\\)+") - nil t) - (progn - (gnus-kill-all-overlays) - (replace-match "\\1 wrote:\n") - (match-beginning 0))))))) - -;; On Wed, 16 Jan 2002 23:23:30 +0100, John Doe wrote: - -(defun gnus-outlook-repair-attribution-other () - "Repair a broken attribution line (other user agents than Outlook)." - (save-excursion - (let ((case-fold-search nil) - (inhibit-read-only t) - (cite-marks gnus-outlook-deuglify-cite-marks)) - (gnus-with-article-buffer - (article-goto-body) - (if (re-search-forward - (concat "^\\("gnus-outlook-deuglify-attrib-cut-regexp"\\)?" - "\\([^" cite-marks "].+\\)\n\\([^\n" cite-marks "].*\\)?" - "\\(" gnus-outlook-deuglify-attrib-verb-regexp "\\).*" - "\\(" gnus-outlook-deuglify-attrib-end-regexp "\\)$") - nil t) - (progn - (gnus-kill-all-overlays) - (replace-match "\\4 \\5\\6\\7") - (match-beginning 0))))))) - -;;;###autoload -(defun gnus-article-outlook-repair-attribution (&optional nodisplay) - "Repair a broken attribution line. -If NODISPLAY is non-nil, don't redisplay the article buffer." - (interactive "P") - (let ((attrib-start - (or - (gnus-outlook-repair-attribution-other) - (gnus-outlook-repair-attribution-block) - (gnus-outlook-repair-attribution-outlook)))) - (unless nodisplay (gnus-outlook-display-article-buffer)) - attrib-start)) - -(defun gnus-article-outlook-rearrange-citation (&optional nodisplay) - "Repair broken citations. -If NODISPLAY is non-nil, don't redisplay the article buffer." - (interactive "P") - (let ((attrib-start (gnus-article-outlook-repair-attribution 'nodisplay))) - ;; rearrange citations if an attribution line has been recognized - (if attrib-start - (gnus-outlook-rearrange-article attrib-start))) - (unless nodisplay (gnus-outlook-display-article-buffer))) - -;;;###autoload -(defun gnus-outlook-deuglify-article (&optional nodisplay) - "Full deuglify of broken Outlook (Express) articles. -Treat dumbquotes, unwrap lines, repair attribution and rearrange citation. If -NODISPLAY is non-nil, don't redisplay the article buffer." - (interactive "P") - ;; apply treatment of dumb quotes - (gnus-article-treat-dumbquotes) - ;; repair wrapped cited lines - (gnus-article-outlook-unwrap-lines 'nodisplay) - ;; repair attribution line and rearrange citation. - (gnus-article-outlook-rearrange-citation 'nodisplay) - (unless nodisplay (gnus-outlook-display-article-buffer))) - -;;;###autoload -(defun gnus-article-outlook-deuglify-article () - "Deuglify broken Outlook (Express) articles and redisplay." - (interactive) - (gnus-outlook-deuglify-article nil)) - -(provide 'deuglify) - -;; Local Variables: -;; coding: iso-8859-1 -;; End: - -;;; arch-tag: 5f895cc9-51a9-487c-b42e-28844d79eb73 -;;; deuglify.el ends here diff --git a/xemacs-packages/gnus/lisp/dgnushack-xemacs.el b/xemacs-packages/gnus/lisp/dgnushack-xemacs.el deleted file mode 100644 index 09c63fb7..00000000 --- a/xemacs-packages/gnus/lisp/dgnushack-xemacs.el +++ /dev/null @@ -1,68 +0,0 @@ -;;; dgnushack-xemacs.el --- a version of dgnushack.el for XEmacs package -(defalias 'facep 'ignore) - -(defalias 'device-sound-enabled-p 'ignore) -(defalias 'play-sound-file 'ignore) -(defalias 'nndb-request-article 'ignore) -(defalias 'efs-re-read-dir 'ignore) -(defalias 'ange-ftp-re-read-dir 'ignore) -(defalias 'define-mail-user-agent 'ignore) - - -(eval-and-compile - (when (featurep 'xemacs) - ;; XEmacs 21.1 needs some extra hand holding - (when (eq emacs-minor-version 1) - (autoload 'custom-declare-face "cus-face" nil t) - (autoload 'cl-compile-time-init "cl-macs" nil t) - (autoload 'defadvice "advice" nil nil 'macro)) - (unless (fboundp 'defadvice) - (autoload 'defadvice "advice" nil nil 'macro)) - (autoload 'Info-directory "info" nil t) - (autoload 'Info-menu "info" nil t) - (autoload 'annotations-at "annotations") - (autoload 'apropos "apropos" nil t) - (autoload 'apropos-command "apropos" nil t) - (autoload 'bbdb-complete-name "bbdb-com" nil t) - (autoload 'browse-url "browse-url" nil t) - (autoload 'customize-apropos "cus-edit" nil t) - (autoload 'customize-save-variable "cus-edit" nil t) - (autoload 'customize-variable "cus-edit" nil t) - (autoload 'delete-annotation "annotations") - (autoload 'dolist "cl-macs" nil nil 'macro) - (autoload 'enriched-decode "enriched") - (autoload 'info "info" nil t) - (autoload 'make-annotation "annotations") - (autoload 'make-display-table "disp-table") - (autoload 'pp "pp") - (autoload 'ps-despool "ps-print" nil t) - (autoload 'ps-spool-buffer "ps-print" nil t) - (autoload 'ps-spool-buffer-with-faces "ps-print" nil t) - (autoload 'read-passwd "passwd") - (autoload 'regexp-opt "regexp-opt") - (autoload 'reporter-submit-bug-report "reporter") - (if (emacs-version>= 21 5) - (autoload 'setenv "process" nil t) - (autoload 'setenv "env" nil t)) - (autoload 'smtpmail-send-it "smtpmail") - (autoload 'sort-numeric-fields "sort" nil t) - (autoload 'sort-subr "sort") - (autoload 'trace-function-background "trace" nil t) - (autoload 'w3-do-setup "w3") - (autoload 'w3-prepare-buffer "w3-display") - (autoload 'w3-region "w3-display" nil t) - (defalias 'match-string-no-properties 'match-string) - (defalias 'frame-char-height 'frame-height) - (defalias 'frame-char-width 'frame-width) - (defalias 'frame-parameter 'frame-property) - (defalias 'make-overlay 'ignore) - (defalias 'overlay-end 'ignore) - (defalias 'overlay-get 'ignore) - (defalias 'overlay-put 'ignore) - (defalias 'overlay-start 'ignore) - (defalias 'overlays-in 'ignore) - (defalias 'replace-dehighlight 'ignore) - (defalias 'replace-highlight 'ignore) - (defalias 'w3-coding-system-for-mime-charset 'ignore))) - -;;; dgnushack-xemacs.el ends here diff --git a/xemacs-packages/gnus/lisp/dgnushack.el b/xemacs-packages/gnus/lisp/dgnushack.el deleted file mode 100644 index 11a0f741..00000000 --- a/xemacs-packages/gnus/lisp/dgnushack.el +++ /dev/null @@ -1,515 +0,0 @@ -;;; dgnushack.el --- a hack to set the load path for byte-compiling -;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003, -;; 2004, 2005, 2008 -;; Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Version: 4.19 -;; Keywords: news, path - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(defvar dgnushack-default-load-path (copy-sequence load-path)) - -(defalias 'facep 'ignore) - -(require 'cl) - -(defvar srcdir (or (getenv "srcdir") ".")) - -(defun my-getenv (str) - (let ((val (getenv str))) - (if (equal val "no") nil val))) - -(if (my-getenv "lispdir") - (push (my-getenv "lispdir") load-path)) - -(push (or (my-getenv "URLDIR") (expand-file-name "../../url/lisp/" srcdir)) - load-path) - -(push (or (my-getenv "W3DIR") (expand-file-name "../../w3/lisp/" srcdir)) - load-path) - -;(push "/usr/share/emacs/site-lisp" load-path) - -;; Define compiler macros for the functions provided by cl in old Emacsen. -(unless (featurep 'xemacs) - (define-compiler-macro butlast (&whole form x &optional n) - (if (>= emacs-major-version 21) - form - (if n - `(let ((x ,x) - (n ,n)) - (if (and n (<= n 0)) - x - (let ((m (length x))) - (or n (setq n 1)) - (and (< n m) - (progn - (if (> n 0) - (progn - (setq x (copy-sequence x)) - (setcdr (nthcdr (- (1- m) n) x) nil))) - x))))) - `(let* ((x ,x) - (m (length x))) - (and (< 1 m) - (progn - (setq x (copy-sequence x)) - (setcdr (nthcdr (- m 2) x) nil) - x)))))) - - (define-compiler-macro remove (&whole form item seq) - (if (>= emacs-major-version 21) - form - `(delete ,item (copy-sequence ,seq)))) - - (define-compiler-macro mapc (&whole form fn seq &rest rest) - (if (>= emacs-major-version 21) - form - (if rest - `(let* ((fn ,fn) - (seq ,seq) - (args (list seq ,@rest)) - (m (apply (function min) (mapcar (function length) args))) - (n 0)) - (while (< n m) - (apply fn (mapcar (function (lambda (arg) (nth n arg))) args)) - (setq n (1+ n))) - seq) - `(let ((seq ,seq)) - (mapcar ,fn seq) - seq))))) - -;; If we are building w3 in a different directory than the source -;; directory, we must read *.el from source directory and write *.elc -;; into the building directory. For that, we define this function -;; before loading bytecomp. Bytecomp doesn't overwrite this function. -(defun byte-compile-dest-file (filename) - "Convert an Emacs Lisp source file name to a compiled file name. - In addition, remove directory name part from FILENAME." - (setq filename (byte-compiler-base-file-name filename)) - (setq filename (file-name-sans-versions filename)) - (setq filename (file-name-nondirectory filename)) - (if (memq system-type '(win32 w32 mswindows windows-nt)) - (setq filename (downcase filename))) - (cond ((eq system-type 'vax-vms) - (concat (substring filename 0 (string-match ";" filename)) "c")) - ((string-match emacs-lisp-file-regexp filename) - (concat (substring filename 0 (match-beginning 0)) ".elc")) - (t (concat filename ".elc")))) - -(require 'bytecomp) -;; To avoid having defsubsts and inlines happen. -;(if (featurep 'xemacs) -; (require 'byte-optimize) -; (require 'byte-opt)) -;(defun byte-optimize-inline-handler (form) -; "byte-optimize-handler for the `inline' special-form." -; (cons 'progn (cdr form))) -;(defalias 'byte-compile-file-form-defsubst 'byte-compile-file-form-defun) - -(when (and (not (featurep 'xemacs)) - (= emacs-major-version 21) - (>= emacs-minor-version 3) - (condition-case code - (let ((byte-compile-error-on-warn t)) - (byte-optimize-form (quote (pop x)) t) - nil) - (error (string-match "called for effect" - (error-message-string code))))) - (defadvice byte-optimize-form-code-walker (around silence-warn-for-pop - (form for-effect) - activate) - "Silence the warning \"...called for effect\" for the `pop' form. -It is effective only when the `pop' macro is defined by cl.el rather -than subr.el." - (let (tmp) - (if (and (eq (car-safe form) 'car) - for-effect - (setq tmp (get 'car 'side-effect-free)) - (not byte-compile-delete-errors) - (not (eq tmp 'error-free)) - (eq (car-safe (cadr form)) 'prog1) - (let ((var (cadr (cadr form))) - (last (nth 2 (cadr form)))) - (and (symbolp var) - (null (nthcdr 3 (cadr form))) - (eq (car-safe last) 'setq) - (eq (cadr last) var) - (eq (car-safe (nth 2 last)) 'cdr) - (eq (cadr (nth 2 last)) var)))) - (progn - (put 'car 'side-effect-free 'error-free) - (unwind-protect - ad-do-it - (put 'car 'side-effect-free tmp))) - ad-do-it)))) - -(push srcdir load-path) -(load (expand-file-name "lpath.el" srcdir) nil t) - -(defalias 'device-sound-enabled-p 'ignore) -(defalias 'play-sound-file 'ignore) -(defalias 'nndb-request-article 'ignore) -(defalias 'efs-re-read-dir 'ignore) -(defalias 'ange-ftp-re-read-dir 'ignore) -(defalias 'define-mail-user-agent 'ignore) - -(eval-and-compile - (unless (featurep 'xemacs) - (defalias 'get-popup-menu-response 'ignore) - (defalias 'event-object 'ignore) - (defalias 'x-defined-colors 'ignore) - (defalias 'read-color 'ignore))) - -(eval-and-compile - (when (featurep 'xemacs) - ;; XEmacs 21.1 needs some extra hand holding - (when (eq emacs-minor-version 1) - (autoload 'custom-declare-face "cus-face" nil t) - (autoload 'cl-compile-time-init "cl-macs" nil t) - (autoload 'defadvice "advice" nil nil 'macro)) - (unless (fboundp 'defadvice) - (autoload 'defadvice "advice" nil nil 'macro)) - (autoload 'Info-directory "info" nil t) - (autoload 'Info-menu "info" nil t) - (autoload 'ad-add-advice "advice") - (autoload 'annotations-at "annotations") - (autoload 'apropos "apropos" nil t) - (autoload 'apropos-command "apropos" nil t) - (autoload 'bbdb-complete-name "bbdb-com" nil t) - (autoload 'browse-url "browse-url" nil t) - (autoload 'customize-apropos "cus-edit" nil t) - (autoload 'customize-group "cus-edit" nil t) - (autoload 'customize-save-variable "cus-edit" nil t) - (autoload 'customize-variable "cus-edit" nil t) - (if (featurep 'mule) - (unless (locate-library "mule-ccl") - (autoload 'define-ccl-program "ccl" nil nil 'macro)) - (defalias 'define-ccl-program 'ignore)) - (autoload 'delete-annotation "annotations") - (autoload 'dolist "cl-macs" nil nil 'macro) - (autoload 'enriched-decode "enriched") - (autoload 'info "info" nil t) - (autoload 'mail-extract-address-components "mail-extr") - (autoload 'mail-fetch-field "mail-utils") - (autoload 'make-annotation "annotations") - (autoload 'make-display-table "disp-table") - (autoload 'pp "pp") - (autoload 'ps-despool "ps-print" nil t) - (autoload 'ps-spool-buffer "ps-print" nil t) - (autoload 'ps-spool-buffer-with-faces "ps-print" nil t) - (autoload 'read-passwd "passwd") - (autoload 'regexp-opt "regexp-opt") - (autoload 'reporter-submit-bug-report "reporter") - (if (emacs-version>= 21 5) - (autoload 'setenv "process" nil t) - (autoload 'setenv "env" nil t)) - (autoload 'sgml-mode "psgml" nil t) - (autoload 'smtpmail-send-it "smtpmail") - (autoload 'sort-numeric-fields "sort" nil t) - (autoload 'sort-subr "sort") - (autoload 'trace-function-background "trace" nil t) - (autoload 'w3-do-setup "w3") - (autoload 'w3-prepare-buffer "w3-display") - (autoload 'w3-region "w3-display" nil t) - (defalias 'frame-char-height 'frame-height) - (defalias 'frame-char-width 'frame-width) - (defalias 'frame-parameter 'frame-property) - (defalias 'make-overlay 'ignore) - (defalias 'overlay-end 'ignore) - (defalias 'overlay-get 'ignore) - (defalias 'overlay-put 'ignore) - (defalias 'overlay-start 'ignore) - (defalias 'overlays-in 'ignore) - (defalias 'replace-dehighlight 'ignore) - (defalias 'replace-highlight 'ignore) - (defalias 'w3-coding-system-for-mime-charset 'ignore))) - -(defun dgnushack-compile-verbosely () - "Call dgnushack-compile with warnings ENABLED. If you are compiling -patches to gnus, you should consider modifying make.bat to call -dgnushack-compile-verbosely. All other users should continue to use -dgnushack-compile." - (dgnushack-compile t)) - -(defun dgnushack-compile (&optional warn) - ;;(setq byte-compile-dynamic t) - (when (and (not (featurep 'xemacs)) - (< emacs-major-version 21)) - (setq max-specpdl-size 1200)) - (unless warn - (setq byte-compile-warnings - '(free-vars unresolved callargs redefine))) - (unless (locate-library "cus-edit") - (error "You do not seem to have Custom installed. -Fetch it from . -You also then need to add the following to the lisp/dgnushack.el file: - - (push \"~/lisp/custom\" load-path) - -Modify to suit your needs.")) - (let ((files (directory-files srcdir nil "^[^=].*\\.el$")) - ;;(byte-compile-generate-call-tree t) - file elc) - ;; Avoid barfing (from gnus-xmas) because the etc directory is not yet - ;; installed. - (when (featurep 'xemacs) - (setq gnus-xmas-glyph-directory "dummy")) - (dolist (file '("dgnushack.el" "lpath.el")) - (setq files (delete file files))) - (when (featurep 'base64) - (setq files (delete "base64.el" files))) - (condition-case code - (require 'w3-parse) - (error - (message "No w3: %s %s" (cadr code) (or (locate-library "w3-parse") "")) - (dolist (file '("nnultimate.el" "webmail.el" "nnwfm.el")) - (setq files (delete file files))))) - (condition-case code - (require 'mh-e) - (error - (message "No mh-e: %s %s" (cadr code) (or (locate-library "mh-e") "")) - (setq files (delete "gnus-mh.el" files)))) - (condition-case code - (require 'xml) - (error - (message "No xml: %s %s" (cadr code) (or (locate-library "xml") "")) - (setq files (delete "nnrss.el" files)))) - (dolist (file - (if (featurep 'xemacs) - '("md5.el") - '("gnus-xmas.el" "messagexmas.el" "nnheaderxm.el"))) - (setq files (delete file files))) - - (dolist (file files) - (setq file (expand-file-name file srcdir)) - (when (and (file-exists-p - (setq elc (concat (file-name-nondirectory file) "c"))) - (file-newer-than-file-p file elc)) - (delete-file elc))) - - (while (setq file (pop files)) - (setq file (expand-file-name file srcdir)) - (when (or (not (file-exists-p - (setq elc (concat (file-name-nondirectory file) "c")))) - (file-newer-than-file-p file elc)) - (ignore-errors - (byte-compile-file file)))))) - -(defun dgnushack-recompile () - (require 'gnus) - (byte-recompile-directory "." 0)) - -(defvar dgnushack-gnus-load-file - (if (featurep 'xemacs) - (expand-file-name "auto-autoloads.el") - (expand-file-name "gnus-load.el"))) - -(defvar dgnushack-cus-load-file - (if (featurep 'xemacs) - (expand-file-name "custom-load.el") - (expand-file-name "cus-load.el"))) - -(defun dgnushack-make-cus-load () - (load "cus-dep") - (let ((cusload-base-file dgnushack-cus-load-file)) - (if (fboundp 'custom-make-dependencies) - (custom-make-dependencies) - (Custom-make-dependencies)) - (when (featurep 'xemacs) - (message "Compiling %s..." dgnushack-cus-load-file) - (byte-compile-file dgnushack-cus-load-file)))) - -(defun dgnushack-make-auto-load () - (require 'autoload) - (unless (make-autoload '(define-derived-mode child parent name - "docstring" body) - "file") - (defadvice make-autoload (around handle-define-derived-mode activate) - "Handle `define-derived-mode'." - (if (eq (car-safe (ad-get-arg 0)) 'define-derived-mode) - (setq ad-return-value - (list 'autoload - (list 'quote (nth 1 (ad-get-arg 0))) - (ad-get-arg 1) - (nth 4 (ad-get-arg 0)) - t nil)) - ad-do-it)) - (put 'define-derived-mode 'doc-string-elt 3)) - (let ((generated-autoload-file dgnushack-gnus-load-file) - (make-backup-files nil) - (autoload-package-name "gnus")) - (if (featurep 'xemacs) - (if (file-exists-p generated-autoload-file) - (delete-file generated-autoload-file)) - (with-temp-file generated-autoload-file - (insert ?\014))) - (batch-update-autoloads))) - -(defun dgnushack-make-load () - (unless (featurep 'xemacs) - (message "Generating %s..." dgnushack-gnus-load-file) - (with-temp-file dgnushack-gnus-load-file - (insert-file-contents dgnushack-cus-load-file) - (delete-file dgnushack-cus-load-file) - (goto-char (point-min)) - (search-forward ";;; Code:") - (forward-line) - (delete-region (point-min) (point)) - (insert "\ -;;; gnus-load.el --- automatically extracted custom dependencies and autoload -;; -;;; Code: -") - (goto-char (point-max)) - (if (search-backward "custom-versions-load-alist" nil t) - (forward-line -1) - (forward-line -1) - (while (eq (char-after) ?\;) - (forward-line -1)) - (forward-line)) - (delete-region (point) (point-max)) - (insert "\n") - ;; smiley-* are duplicated. Remove them all. - (let ((point (point))) - (insert-file-contents dgnushack-gnus-load-file) - (goto-char point) - (while (search-forward "smiley-" nil t) - (beginning-of-line) - (if (looking-at "(autoload ") - (delete-region (point) (progn (forward-sexp) (point))) - (forward-line)))) - ;; - (goto-char (point-max)) - (when (search-backward "\n(provide " nil t) - (forward-line -1) - (delete-region (point) (point-max))) - (insert "\ - -\(provide 'gnus-load) - -;;; Local Variables: -;;; version-control: never -;;; no-byte-compile: t -;;; no-update-autoloads: t -;;; End: -;;; gnus-load.el ends here -") - )) - (message "Compiling %s..." dgnushack-gnus-load-file) - (byte-compile-file dgnushack-gnus-load-file) - (when (featurep 'xemacs) - (message "Creating dummy gnus-load.el...") - (with-temp-file (expand-file-name "gnus-load.el") - (insert "\ - -\(provide 'gnus-load) - -;;; Local Variables: -;;; version-control: never -;;; no-byte-compile: t -;;; no-update-autoloads: t -;;; End: -;;; gnus-load.el ends here")))) - -(defun dgnushack-find-lisp-shadows (&optional lispdir) - "Return a list of directories in which other Gnus installations exist. -This function looks for the other Gnus installations which will shadow -the new Gnus Lisp modules which have been installed in LISPDIR, using -the default `load-path'. The return value will make sense only when -LISPDIR is existent and is listed in the default `load-path'. Assume -LISPDIR will be prepended to `load-path' by a user if the default -`load-path' does not contain it." - (unless lispdir - (setq lispdir (getenv "lispdir"))) - (when (and lispdir (file-directory-p lispdir)) - (setq lispdir (file-truename (directory-file-name lispdir))) - (let ((indices '("gnus.elc" "gnus.el" "gnus.el.bz2" "gnus.el.gz" - "message.elc" "message.el" "message.el.bz2" - "message.el.gz")) - (path (delq nil (mapcar - (lambda (p) - (condition-case nil - (when (and p (file-directory-p p)) - (file-truename (directory-file-name p))) - (error nil))) - dgnushack-default-load-path))) - rest elcs) - (while path - (setq rest (cons (car path) rest) - path (delete (car rest) (cdr path)))) - (setq path (nreverse (cdr (member lispdir rest))) - rest nil) - (while path - (setq elcs indices) - (while elcs - (when (file-exists-p (expand-file-name (pop elcs) (car path))) - (setq rest (cons (car path) rest) - elcs nil))) - (setq path (cdr path))) - (prog1 - (setq path (nreverse rest)) - (when path - (let (print-level print-length) - (princ (concat "\n\ -WARNING: The other Gnus installation" (if (cdr path) "s have" " has") "\ - been detected in:\n\n " (mapconcat 'identity path "\n ") "\n\n\ -You will need to modify the run-time `load-path', remove them manually, -or remove them using `make remove-installed-shadows'.\n\n")))))))) - -(defun dgnushack-remove-lisp-shadows (&optional lispdir) - "Remove the other Gnus installations which shadow the recent one." - (let ((path (with-temp-buffer - (let ((standard-output (current-buffer))) - (dgnushack-find-lisp-shadows lispdir)))) - elcs files shadows file) - (when path - (unless (setq elcs (directory-files srcdir nil "\\.elc\\'")) - (error "You should build .elc files first.")) - (setq files - (apply - 'append - (mapcar - (lambda (el) - (list (concat el "c") el (concat el ".bz2") (concat el ".gz"))) - (append - (list (file-name-nondirectory dgnushack-gnus-load-file) - (file-name-nondirectory dgnushack-cus-load-file)) - (mapcar (lambda (elc) (substring elc 0 -1)) elcs))))) - (while path - (setq shadows files) - (while shadows - (setq file (expand-file-name (pop shadows) (car path))) - (when (file-exists-p file) - (princ (concat " Removing " file "...")) - (condition-case nil - (progn - (delete-file file) - (princ "done\n")) - (error (princ "failed\n"))))) - (setq path (cdr path)))))) - -;;; dgnushack.el ends here - -;;; arch-tag: 579f585a-24eb-4e1c-8d34-4808e11b68f2 diff --git a/xemacs-packages/gnus/lisp/earcon.el b/xemacs-packages/gnus/lisp/earcon.el deleted file mode 100644 index 39b17893..00000000 --- a/xemacs-packages/gnus/lisp/earcon.el +++ /dev/null @@ -1,235 +0,0 @@ -;;; earcon.el --- Sound effects for messages - -;; Copyright (C) 1996, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Steven L. Baur - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: -;; This file provides access to sound effects in Gnus. - -;;; Code: - -(eval-when-compile (require 'cl)) -(require 'gnus) -(require 'gnus-audio) -(require 'gnus-art) - -(defgroup earcon nil - "Turn ** sounds ** into noise." - :group 'gnus-visual) - -(defcustom earcon-prefix "**" - "*String denoting the start of an earcon." - :type 'string - :group 'earcon) - -(defcustom earcon-suffix "**" - "String denoting the end of an earcon." - :type 'string - :group 'earcon) - -(defcustom earcon-regexp-alist - '(("boring" 1 "Boring.au") - ("evil[ \t]+laugh" 1 "Evil_Laugh.au") - ("gag\\|puke" 1 "Puke.au") - ("snicker" 1 "Snicker.au") - ("meow" 1 "catmeow.wav") - ("sob\\|boohoo" 1 "cry.wav") - ("drum[ \t]*roll" 1 "drumroll.au") - ("blast" 1 "explosion.au") - ("flush\\|plonk!*" 1 "flush.au") - ("kiss" 1 "kiss.wav") - ("tee[ \t]*hee" 1 "laugh.au") - ("shoot" 1 "shotgun.wav") - ("yawn" 1 "snore.wav") - ("cackle" 1 "witch.au") - ("yell\\|roar" 1 "yell2.au") - ("whoop-de-doo" 1 "whistle.au")) - "*A list of regexps to map earcons to real sounds." - :type '(repeat (list regexp - (integer :tag "Match") - (string :tag "Sound"))) - :group 'earcon) -(defvar earcon-button-marker-list nil) -(make-variable-buffer-local 'earcon-button-marker-list) - -;;; FIXME!! clone of code from gnus-vis.el FIXME!! -(defun earcon-article-push-button (event) - "Check text under the mouse pointer for a callback function. -If the text under the mouse pointer has a `earcon-callback' property, -call it with the value of the `earcon-data' text property." - (interactive "e") - (set-buffer (window-buffer (posn-window (event-start event)))) - (let* ((pos (posn-point (event-start event))) - (data (get-text-property pos 'earcon-data)) - (fun (get-text-property pos 'earcon-callback))) - (if fun (funcall fun data)))) - -(defun earcon-article-press-button () - "Check text at point for a callback function. -If the text at point has a `earcon-callback' property, -call it with the value of the `earcon-data' text property." - (interactive) - (let* ((data (get-text-property (point) 'earcon-data)) - (fun (get-text-property (point) 'earcon-callback))) - (if fun (funcall fun data)))) - -(defun earcon-article-prev-button (n) - "Move point to N buttons backward. -If N is negative, move forward instead." - (interactive "p") - (earcon-article-next-button (- n))) - -(defun earcon-article-next-button (n) - "Move point to N buttons forward. -If N is negative, move backward instead." - (interactive "p") - (let ((function (if (< n 0) 'previous-single-property-change - 'next-single-property-change)) - (inhibit-point-motion-hooks t) - (backward (< n 0)) - (limit (if (< n 0) (point-min) (point-max)))) - (setq n (abs n)) - (while (and (not (= limit (point))) - (> n 0)) - ;; Skip past the current button. - (when (get-text-property (point) 'earcon-callback) - (goto-char (funcall function (point) 'earcon-callback nil limit))) - ;; Go to the next (or previous) button. - (gnus-goto-char (funcall function (point) 'earcon-callback nil limit)) - ;; Put point at the start of the button. - (when (and backward (not (get-text-property (point) 'earcon-callback))) - (goto-char (funcall function (point) 'earcon-callback nil limit))) - ;; Skip past intangible buttons. - (when (get-text-property (point) 'intangible) - (incf n)) - (decf n)) - (unless (zerop n) - (gnus-message 5 "No more buttons")) - n)) - -(defun earcon-article-add-button (from to fun &optional data) - "Create a button between FROM and TO with callback FUN and data DATA." - (and (boundp gnus-article-button-face) - gnus-article-button-face - (gnus-overlay-put (gnus-make-overlay from to) - 'face gnus-article-button-face)) - (gnus-add-text-properties - from to - (nconc (and gnus-article-mouse-face - (list gnus-mouse-face-prop gnus-article-mouse-face)) - (list 'gnus-callback fun) - (and data (list 'gnus-data data))))) - -(defun earcon-button-entry () - ;; Return the first entry in `gnus-button-alist' matching this place. - (let ((alist earcon-regexp-alist) - (case-fold-search t) - (entry nil)) - (while alist - (setq entry (pop alist)) - (if (looking-at (car entry)) - (setq alist nil) - (setq entry nil))) - entry)) - -(defun earcon-button-push (marker) - ;; Push button starting at MARKER. - (save-excursion - (set-buffer gnus-article-buffer) - (goto-char marker) - (let* ((entry (earcon-button-entry)) - (inhibit-point-motion-hooks t) - (fun 'gnus-audio-play) - (args (list (nth 2 entry)))) - (cond - ((fboundp fun) - (apply fun args)) - ((and (boundp fun) - (fboundp (symbol-value fun))) - (apply (symbol-value fun) args)) - (t - (gnus-message 1 "You must define `%S' to use this button" - (cons fun args))))))) - -;;; FIXME!! clone of code from gnus-vis.el FIXME!! - -;;;###interactive -(defun earcon-region (beg end) - "Play Sounds in the region between point and mark." - (interactive "r") - (earcon-buffer (current-buffer) beg end)) - -;;;###interactive -(defun earcon-buffer (&optional buffer st nd) - (interactive) - (save-excursion - ;; clear old markers. - (if (boundp 'earcon-button-marker-list) - (while earcon-button-marker-list - (set-marker (pop earcon-button-marker-list) nil)) - (setq earcon-button-marker-list nil)) - (and buffer (set-buffer buffer)) - (let ((buffer-read-only nil) - (inhibit-point-motion-hooks t) - (case-fold-search t) - (alist earcon-regexp-alist) - beg entry regexp) - (goto-char (point-min)) - (setq beg (point)) - (while (setq entry (pop alist)) - (setq regexp (concat (regexp-quote earcon-prefix) - ".*\\(" - (car entry) - "\\).*" - (regexp-quote earcon-suffix))) - (goto-char beg) - (while (re-search-forward regexp nil t) - (let* ((start (and entry (match-beginning 1))) - (end (and entry (match-end 1))) - (from (match-beginning 1))) - (earcon-article-add-button - start end 'earcon-button-push - (car (push (set-marker (make-marker) from) - earcon-button-marker-list))) - (gnus-audio-play (caddr entry)))))))) - -;;;###autoload -(defun gnus-earcon-display () - "Play sounds in message buffers." - (interactive) - (save-excursion - (set-buffer gnus-article-buffer) - (goto-char (point-min)) - ;; Skip headers - (unless (search-forward "\n\n" nil t) - (goto-char (point-max))) - (sit-for 0) - (earcon-buffer (current-buffer) (point)))) - -;;;*** - -(provide 'earcon) - -(run-hooks 'earcon-load-hook) - -;;; arch-tag: 844dfeea-980c-4ed0-907f-a30bf139691c -;;; earcon.el ends here diff --git a/xemacs-packages/gnus/lisp/flow-fill.el b/xemacs-packages/gnus/lisp/flow-fill.el deleted file mode 100644 index 202b8d7c..00000000 --- a/xemacs-packages/gnus/lisp/flow-fill.el +++ /dev/null @@ -1,237 +0,0 @@ -;;; flow-fill.el --- interpret RFC2646 "flowed" text - -;; Copyright (C) 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Simon Josefsson -;; Keywords: mail - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; This implement decoding of RFC2646 formatted text, including the -;; quoted-depth wins rules. - -;; Theory of operation: search for lines ending with SPC, save quote -;; length of line, remove SPC and concatenate line with the following -;; line if quote length of following line matches current line. - -;; When no further concatenations are possible, we've found a -;; paragraph and we let `fill-region' fill the long line into several -;; lines with the quote prefix as `fill-prefix'. - -;; Todo: implement basic `fill-region' (Emacs and XEmacs -;; implementations differ..) - -;;; History: - -;; 2000-02-17 posted on ding mailing list -;; 2000-02-19 use `point-at-{b,e}ol' in XEmacs -;; 2000-03-11 no compile warnings for point-at-bol stuff -;; 2000-03-26 committed to gnus cvs -;; 2000-10-23 don't flow "-- " lines, make "quote-depth wins" rule -;; work when first line is at level 0. -;; 2002-01-12 probably incomplete encoding support -;; 2003-12-08 started working on test harness. - -;;; Code: - -(eval-when-compile (require 'cl)) - -(defcustom fill-flowed-display-column 'fill-column - "Column beyond which format=flowed lines are wrapped, when displayed. -This can be a Lisp expression or an integer." - :version "22.1" - :group 'mime-display - :type '(choice (const :tag "Standard `fill-column'" fill-column) - (const :tag "Fit Window" (- (window-width) 5)) - (sexp) - (integer))) - -(defcustom fill-flowed-encode-column 66 - "Column beyond which format=flowed lines are wrapped, in outgoing messages. -This can be a Lisp expression or an integer. -RFC 2646 suggests 66 characters for readability." - :version "22.1" - :group 'mime-display - :type '(choice (const :tag "Standard fill-column" fill-column) - (const :tag "RFC 2646 default (66)" 66) - (sexp) - (integer))) - -(eval-and-compile - (defalias 'fill-flowed-point-at-bol - (if (fboundp 'point-at-bol) - 'point-at-bol - 'line-beginning-position)) - - (defalias 'fill-flowed-point-at-eol - (if (fboundp 'point-at-eol) - 'point-at-eol - 'line-end-position))) - -;;;###autoload -(defun fill-flowed-encode (&optional buffer) - (with-current-buffer (or buffer (current-buffer)) - ;; No point in doing this unless hard newlines is used. - (when use-hard-newlines - (let ((start (point-min)) end) - ;; Go through each paragraph, filling it and adding SPC - ;; as the last character on each line. - (while (setq end (text-property-any start (point-max) 'hard 't)) - (let ((fill-column (eval fill-flowed-encode-column))) - (fill-region start end t 'nosqueeze 'to-eop)) - (goto-char start) - ;; `fill-region' probably distorted end. - (setq end (text-property-any start (point-max) 'hard 't)) - (while (and (< (point) end) - (re-search-forward "$" (1- end) t)) - (insert " ") - (setq end (1+ end)) - (forward-char)) - (goto-char (setq start (1+ end))))) - t))) - -;;;###autoload -(defun fill-flowed (&optional buffer) - (save-excursion - (set-buffer (or (current-buffer) buffer)) - (goto-char (point-min)) - ;; Remove space stuffing. - (while (re-search-forward "^\\( \\|>+ $\\)" nil t) - (delete-char -1) - (forward-line 1)) - (goto-char (point-min)) - (while (re-search-forward " $" nil t) - (when (save-excursion - (beginning-of-line) - (looking-at "^\\(>*\\)\\( ?\\)")) - (let ((quote (match-string 1)) - sig) - (if (string= quote "") - (setq quote nil)) - (when (and quote (string= (match-string 2) "")) - (save-excursion - ;; insert SP after quote for pleasant reading of quoted lines - (beginning-of-line) - (when (> (skip-chars-forward ">") 0) - (insert " ")))) - ;; XXX slightly buggy handling of "-- " - (while (and (save-excursion - (ignore-errors (backward-char 3)) - (setq sig (looking-at "-- ")) - (looking-at "[^-][^-] ")) - (save-excursion - (unless (eobp) - (forward-char 1) - (looking-at (format "^\\(%s\\)\\([^>\n\r]\\)" - (or quote " ?")))))) - (save-excursion - (replace-match (if (string= (match-string 2) " ") - "" "\\2"))) - (backward-delete-char -1) - (end-of-line)) - (unless sig - (condition-case nil - (let ((fill-prefix (when quote (concat quote " "))) - (fill-column (eval fill-flowed-display-column)) - filladapt-mode - adaptive-fill-mode) - (fill-region (fill-flowed-point-at-bol) - (min (1+ (fill-flowed-point-at-eol)) - (point-max)) - 'left 'nosqueeze)) - (error - (forward-line 1) - nil)))))))) - -;; Test vectors. - -(eval-when-compile - (defvar show-trailing-whitespace)) - -(defvar fill-flowed-encode-tests - `( - ;; The syntax of each list element is: - ;; (INPUT . EXPECTED-OUTPUT) - (,(concat - "> Thou villainous ill-breeding spongy dizzy-eyed \n" - "> reeky elf-skinned pigeon-egg! \n" - ">> Thou artless swag-bellied milk-livered \n" - ">> dismal-dreaming idle-headed scut!\n" - ">>> Thou errant folly-fallen spleeny reeling-ripe \n" - ">>> unmuzzled ratsbane!\n" - ">>>> Henceforth, the coding style is to be strictly \n" - ">>>> enforced, including the use of only upper case.\n" - ">>>>> I've noticed a lack of adherence to the coding \n" - ">>>>> styles, of late.\n" - ">>>>>> Any complaints?") - . - ,(concat - "> Thou villainous ill-breeding spongy dizzy-eyed reeky elf-skinned\n" - "> pigeon-egg! \n" - ">> Thou artless swag-bellied milk-livered dismal-dreaming idle-headed\n" - ">> scut!\n" - ">>> Thou errant folly-fallen spleeny reeling-ripe unmuzzled ratsbane!\n" - ">>>> Henceforth, the coding style is to be strictly enforced,\n" - ">>>> including the use of only upper case.\n" - ">>>>> I've noticed a lack of adherence to the coding styles, of late.\n" - ">>>>>> Any complaints?\n" - )) - ;; (,(concat - ;; "\n" - ;; "> foo\n" - ;; "> \n" - ;; "> \n" - ;; "> bar\n") - ;; . - ;; ,(concat - ;; "\n" - ;; "> foo bar\n")) - )) - -(defun fill-flowed-test () - (interactive "") - (switch-to-buffer (get-buffer-create "*Format=Flowed test output*")) - (erase-buffer) - (setq show-trailing-whitespace t) - (dolist (test fill-flowed-encode-tests) - (let (start output) - (insert "***** BEGIN TEST INPUT *****\n") - (insert (car test)) - (insert "***** END TEST INPUT *****\n\n") - (insert "***** BEGIN TEST OUTPUT *****\n") - (setq start (point)) - (insert (car test)) - (save-restriction - (narrow-to-region start (point)) - (fill-flowed)) - (setq output (buffer-substring start (point-max))) - (insert "***** END TEST OUTPUT *****\n") - (unless (string= output (cdr test)) - (insert "\n***** BEGIN TEST EXPECTED OUTPUT *****\n") - (insert (cdr test)) - (insert "***** END TEST EXPECTED OUTPUT *****\n")) - (insert "\n\n"))) - (goto-char (point-max))) - -(provide 'flow-fill) - -;;; arch-tag: addc0040-bc53-4f17-b4bc-1eb44eed6f0b -;;; flow-fill.el ends here diff --git a/xemacs-packages/gnus/lisp/format-spec.el b/xemacs-packages/gnus/lisp/format-spec.el deleted file mode 100644 index f294bcda..00000000 --- a/xemacs-packages/gnus/lisp/format-spec.el +++ /dev/null @@ -1,82 +0,0 @@ -;;; format-spec.el --- functions for formatting arbitrary formatting strings - -;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: tools - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(defun format-spec (format specification) - "Return a string based on FORMAT and SPECIFICATION. -FORMAT is a string containing `format'-like specs like \"bash %u %k\", -while SPECIFICATION is an alist mapping from format spec characters -to values. Any text properties on a %-spec itself are propagated to -the text that it generates." - (with-temp-buffer - (insert format) - (goto-char (point-min)) - (while (search-forward "%" nil t) - (cond - ;; Quoted percent sign. - ((eq (char-after) ?%) - (delete-char 1)) - ;; Valid format spec. - ((looking-at "\\([-0-9.]*\\)\\([a-zA-Z]\\)") - (let* ((num (match-string 1)) - (spec (string-to-char (match-string 2))) - (val (cdr (assq spec specification)))) - (unless val - (error "Invalid format character: %s" spec)) - ;; Pad result to desired length. - (let ((text (format (concat "%" num "s") val))) - ;; Insert first, to preserve text properties. - (insert-and-inherit text) - ;; Delete the specifier body. - (delete-region (+ (match-beginning 0) (length text)) - (+ (match-end 0) (length text))) - ;; Delete the percent sign. - (delete-region (1- (match-beginning 0)) (match-beginning 0))))) - ;; Signal an error on bogus format strings. - (t - (error "Invalid format string")))) - (buffer-string))) - -(defun format-spec-make (&rest pairs) - "Return an alist suitable for use in `format-spec' based on PAIRS. -PAIRS is a list where every other element is a character and a value, -starting with a character." - (let (alist) - (while pairs - (unless (cdr pairs) - (error "Invalid list of pairs")) - (push (cons (car pairs) (cadr pairs)) alist) - (setq pairs (cddr pairs))) - (nreverse alist))) - -(provide 'format-spec) - -;;; arch-tag: c22d49cf-d167-445d-b7f1-2504d4173f53 -;;; format-spec.el ends here diff --git a/xemacs-packages/gnus/lisp/gmm-utils.el b/xemacs-packages/gnus/lisp/gmm-utils.el deleted file mode 100644 index 57fb2785..00000000 --- a/xemacs-packages/gnus/lisp/gmm-utils.el +++ /dev/null @@ -1,422 +0,0 @@ -;;; gmm-utils.el --- Utility functions for Gnus, Message and MML - -;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Reiner Steib -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; This library provides self-contained utility functions. The functions are -;; used in Gnus, Message and MML, but within this library there are no -;; dependencies on Gnus, Message, or MML. - -;;; Code: - -(require 'wid-edit) - -(defgroup gmm nil - "Utility functions for Gnus, Message and MML" - :prefix "gmm-" - :version "22.1" ;; Gnus 5.10.9 - :group 'lisp) - -;; Helper functions from `gnus-utils.el': gmm-verbose, gmm-message, gmm-error - -(defcustom gmm-verbose 7 - "Integer that says how verbose gmm should be. -The higher the number, the more messages will flash to say what -it done. At zero, it will be totally mute; at five, it will -display most important messages; and at ten, it will keep on -jabbering all the time." - :type 'integer - :group 'gmm) - -;;;###autoload -(defun gmm-message (level &rest args) - "If LEVEL is lower than `gmm-verbose' print ARGS using `message'. - -Guideline for numbers: -1 - error messages, 3 - non-serious error messages, 5 - messages for things -that take a long time, 7 - not very important messages on stuff, 9 - messages -inside loops." - (if (<= level gmm-verbose) - (apply 'message args) - ;; We have to do this format thingy here even if the result isn't - ;; shown - the return value has to be the same as the return value - ;; from `message'. - (apply 'format args))) - -;;;###autoload -(defun gmm-error (level &rest args) - "Beep an error if LEVEL is equal to or less than `gmm-verbose'. -ARGS are passed to `message'." - (when (<= (floor level) gmm-verbose) - (apply 'message args) - (ding) - (let (duration) - (when (and (floatp level) - (not (zerop (setq duration (* 10 (- level (floor level))))))) - (sit-for duration)))) - nil) - -;;;###autoload -(defun gmm-widget-p (symbol) - "Non-nil if SYMBOL is a widget." - (get symbol 'widget-type)) - -;; Copy of the `nnmail-lazy' code from `nnmail.el': -(define-widget 'gmm-lazy 'default - "Base widget for recursive datastructures. - -This is copy of the `lazy' widget in Emacs 22.1 provided for compatibility." - :format "%{%t%}: %v" - :convert-widget 'widget-value-convert-widget - :value-create (lambda (widget) - (let ((value (widget-get widget :value)) - (type (widget-get widget :type))) - (widget-put widget :children - (list (widget-create-child-value - widget (widget-convert type) value))))) - :value-delete 'widget-children-value-delete - :value-get (lambda (widget) - (widget-value (car (widget-get widget :children)))) - :value-inline (lambda (widget) - (widget-apply (car (widget-get widget :children)) - :value-inline)) - :default-get (lambda (widget) - (widget-default-get - (widget-convert (widget-get widget :type)))) - :match (lambda (widget value) - (widget-apply (widget-convert (widget-get widget :type)) - :match value)) - :validate (lambda (widget) - (widget-apply (car (widget-get widget :children)) :validate))) - -;; Note: The format of `gmm-tool-bar-item' may change if some future Emacs -;; version will provide customizable tool bar buttons using a different -;; interface. - -;; TODO: Extend API so that the "Command" entry can be a function or a plist. -;; In case of a list it should have the format... -;; -;; (:none command-without-modifier -;; :shift command-with-shift-pressed -;; :control command-with-ctrl-pressed -;; :control-shift command-with-control-and-shift-pressed -;; ;; mouse-2 and mouse-3 can't be used in Emacs yet. -;; :mouse-2 command-on-mouse-2-press -;; :mouse-3 command-on-mouse-3-press) ;; typically a menu of related commands -;; -;; Combinations of mouse-[23] plus shift and/or controll might be overkill. -;; -;; Then use (plist-get rs-command :none), (plist-get rs-command :shift) - -(define-widget 'gmm-tool-bar-item (if (gmm-widget-p 'lazy) 'lazy 'gmm-lazy) - "Tool bar list item." - :tag "Tool bar item" - :type '(choice - (list :tag "Command and Icon" - (function :tag "Command") - (string :tag "Icon file") - (choice - (const :tag "Default map" nil) - ;; Note: Usually we need non-nil attributes if map is t. - (const :tag "No menu" t) - (sexp :tag "Other map")) - (plist :inline t :tag "Properties")) - (list :tag "Separator" - (const :tag "No command" gmm-ignore) - (string :tag "Icon file") - (const :tag "No map") - (plist :inline t :tag "Properties")))) - -(define-widget 'gmm-tool-bar-zap-list (if (gmm-widget-p 'lazy) 'lazy 'gmm-lazy) - "Tool bar zap list." - :tag "Tool bar zap list" - :type '(choice (const :tag "Zap all" t) - (const :tag "Keep all" nil) - (list - ;; :value - ;; Work around (bug in customize?), see - ;; - ;; (new-file open-file dired kill-buffer write-file - ;; print-buffer customize help) - (set :inline t - (const new-file) - (const open-file) - (const dired) - (const kill-buffer) - (const save-buffer) - (const write-file) - (const undo) - (const cut) - (const copy) - (const paste) - (const search-forward) - (const print-buffer) - (const customize) - (const help)) - (repeat :inline t - :tag "Other" - (symbol :tag "Icon item"))))) - -;; (defun gmm-color-cells (&optional display) -;; "Return the number of color cells supported by DISPLAY. -;; Compatibility function." -;; ;; `display-color-cells' doesn't return more than 256 even if color depth is -;; ;; > 8 in Emacs 21. -;; ;; -;; ;; Feel free to add proper XEmacs support. -;; (let* ((cells (and (fboundp 'display-color-cells) -;; (display-color-cells display))) -;; (plane (and (fboundp 'x-display-planes) -;; (ash 1 (x-display-planes)))) -;; (none -1)) -;; (max (if (integerp cells) cells none) -;; (if (integerp plane) plane none)))) - -(defcustom gmm-tool-bar-style - (if (and (boundp 'tool-bar-mode) - tool-bar-mode - (and (fboundp 'display-visual-class) - (not (memq (display-visual-class) - (list 'static-gray 'gray-scale - 'static-color 'pseudo-color))))) - 'gnome - 'retro) - "Prefered tool bar style." - :type '(choice (const :tag "GNOME style" gnome) - (const :tag "Retro look" retro)) - :group 'gmm) - -(defvar tool-bar-map) - -;;;###autoload -(defun gmm-tool-bar-from-list (icon-list zap-list default-map) - "Make a tool bar from ICON-LIST. - -Within each entry of ICON-LIST, the first element is a menu -command, the second element is an icon file name and the third -element is a test function. You can use \\[describe-key] - to find out the name of a menu command. The fourth -and all following elements are passed as the PROPS argument to the -function `tool-bar-local-item'. - -If ZAP-LIST is a list, remove those item from the default -`tool-bar-map'. If it is t, start with a new sparse map. You -can use \\[describe-key] to find out the name of an icon -item. When \\[describe-key] shows \" -runs the command find-file\", then use `new-file' in ZAP-LIST. - -DEFAULT-MAP specifies the default key map for ICON-LIST." - (let (;; For Emacs 21, we must let-bind `tool-bar-map'. In Emacs 22, we - ;; could use some other local variable. - (tool-bar-map (if (eq zap-list t) - (make-sparse-keymap) - (copy-keymap tool-bar-map)))) - (when (listp zap-list) - ;; Zap some items which aren't relevant for this mode and take up space. - (dolist (key zap-list) - (define-key tool-bar-map (vector key) nil))) - (mapc (lambda (el) - (let ((command (car el)) - (icon (nth 1 el)) - (fmap (or (nth 2 el) default-map)) - (props (cdr (cdr (cdr el)))) ) - ;; command may stem from different from-maps: - (cond ((eq command 'gmm-ignore) - ;; The dummy `gmm-ignore', see `gmm-tool-bar-item' - ;; widget. Suppress tooltip by adding `:enable nil'. - (if (fboundp 'tool-bar-local-item) - (apply 'tool-bar-local-item icon nil nil - tool-bar-map :enable nil props) - ;; (tool-bar-local-item ICON DEF KEY MAP &rest PROPS) - ;; (tool-bar-add-item ICON DEF KEY &rest PROPS) - (apply 'tool-bar-add-item icon nil nil :enable nil props))) - ((equal fmap t) ;; Not a menu command - (if (fboundp 'tool-bar-local-item) - (apply 'tool-bar-local-item - icon command - (intern icon) ;; reuse icon or fmap here? - tool-bar-map props) - ;; Emacs 21 compatibility: - (apply 'tool-bar-add-item - icon command - (intern icon) - props))) - (t ;; A menu command - (if (fboundp 'tool-bar-local-item-from-menu) - (apply 'tool-bar-local-item-from-menu - ;; (apply 'tool-bar-local-item icon def key - ;; tool-bar-map props) - command icon tool-bar-map (symbol-value fmap) - props) - ;; Emacs 21 compatibility: - (apply 'tool-bar-add-item-from-menu - command icon (symbol-value fmap) - props)))) - t)) - (if (symbolp icon-list) - (eval icon-list) - icon-list)) - tool-bar-map)) - -(defmacro defun-gmm (name function arg-list &rest body) - "Create function NAME. -If FUNCTION exists, then NAME becomes an alias for FUNCTION. -Otherwise, create function NAME with ARG-LIST and BODY." - (let ((defined-p (fboundp function))) - (if defined-p - `(defalias ',name ',function) - `(defun ,name ,arg-list ,@body)))) - -(defun-gmm gmm-image-search-load-path - image-search-load-path (file &optional path) - "Emacs 21 and XEmacs don't have `image-search-load-path'. -This function returns nil on those systems." - nil) - -;; Cf. `mh-image-load-path-for-library' in `mh-compat.el'. - -(defun-gmm gmm-image-load-path-for-library - image-load-path-for-library (library image &optional path no-error) - "Return a suitable search path for images used by LIBRARY. - -It searches for IMAGE in `image-load-path' (excluding -\"`data-directory'/images\") and `load-path', followed by a path -suitable for LIBRARY, which includes \"../../etc/images\" and -\"../etc/images\" relative to the library file itself, and then -in \"`data-directory'/images\". - -Then this function returns a list of directories which contains -first the directory in which IMAGE was found, followed by the -value of `load-path'. If PATH is given, it is used instead of -`load-path'. - -If NO-ERROR is non-nil and a suitable path can't be found, don't -signal an error. Instead, return a list of directories as before, -except that nil appears in place of the image directory. - -Here is an example that uses a common idiom to provide -compatibility with versions of Emacs that lack the variable -`image-load-path': - - ;; Shush compiler. - (defvar image-load-path) - - (let* ((load-path (image-load-path-for-library \"mh-e\" \"mh-logo.xpm\")) - (image-load-path (cons (car load-path) - (when (boundp 'image-load-path) - image-load-path)))) - (mh-tool-bar-folder-buttons-init))" - (unless library (error "No library specified")) - (unless image (error "No image specified")) - (let (image-directory image-directory-load-path) - ;; Check for images in image-load-path or load-path. - (let ((img image) - (dir (or - ;; Images in image-load-path. - (gmm-image-search-load-path image) ;; "gmm-" prefix! - ;; Images in load-path. - (locate-library image))) - parent) - ;; Since the image might be in a nested directory (for - ;; example, mail/attach.pbm), adjust `image-directory' - ;; accordingly. - (when dir - (setq dir (file-name-directory dir)) - (while (setq parent (file-name-directory img)) - (setq img (directory-file-name parent) - dir (expand-file-name "../" dir)))) - (setq image-directory-load-path dir)) - - ;; If `image-directory-load-path' isn't Emacs' image directory, - ;; it's probably a user preference, so use it. Then use a - ;; relative setting if possible; otherwise, use - ;; `image-directory-load-path'. - (cond - ;; User-modified image-load-path? - ((and image-directory-load-path - (not (equal image-directory-load-path - (file-name-as-directory - (expand-file-name "images" data-directory))))) - (setq image-directory image-directory-load-path)) - ;; Try relative setting. - ((let (library-name d1ei d2ei) - ;; First, find library in the load-path. - (setq library-name (locate-library library)) - (if (not library-name) - (error "Cannot find library %s in load-path" library)) - ;; And then set image-directory relative to that. - (setq - ;; Go down 2 levels. - d2ei (file-name-as-directory - (expand-file-name - (concat (file-name-directory library-name) "../../etc/images"))) - ;; Go down 1 level. - d1ei (file-name-as-directory - (expand-file-name - (concat (file-name-directory library-name) "../etc/images")))) - (setq image-directory - ;; Set it to nil if image is not found. - (cond ((file-exists-p (expand-file-name image d2ei)) d2ei) - ((file-exists-p (expand-file-name image d1ei)) d1ei))))) - ;; Use Emacs' image directory. - (image-directory-load-path - (setq image-directory image-directory-load-path)) - (no-error - (message "Could not find image %s for library %s" image library)) - (t - (error "Could not find image %s for library %s" image library))) - - ;; Return an augmented `path' or `load-path'. - (nconc (list image-directory) - (delete image-directory (copy-sequence (or path load-path)))))) - -(defun gmm-customize-mode (&optional mode) - "Customize customization group for MODE. -If mode is nil, use `major-mode' of the curent buffer." - (interactive) - (customize-group - (or mode - (intern (let ((mode (symbol-name major-mode))) - (string-match "^\\(.+\\)-mode$" mode) - (match-string 1 mode)))))) - -(defun gmm-write-region (start end filename &optional append visit - lockname mustbenew) - "Compatibility function for `write-region'. - -In XEmacs, the seventh argument of `write-region' specifies the -coding-system." - (if (and mustbenew - (or (featurep 'xemacs) - (= emacs-major-version 20))) - (if (file-exists-p filename) - (signal 'file-already-exists - (list "File exists" filename)) - (write-region start end filename append visit lockname)) - (write-region start end filename append visit lockname mustbenew))) - -(provide 'gmm-utils) - -;; arch-tag: e0b60920-2ce6-40c1-bfc0-cadbbe26b602 -;;; gmm-utils.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-agent.el b/xemacs-packages/gnus/lisp/gnus-agent.el deleted file mode 100644 index b373039c..00000000 --- a/xemacs-packages/gnus/lisp/gnus-agent.el +++ /dev/null @@ -1,4002 +0,0 @@ -;;; gnus-agent.el --- unplugged support for Gnus - -;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) -(require 'gnus-cache) -(require 'nnmail) -(require 'nnvirtual) -(require 'gnus-sum) -(require 'gnus-score) -(require 'gnus-srvr) -(require 'gnus-util) -(eval-when-compile - (if (featurep 'xemacs) - (require 'itimer) - (require 'timer)) - (require 'cl)) - -(eval-and-compile - (autoload 'gnus-server-update-server "gnus-srvr") - (autoload 'gnus-agent-customize-category "gnus-cus") -) - -(defcustom gnus-agent-directory (nnheader-concat gnus-directory "agent/") - "Where the Gnus agent will store its files." - :group 'gnus-agent - :type 'directory) - -(defcustom gnus-agent-plugged-hook nil - "Hook run when plugging into the network." - :group 'gnus-agent - :type 'hook) - -(defcustom gnus-agent-unplugged-hook nil - "Hook run when unplugging from the network." - :group 'gnus-agent - :type 'hook) - -(defcustom gnus-agent-fetched-hook nil - "Hook run when finished fetching articles." - :version "22.1" - :group 'gnus-agent - :type 'hook) - -(defcustom gnus-agent-handle-level gnus-level-subscribed - "Groups on levels higher than this variable will be ignored by the Agent." - :group 'gnus-agent - :type 'integer) - -(defcustom gnus-agent-expire-days 7 - "Read articles older than this will be expired. -If you wish to disable Agent expiring, see `gnus-agent-enable-expiration'." - :group 'gnus-agent - :type '(number :tag "days")) - -(defcustom gnus-agent-expire-all nil - "If non-nil, also expire unread, ticked and dormant articles. -If nil, only read articles will be expired." - :group 'gnus-agent - :type 'boolean) - -(defcustom gnus-agent-group-mode-hook nil - "Hook run in Agent group minor modes." - :group 'gnus-agent - :type 'hook) - -;; Extracted from gnus-xmas-redefine in order to preserve user settings -(when (featurep 'xemacs) - (add-hook 'gnus-agent-group-mode-hook 'gnus-xmas-agent-group-menu-add)) - -(defcustom gnus-agent-summary-mode-hook nil - "Hook run in Agent summary minor modes." - :group 'gnus-agent - :type 'hook) - -;; Extracted from gnus-xmas-redefine in order to preserve user settings -(when (featurep 'xemacs) - (add-hook 'gnus-agent-summary-mode-hook 'gnus-xmas-agent-summary-menu-add)) - -(defcustom gnus-agent-server-mode-hook nil - "Hook run in Agent summary minor modes." - :group 'gnus-agent - :type 'hook) - -;; Extracted from gnus-xmas-redefine in order to preserve user settings -(when (featurep 'xemacs) - (add-hook 'gnus-agent-server-mode-hook 'gnus-xmas-agent-server-menu-add)) - -(defcustom gnus-agent-confirmation-function 'y-or-n-p - "Function to confirm when error happens." - :version "21.1" - :group 'gnus-agent - :type 'function) - -(defcustom gnus-agent-synchronize-flags t - "Indicate if flags are synchronized when you plug in. -If this is `ask' the hook will query the user." - ;; If the default switches to something else than nil, then the function - ;; should be fixed not be exceedingly slow. See 2005-09-20 ChangeLog entry. - :version "21.1" - :type '(choice (const :tag "Always" t) - (const :tag "Never" nil) - (const :tag "Ask" ask)) - :group 'gnus-agent) - -(defcustom gnus-agent-go-online 'ask - "Indicate if offline servers go online when you plug in. -If this is `ask' the hook will query the user." - :version "21.3" - :type '(choice (const :tag "Always" t) - (const :tag "Never" nil) - (const :tag "Ask" ask)) - :group 'gnus-agent) - -(defcustom gnus-agent-mark-unread-after-downloaded t - "Indicate whether to mark articles unread after downloaded." - :version "21.1" - :type 'boolean - :group 'gnus-agent) - -(defcustom gnus-agent-download-marks '(download) - "Marks for downloading." - :version "21.1" - :type '(repeat (symbol :tag "Mark")) - :group 'gnus-agent) - -(defcustom gnus-agent-consider-all-articles nil - "When non-nil, the agent will let the agent predicate decide -whether articles need to be downloaded or not, for all articles. When -nil, the default, the agent will only let the predicate decide -whether unread articles are downloaded or not. If you enable this, -groups with large active ranges may open slower and you may also want -to look into the agent expiry settings to block the expiration of -read articles as they would just be downloaded again." - :version "22.1" - :type 'boolean - :group 'gnus-agent) - -(defcustom gnus-agent-max-fetch-size 10000000 ;; 10 Mb - "Chunk size for `gnus-agent-fetch-session'. -The function will split its article fetches into chunks smaller than -this limit." - :version "22.1" - :group 'gnus-agent - :type 'integer) - -(defcustom gnus-agent-enable-expiration 'ENABLE - "The default expiration state for each group. -When set to ENABLE, the default, `gnus-agent-expire' will expire old -contents from a group's local storage. This value may be overridden -to disable expiration in specific categories, topics, and groups. Of -course, you could change gnus-agent-enable-expiration to DISABLE then -enable expiration per categories, topics, and groups." - :version "22.1" - :group 'gnus-agent - :type '(radio (const :format "Enable " ENABLE) - (const :format "Disable " DISABLE))) - -(defcustom gnus-agent-expire-unagentized-dirs t - "*Whether expiration should expire in unagentized directories. -Have gnus-agent-expire scan the directories under -\(gnus-agent-directory) for groups that are no longer agentized. -When found, offer to remove them." - :version "22.1" - :type 'boolean - :group 'gnus-agent) - -(defcustom gnus-agent-auto-agentize-methods '(nntp nnimap) - "Initially, all servers from these methods are agentized. -The user may remove or add servers using the Server buffer. -See Info node `(gnus)Server Buffer'." - :version "22.1" - :type '(repeat symbol) - :group 'gnus-agent) - -(defcustom gnus-agent-queue-mail t - "Whether and when outgoing mail should be queued by the agent. -When `always', always queue outgoing mail. When nil, never -queue. Otherwise, queue if and only if unplugged." - :version "22.1" - :group 'gnus-agent - :type '(radio (const :format "Always" always) - (const :format "Never" nil) - (const :format "When unplugged" t))) - -(defcustom gnus-agent-prompt-send-queue nil - "If non-nil, `gnus-group-send-queue' will prompt if called when -unplugged." - :version "22.1" - :group 'gnus-agent - :type 'boolean) - -(defcustom gnus-agent-article-alist-save-format 1 - "Indicates whether to use compression(2), versus no -compression(1), when writing agentview files. The compressed -files do save space but load times are 6-7 times higher. A group -must be opened then closed for the agentview to be updated using -the new format." - ;; Wouldn't symbols instead numbers be nicer? --rsteib - :version "22.1" - :group 'gnus-agent - :type '(radio (const :format "Compressed" 2) - (const :format "Uncompressed" 1))) - -;;; Internal variables - -(defvar gnus-agent-history-buffers nil) -(defvar gnus-agent-buffer-alist nil) -(defvar gnus-agent-article-alist nil - "An assoc list identifying the articles whose headers have been fetched. -If successfully fetched, these headers will be stored in the group's overview -file. The key of each assoc pair is the article ID, the value of each assoc -pair is a flag indicating whether the identified article has been downloaded -\(gnus-agent-fetch-articles sets the value to the day of the download). -NOTES: -1) The last element of this list can not be expired as some - routines (for example, get-agent-fetch-headers) use the last - value to track which articles have had their headers retrieved. -2) The function `gnus-agent-regenerate' may destructively modify the value.") -(defvar gnus-agent-group-alist nil) -(defvar gnus-category-alist nil) -(defvar gnus-agent-current-history nil) -(defvar gnus-agent-overview-buffer nil) -(defvar gnus-category-predicate-cache nil) -(defvar gnus-category-group-cache nil) -(defvar gnus-agent-spam-hashtb nil) -(defvar gnus-agent-file-name nil) -(defvar gnus-agent-send-mail-function nil) -(defvar gnus-agent-file-coding-system 'raw-text) -(defvar gnus-agent-file-loading-cache nil) - -;; Dynamic variables -(defvar gnus-headers) -(defvar gnus-score) - -;;; -;;; Setup -;;; - -(defun gnus-open-agent () - (setq gnus-agent t) - (gnus-agent-read-servers) - (gnus-category-read) - (gnus-agent-create-buffer) - (add-hook 'gnus-group-mode-hook 'gnus-agent-mode) - (add-hook 'gnus-summary-mode-hook 'gnus-agent-mode) - (add-hook 'gnus-server-mode-hook 'gnus-agent-mode)) - -(defun gnus-agent-create-buffer () - (if (gnus-buffer-live-p gnus-agent-overview-buffer) - t - (setq gnus-agent-overview-buffer - (gnus-get-buffer-create " *Gnus agent overview*")) - (with-current-buffer gnus-agent-overview-buffer - (mm-enable-multibyte)) - nil)) - -(gnus-add-shutdown 'gnus-close-agent 'gnus) - -(defun gnus-close-agent () - (setq gnus-category-predicate-cache nil - gnus-category-group-cache nil - gnus-agent-spam-hashtb nil) - (gnus-kill-buffer gnus-agent-overview-buffer)) - -;;; -;;; Utility functions -;;; - -(defun gnus-agent-read-file (file) - "Load FILE and do a `read' there." - (with-temp-buffer - (ignore-errors - (nnheader-insert-file-contents file) - (goto-char (point-min)) - (read (current-buffer))))) - -(defsubst gnus-agent-method () - (concat (symbol-name (car gnus-command-method)) "/" - (if (equal (cadr gnus-command-method) "") - "unnamed" - (cadr gnus-command-method)))) - -(defsubst gnus-agent-directory () - "The name of the Gnus agent directory." - (nnheader-concat gnus-agent-directory - (nnheader-translate-file-chars (gnus-agent-method)) "/")) - -(defun gnus-agent-lib-file (file) - "The full name of the Gnus agent library FILE." - (expand-file-name file - (file-name-as-directory - (expand-file-name "agent.lib" (gnus-agent-directory))))) - -(defun gnus-agent-cat-set-property (category property value) - (if value - (setcdr (or (assq property category) - (let ((cell (cons property nil))) - (setcdr category (cons cell (cdr category))) - cell)) value) - (let ((category category)) - (while (cond ((eq property (caadr category)) - (setcdr category (cddr category)) - nil) - (t - (setq category (cdr category))))))) - category) - -(eval-when-compile - (defmacro gnus-agent-cat-defaccessor (name prop-name) - "Define accessor and setter methods for manipulating a list of the form -\(NAME (PROPERTY1 VALUE1) ... (PROPERTY_N VALUE_N)). -Given the call (gnus-agent-cat-defaccessor func PROPERTY1), the list may be -manipulated as follows: - (func LIST): Returns VALUE1 - (setf (func LIST) NEW_VALUE1): Replaces VALUE1 with NEW_VALUE1." - `(progn (defmacro ,name (category) - (list (quote cdr) (list (quote assq) - (quote (quote ,prop-name)) category))) - - (define-setf-method ,name (category) - (let* ((--category--temp-- (make-symbol "--category--")) - (--value--temp-- (make-symbol "--value--"))) - (list (list --category--temp--) ; temporary-variables - (list category) ; value-forms - (list --value--temp--) ; store-variables - (let* ((category --category--temp--) ; store-form - (value --value--temp--)) - (list (quote gnus-agent-cat-set-property) - category - (quote (quote ,prop-name)) - value)) - (list (quote ,name) --category--temp--) ; access-form - ))))) - ) - -(defmacro gnus-agent-cat-name (category) - `(car ,category)) - -(gnus-agent-cat-defaccessor - gnus-agent-cat-days-until-old agent-days-until-old) -(gnus-agent-cat-defaccessor - gnus-agent-cat-enable-expiration agent-enable-expiration) -(gnus-agent-cat-defaccessor - gnus-agent-cat-groups agent-groups) -(gnus-agent-cat-defaccessor - gnus-agent-cat-high-score agent-high-score) -(gnus-agent-cat-defaccessor - gnus-agent-cat-length-when-long agent-long-article) -(gnus-agent-cat-defaccessor - gnus-agent-cat-length-when-short agent-short-article) -(gnus-agent-cat-defaccessor - gnus-agent-cat-low-score agent-low-score) -(gnus-agent-cat-defaccessor - gnus-agent-cat-predicate agent-predicate) -(gnus-agent-cat-defaccessor - gnus-agent-cat-score-file agent-score) -(gnus-agent-cat-defaccessor - gnus-agent-cat-enable-undownloaded-faces agent-enable-undownloaded-faces) - - -;; This form is equivalent to defsetf except that it calls make-symbol -;; whereas defsetf calls gensym (Using gensym creates a run-time -;; dependency on the CL library). - -(eval-and-compile - (define-setf-method gnus-agent-cat-groups (category) - (let* ((--category--temp-- (make-symbol "--category--")) - (--groups--temp-- (make-symbol "--groups--"))) - (list (list --category--temp--) - (list category) - (list --groups--temp--) - (let* ((category --category--temp--) - (groups --groups--temp--)) - (list (quote gnus-agent-set-cat-groups) category groups)) - (list (quote gnus-agent-cat-groups) --category--temp--)))) - ) - -(defun gnus-agent-set-cat-groups (category groups) - (unless (eq groups 'ignore) - (let ((new-g groups) - (old-g (gnus-agent-cat-groups category))) - (cond ((eq new-g old-g) - ;; gnus-agent-add-group is fiddling with the group - ;; list. Still, Im done. - nil - ) - ((eq new-g (cdr old-g)) - ;; gnus-agent-add-group is fiddling with the group list - (setcdr (or (assq 'agent-groups category) - (let ((cell (cons 'agent-groups nil))) - (setcdr category (cons cell (cdr category))) - cell)) new-g)) - (t - (let ((groups groups)) - (while groups - (let* ((group (pop groups)) - (old-category (gnus-group-category group))) - (if (eq category old-category) - nil - (setf (gnus-agent-cat-groups old-category) - (delete group (gnus-agent-cat-groups - old-category)))))) - ;; Purge cache as preceeding loop invalidated it. - (setq gnus-category-group-cache nil)) - - (setcdr (or (assq 'agent-groups category) - (let ((cell (cons 'agent-groups nil))) - (setcdr category (cons cell (cdr category))) - cell)) groups)))))) - -(defsubst gnus-agent-cat-make (name &optional default-agent-predicate) - (list name `(agent-predicate . ,(or default-agent-predicate 'false)))) - -;;; Fetching setup functions. - -(defun gnus-agent-start-fetch () - "Initialize data structures for efficient fetching." - (gnus-agent-create-buffer)) - -(defun gnus-agent-stop-fetch () - "Save all data structures and clean up." - (setq gnus-agent-spam-hashtb nil) - (save-excursion - (set-buffer nntp-server-buffer) - (widen))) - -(defmacro gnus-agent-with-fetch (&rest forms) - "Do FORMS safely." - `(unwind-protect - (let ((gnus-agent-fetching t)) - (gnus-agent-start-fetch) - ,@forms) - (gnus-agent-stop-fetch))) - -(put 'gnus-agent-with-fetch 'lisp-indent-function 0) -(put 'gnus-agent-with-fetch 'edebug-form-spec '(body)) - -(defmacro gnus-agent-append-to-list (tail value) - `(setq ,tail (setcdr ,tail (cons ,value nil)))) - -(defmacro gnus-agent-message (level &rest args) - `(if (<= ,level gnus-verbose) - (message ,@args))) - -;;; -;;; Mode infestation -;;; - -(defvar gnus-agent-mode-hook nil - "Hook run when installing agent mode.") - -(defvar gnus-agent-mode nil) -(defvar gnus-agent-mode-status '(gnus-agent-mode " Plugged")) - -(defun gnus-agent-mode () - "Minor mode for providing a agent support in Gnus buffers." - (let* ((buffer (progn (string-match "^gnus-\\(.*\\)-mode$" - (symbol-name major-mode)) - (match-string 1 (symbol-name major-mode)))) - (mode (intern (format "gnus-agent-%s-mode" buffer)))) - (set (make-local-variable 'gnus-agent-mode) t) - (set mode nil) - (set (make-local-variable mode) t) - ;; Set up the menu. - (when (gnus-visual-p 'agent-menu 'menu) - (funcall (intern (format "gnus-agent-%s-make-menu-bar" buffer)))) - (unless (assq 'gnus-agent-mode minor-mode-alist) - (push gnus-agent-mode-status minor-mode-alist)) - (unless (assq mode minor-mode-map-alist) - (push (cons mode (symbol-value (intern (format "gnus-agent-%s-mode-map" - buffer)))) - minor-mode-map-alist)) - (when (eq major-mode 'gnus-group-mode) - (let ((init-plugged gnus-plugged) - (gnus-agent-go-online nil)) - ;; g-a-t-p does nothing when gnus-plugged isn't changed. - ;; Therefore, make certain that the current value does not - ;; match the desired initial value. - (setq gnus-plugged :unknown) - (gnus-agent-toggle-plugged init-plugged))) - (gnus-run-hooks 'gnus-agent-mode-hook - (intern (format "gnus-agent-%s-mode-hook" buffer))))) - -(defvar gnus-agent-group-mode-map (make-sparse-keymap)) -(gnus-define-keys gnus-agent-group-mode-map - "Ju" gnus-agent-fetch-groups - "Jc" gnus-enter-category-buffer - "Jj" gnus-agent-toggle-plugged - "Js" gnus-agent-fetch-session - "JY" gnus-agent-synchronize-flags - "JS" gnus-group-send-queue - "Ja" gnus-agent-add-group - "Jr" gnus-agent-remove-group - "Jo" gnus-agent-toggle-group-plugged) - -(defun gnus-agent-group-make-menu-bar () - (unless (boundp 'gnus-agent-group-menu) - (easy-menu-define - gnus-agent-group-menu gnus-agent-group-mode-map "" - '("Agent" - ["Toggle plugged" gnus-agent-toggle-plugged t] - ["Toggle group plugged" gnus-agent-toggle-group-plugged t] - ["List categories" gnus-enter-category-buffer t] - ["Add (current) group to category" gnus-agent-add-group t] - ["Remove (current) group from category" gnus-agent-remove-group t] - ["Send queue" gnus-group-send-queue gnus-plugged] - ("Fetch" - ["All" gnus-agent-fetch-session gnus-plugged] - ["Group" gnus-agent-fetch-group gnus-plugged]) - ["Synchronize flags" gnus-agent-synchronize-flags t] - )))) - -(defvar gnus-agent-summary-mode-map (make-sparse-keymap)) -(gnus-define-keys gnus-agent-summary-mode-map - "Jj" gnus-agent-toggle-plugged - "Ju" gnus-agent-summary-fetch-group - "JS" gnus-agent-fetch-group - "Js" gnus-agent-summary-fetch-series - "J#" gnus-agent-mark-article - "J\M-#" gnus-agent-unmark-article - "@" gnus-agent-toggle-mark - "Jc" gnus-agent-catchup) - -(defun gnus-agent-summary-make-menu-bar () - (unless (boundp 'gnus-agent-summary-menu) - (easy-menu-define - gnus-agent-summary-menu gnus-agent-summary-mode-map "" - '("Agent" - ["Toggle plugged" gnus-agent-toggle-plugged t] - ["Mark as downloadable" gnus-agent-mark-article t] - ["Unmark as downloadable" gnus-agent-unmark-article t] - ["Toggle mark" gnus-agent-toggle-mark t] - ["Fetch downloadable" gnus-agent-summary-fetch-group t] - ["Catchup undownloaded" gnus-agent-catchup t])))) - -(defvar gnus-agent-server-mode-map (make-sparse-keymap)) -(gnus-define-keys gnus-agent-server-mode-map - "Jj" gnus-agent-toggle-plugged - "Ja" gnus-agent-add-server - "Jr" gnus-agent-remove-server) - -(defun gnus-agent-server-make-menu-bar () - (unless (boundp 'gnus-agent-server-menu) - (easy-menu-define - gnus-agent-server-menu gnus-agent-server-mode-map "" - '("Agent" - ["Toggle plugged" gnus-agent-toggle-plugged t] - ["Add" gnus-agent-add-server t] - ["Remove" gnus-agent-remove-server t])))) - -(defun gnus-agent-make-mode-line-string (string mouse-button mouse-func) - (if (and (fboundp 'propertize) - (fboundp 'make-mode-line-mouse-map)) - (propertize string 'local-map - (make-mode-line-mouse-map mouse-button mouse-func) - 'mouse-face - (cond ((and (featurep 'xemacs) - ;; XEmacs' `facep' only checks for a face - ;; object, not for a face name, so it's useless - ;; to check with `facep'. - (find-face 'modeline)) - 'modeline) - ((facep 'mode-line-highlight) ;; Emacs 22 - 'mode-line-highlight) - ((facep 'mode-line) ;; Emacs 21 - 'mode-line)) ) - string)) - -(defun gnus-agent-toggle-plugged (set-to) - "Toggle whether Gnus is unplugged or not." - (interactive (list (not gnus-plugged))) - (cond ((eq set-to gnus-plugged) - nil) - (set-to - (setq gnus-plugged set-to) - (gnus-run-hooks 'gnus-agent-plugged-hook) - (setcar (cdr gnus-agent-mode-status) - (gnus-agent-make-mode-line-string " Plugged" - 'mouse-2 - 'gnus-agent-toggle-plugged)) - (gnus-agent-go-online gnus-agent-go-online) - (gnus-agent-possibly-synchronize-flags)) - (t - (gnus-agent-close-connections) - (setq gnus-plugged set-to) - (gnus-run-hooks 'gnus-agent-unplugged-hook) - (setcar (cdr gnus-agent-mode-status) - (gnus-agent-make-mode-line-string " Unplugged" - 'mouse-2 - 'gnus-agent-toggle-plugged)))) - (set-buffer-modified-p t)) - -(defmacro gnus-agent-while-plugged (&rest body) - `(let ((original-gnus-plugged gnus-plugged)) - (unwind-protect - (progn (gnus-agent-toggle-plugged t) - ,@body) - (gnus-agent-toggle-plugged original-gnus-plugged)))) - -(put 'gnus-agent-while-plugged 'lisp-indent-function 0) -(put 'gnus-agent-while-plugged 'edebug-form-spec '(body)) - -(defun gnus-agent-close-connections () - "Close all methods covered by the Gnus agent." - (let ((methods (gnus-agent-covered-methods))) - (while methods - (gnus-close-server (pop methods))))) - -;;;###autoload -(defun gnus-unplugged () - "Start Gnus unplugged." - (interactive) - (setq gnus-plugged nil) - (gnus)) - -;;;###autoload -(defun gnus-plugged () - "Start Gnus plugged." - (interactive) - (setq gnus-plugged t) - (gnus)) - -;;;###autoload -(defun gnus-slave-unplugged (&optional arg) - "Read news as a slave unplugged." - (interactive "P") - (setq gnus-plugged nil) - (gnus arg nil 'slave)) - -;;;###autoload -(defun gnus-agentize () - "Allow Gnus to be an offline newsreader. - -The gnus-agentize function is now called internally by gnus when -gnus-agent is set. If you wish to avoid calling gnus-agentize, -customize gnus-agent to nil. - -This will modify the `gnus-setup-news-hook', and -`message-send-mail-real-function' variables, and install the Gnus agent -minor mode in all Gnus buffers." - (interactive) - (gnus-open-agent) - (add-hook 'gnus-setup-news-hook 'gnus-agent-queue-setup) - (unless gnus-agent-send-mail-function - (setq gnus-agent-send-mail-function - (or message-send-mail-real-function - (function (lambda () (funcall message-send-mail-function)))) - message-send-mail-real-function 'gnus-agent-send-mail)) - - ;; If the servers file doesn't exist, auto-agentize some servers and - ;; save the servers file so this auto-agentizing isn't invoked - ;; again. - (unless (file-exists-p (nnheader-concat gnus-agent-directory "lib/servers")) - (gnus-message 3 "First time agent user, agentizing remote groups...") - (mapc - (lambda (server-or-method) - (let ((method (gnus-server-to-method server-or-method))) - (when (memq (car method) - gnus-agent-auto-agentize-methods) - (push (gnus-method-to-server method) - gnus-agent-covered-methods) - (setq gnus-agent-method-p-cache nil)))) - (cons gnus-select-method gnus-secondary-select-methods)) - (gnus-agent-write-servers))) - -(defun gnus-agent-queue-setup (&optional group-name) - "Make sure the queue group exists. -Optional arg GROUP-NAME allows to specify another group." - (unless (gnus-gethash (format "nndraft:%s" (or group-name "queue")) - gnus-newsrc-hashtb) - (gnus-request-create-group (or group-name "queue") '(nndraft "")) - (let ((gnus-level-default-subscribed 1)) - (gnus-subscribe-group (format "nndraft:%s" (or group-name "queue")) - nil '(nndraft ""))) - (gnus-group-set-parameter - (format "nndraft:%s" (or group-name "queue")) - 'gnus-dummy '((gnus-draft-mode))))) - -(defun gnus-agent-send-mail () - (if (or (not gnus-agent-queue-mail) - (and gnus-plugged (not (eq gnus-agent-queue-mail 'always)))) - (funcall gnus-agent-send-mail-function) - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "\n")) - (replace-match "\n") - (gnus-agent-insert-meta-information 'mail) - (gnus-request-accept-article "nndraft:queue" nil t t))) - -(defun gnus-agent-insert-meta-information (type &optional method) - "Insert meta-information into the message that says how it's to be posted. -TYPE can be either `mail' or `news'. If the latter, then METHOD can -be a select method." - (save-excursion - (message-remove-header gnus-agent-meta-information-header) - (goto-char (point-min)) - (insert gnus-agent-meta-information-header ": " - (symbol-name type) " " (format "%S" method) - "\n") - (forward-char -1) - (while (search-backward "\n" nil t) - (replace-match "\\n" t t)))) - -(defun gnus-agent-restore-gcc () - "Restore GCC field from saved header." - (save-excursion - (goto-char (point-min)) - (while (re-search-forward - (concat "^" (regexp-quote gnus-agent-gcc-header) ":") nil t) - (replace-match "Gcc:" 'fixedcase)))) - -(defun gnus-agent-any-covered-gcc () - (save-restriction - (message-narrow-to-headers) - (let* ((gcc (mail-fetch-field "gcc" nil t)) - (methods (and gcc - (mapcar 'gnus-inews-group-method - (message-unquote-tokens - (message-tokenize-header - gcc " ,"))))) - covered) - (while (and (not covered) methods) - (setq covered (gnus-agent-method-p (car methods)) - methods (cdr methods))) - covered))) - -;;;###autoload -(defun gnus-agent-possibly-save-gcc () - "Save GCC if Gnus is unplugged." - (when (and (not gnus-plugged) (gnus-agent-any-covered-gcc)) - (save-excursion - (goto-char (point-min)) - (let ((case-fold-search t)) - (while (re-search-forward "^gcc:" nil t) - (replace-match (concat gnus-agent-gcc-header ":") 'fixedcase)))))) - -(defun gnus-agent-possibly-do-gcc () - "Do GCC if Gnus is plugged." - (when (or gnus-plugged (not (gnus-agent-any-covered-gcc))) - (gnus-inews-do-gcc))) - -;;; -;;; Group mode commands -;;; - -(defun gnus-agent-fetch-groups (n) - "Put all new articles in the current groups into the Agent." - (interactive "P") - (unless gnus-plugged - (error "Groups can't be fetched when Gnus is unplugged")) - (gnus-group-iterate n 'gnus-agent-fetch-group)) - -(defun gnus-agent-fetch-group (&optional group) - "Put all new articles in GROUP into the Agent." - (interactive (list (gnus-group-group-name))) - (setq group (or group gnus-newsgroup-name)) - (unless group - (error "No group on the current line")) - - (gnus-agent-while-plugged - (let ((gnus-command-method (gnus-find-method-for-group group))) - (gnus-agent-with-fetch - (gnus-agent-fetch-group-1 group gnus-command-method) - (gnus-message 5 "Fetching %s...done" group))))) - -(defun gnus-agent-add-group (category arg) - "Add the current group to an agent category." - (interactive - (list - (intern - (completing-read - "Add to category: " - (mapcar (lambda (cat) (list (symbol-name (car cat)))) - gnus-category-alist) - nil t)) - current-prefix-arg)) - (let ((cat (assq category gnus-category-alist)) - c groups) - (gnus-group-iterate arg - (lambda (group) - (when (gnus-agent-cat-groups (setq c (gnus-group-category group))) - (setf (gnus-agent-cat-groups c) - (delete group (gnus-agent-cat-groups c)))) - (push group groups))) - (setf (gnus-agent-cat-groups cat) - (nconc (gnus-agent-cat-groups cat) groups)) - (gnus-category-write))) - -(defun gnus-agent-remove-group (arg) - "Remove the current group from its agent category, if any." - (interactive "P") - (let (c) - (gnus-group-iterate arg - (lambda (group) - (when (gnus-agent-cat-groups (setq c (gnus-group-category group))) - (setf (gnus-agent-cat-groups c) - (delete group (gnus-agent-cat-groups c)))))) - (gnus-category-write))) - -(defun gnus-agent-synchronize-flags () - "Synchronize unplugged flags with servers." - (interactive) - (save-excursion - (dolist (gnus-command-method (gnus-agent-covered-methods)) - (when (file-exists-p (gnus-agent-lib-file "flags")) - (gnus-agent-synchronize-flags-server gnus-command-method))))) - -(defun gnus-agent-possibly-synchronize-flags () - "Synchronize flags according to `gnus-agent-synchronize-flags'." - (interactive) - (save-excursion - (dolist (gnus-command-method (gnus-agent-covered-methods)) - (when (and (file-exists-p (gnus-agent-lib-file "flags")) - (eq (gnus-server-status gnus-command-method) 'ok)) - (gnus-agent-possibly-synchronize-flags-server gnus-command-method))))) - -(defun gnus-agent-synchronize-flags-server (method) - "Synchronize flags set when unplugged for server." - (let ((gnus-command-method method) - (gnus-agent nil)) - (when (file-exists-p (gnus-agent-lib-file "flags")) - (set-buffer (get-buffer-create " *Gnus Agent flag synchronize*")) - (erase-buffer) - (nnheader-insert-file-contents (gnus-agent-lib-file "flags")) - (cond ((null gnus-plugged) - (gnus-message - 1 "You must be plugged to synchronize flags with server %s" - (nth 1 gnus-command-method))) - ((null (gnus-check-server gnus-command-method)) - (gnus-message - 1 "Couldn't open server %s" (nth 1 gnus-command-method))) - (t - (condition-case err - (while t - (let ((bgn (point))) - (eval (read (current-buffer))) - (delete-region bgn (point)))) - (end-of-file - (delete-file (gnus-agent-lib-file "flags"))) - (error - (let ((file (gnus-agent-lib-file "flags"))) - (write-region (point-min) (point-max) - (gnus-agent-lib-file "flags") nil 'silent) - (error "Couldn't set flags from file %s due to %s" - file (error-message-string err))))))) - (kill-buffer nil)))) - -(defun gnus-agent-possibly-synchronize-flags-server (method) - "Synchronize flags for server according to `gnus-agent-synchronize-flags'." - (when (or (and gnus-agent-synchronize-flags - (not (eq gnus-agent-synchronize-flags 'ask))) - (and (eq gnus-agent-synchronize-flags 'ask) - (gnus-y-or-n-p (format "Synchronize flags on server `%s'? " - (cadr method))))) - (gnus-agent-synchronize-flags-server method))) - -;;;###autoload -(defun gnus-agent-rename-group (old-group new-group) - "Rename fully-qualified OLD-GROUP as NEW-GROUP. -Always updates the agent, even when disabled, as the old agent -files would corrupt gnus when the agent was next enabled. -Depends upon the caller to determine whether group renaming is -supported." - (let* ((old-command-method (gnus-find-method-for-group old-group)) - (old-path (directory-file-name - (let (gnus-command-method old-command-method) - (gnus-agent-group-pathname old-group)))) - (new-command-method (gnus-find-method-for-group new-group)) - (new-path (directory-file-name - (let (gnus-command-method new-command-method) - (gnus-agent-group-pathname new-group))))) - (gnus-rename-file old-path new-path t) - - (let* ((old-real-group (gnus-group-real-name old-group)) - (new-real-group (gnus-group-real-name new-group)) - (old-active (gnus-agent-get-group-info old-command-method old-real-group))) - (gnus-agent-save-group-info old-command-method old-real-group nil) - (gnus-agent-save-group-info new-command-method new-real-group old-active) - - (let ((old-local (gnus-agent-get-local old-group - old-real-group old-command-method))) - (gnus-agent-set-local old-group - nil nil - old-real-group old-command-method) - (gnus-agent-set-local new-group - (car old-local) (cdr old-local) - new-real-group new-command-method))))) - -;;;###autoload -(defun gnus-agent-delete-group (group) - "Delete fully-qualified GROUP. -Always updates the agent, even when disabled, as the old agent -files would corrupt gnus when the agent was next enabled. -Depends upon the caller to determine whether group deletion is -supported." - (let* ((command-method (gnus-find-method-for-group group)) - (path (directory-file-name - (let (gnus-command-method command-method) - (gnus-agent-group-pathname group))))) - (gnus-delete-directory path) - - (let* ((real-group (gnus-group-real-name group))) - (gnus-agent-save-group-info command-method real-group nil) - - (let ((local (gnus-agent-get-local group - real-group command-method))) - (gnus-agent-set-local group - nil nil - real-group command-method))))) - -;;; -;;; Server mode commands -;;; - -(defun gnus-agent-add-server () - "Enroll SERVER in the agent program." - (interactive) - (let* ((server (gnus-server-server-name)) - (named-server (gnus-server-named-server)) - (method (and server - (gnus-server-get-method nil server)))) - (unless server - (error "No server on the current line")) - - (when (gnus-agent-method-p method) - (error "Server already in the agent program")) - - (push named-server gnus-agent-covered-methods) - - (setq gnus-agent-method-p-cache nil) - (gnus-server-update-server server) - (gnus-agent-write-servers) - (gnus-message 1 "Entered %s into the Agent" server))) - -(defun gnus-agent-remove-server () - "Remove SERVER from the agent program." - (interactive) - (let* ((server (gnus-server-server-name)) - (named-server (gnus-server-named-server))) - (unless server - (error "No server on the current line")) - - (unless (member named-server gnus-agent-covered-methods) - (error "Server not in the agent program")) - - (setq gnus-agent-covered-methods - (delete named-server gnus-agent-covered-methods) - gnus-agent-method-p-cache nil) - - (gnus-server-update-server server) - (gnus-agent-write-servers) - (gnus-message 1 "Removed %s from the agent" server))) - -(defun gnus-agent-read-servers () - "Read the alist of covered servers." - (setq gnus-agent-covered-methods - (gnus-agent-read-file - (nnheader-concat gnus-agent-directory "lib/servers")) - gnus-agent-method-p-cache nil) - - ;; I am called so early in start-up that I can not validate server - ;; names. When that is the case, I skip the validation. That is - ;; alright as the gnus startup code calls the validate methods - ;; directly. - (if gnus-server-alist - (gnus-agent-read-servers-validate))) - -(defun gnus-agent-read-servers-validate () - (mapcar (lambda (server-or-method) - (let* ((server (if (stringp server-or-method) - server-or-method - (gnus-method-to-server server-or-method))) - (method (gnus-server-to-method server))) - (if method - (unless (member server gnus-agent-covered-methods) - (push server gnus-agent-covered-methods) - (setq gnus-agent-method-p-cache nil)) - (gnus-message 1 "Ignoring disappeared server `%s'" server)))) - (prog1 gnus-agent-covered-methods - (setq gnus-agent-covered-methods nil)))) - -(defun gnus-agent-read-servers-validate-native (native-method) - (setq gnus-agent-covered-methods - (mapcar (lambda (method) - (if (or (not method) - (equal method native-method)) - "native" - method)) gnus-agent-covered-methods))) - -(defun gnus-agent-write-servers () - "Write the alist of covered servers." - (gnus-make-directory (nnheader-concat gnus-agent-directory "lib")) - (let ((coding-system-for-write nnheader-file-coding-system) - (file-name-coding-system nnmail-pathname-coding-system)) - (with-temp-file (nnheader-concat gnus-agent-directory "lib/servers") - (prin1 gnus-agent-covered-methods - (current-buffer))))) - -;;; -;;; Summary commands -;;; - -(defun gnus-agent-mark-article (n &optional unmark) - "Mark the next N articles as downloadable. -If N is negative, mark backward instead. If UNMARK is non-nil, remove -the mark instead. The difference between N and the actual number of -articles marked is returned." - (interactive "p") - (let ((backward (< n 0)) - (n (abs n))) - (while (and - (> n 0) - (progn - (gnus-summary-set-agent-mark - (gnus-summary-article-number) unmark) - (zerop (gnus-summary-next-subject (if backward -1 1) nil t)))) - (setq n (1- n))) - (when (/= 0 n) - (gnus-message 7 "No more articles")) - (gnus-summary-recenter) - (gnus-summary-position-point) - n)) - -(defun gnus-agent-unmark-article (n) - "Remove the downloadable mark from the next N articles. -If N is negative, unmark backward instead. The difference between N and -the actual number of articles unmarked is returned." - (interactive "p") - (gnus-agent-mark-article n t)) - -(defun gnus-agent-toggle-mark (n) - "Toggle the downloadable mark from the next N articles. -If N is negative, toggle backward instead. The difference between N and -the actual number of articles toggled is returned." - (interactive "p") - (gnus-agent-mark-article n 'toggle)) - -(defun gnus-summary-set-agent-mark (article &optional unmark) - "Mark ARTICLE as downloadable. If UNMARK is nil, article is marked. -When UNMARK is t, the article is unmarked. For any other value, the -article's mark is toggled." - (let ((unmark (cond ((eq nil unmark) - nil) - ((eq t unmark) - t) - (t - (memq article gnus-newsgroup-downloadable))))) - (when (gnus-summary-goto-subject article nil t) - (gnus-summary-update-mark - (if unmark - (progn - (setq gnus-newsgroup-downloadable - (delq article gnus-newsgroup-downloadable)) - (gnus-article-mark article)) - (setq gnus-newsgroup-downloadable - (gnus-add-to-sorted-list gnus-newsgroup-downloadable article)) - gnus-downloadable-mark) - 'unread)))) - -;;;###autoload -(defun gnus-agent-get-undownloaded-list () - "Construct list of articles that have not been downloaded." - (let ((gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name))) - (when (set (make-local-variable 'gnus-newsgroup-agentized) - (gnus-agent-method-p gnus-command-method)) - (let* ((alist (gnus-agent-load-alist gnus-newsgroup-name)) - (headers (sort (mapcar (lambda (h) - (mail-header-number h)) - gnus-newsgroup-headers) '<)) - (cached (and gnus-use-cache gnus-newsgroup-cached)) - (undownloaded (list nil)) - (tail-undownloaded undownloaded) - (unfetched (list nil)) - (tail-unfetched unfetched)) - (while (and alist headers) - (let ((a (caar alist)) - (h (car headers))) - (cond ((< a h) - ;; Ignore IDs in the alist that are not being - ;; displayed in the summary. - (setq alist (cdr alist))) - ((> a h) - ;; Headers that are not in the alist should be - ;; fictious (see nnagent-retrieve-headers); they - ;; imply that this article isn't in the agent. - (gnus-agent-append-to-list tail-undownloaded h) - (gnus-agent-append-to-list tail-unfetched h) - (setq headers (cdr headers))) - ((cdar alist) - (setq alist (cdr alist)) - (setq headers (cdr headers)) - nil ; ignore already downloaded - ) - (t - (setq alist (cdr alist)) - (setq headers (cdr headers)) - - ;; This article isn't in the agent. Check to see - ;; if it is in the cache. If it is, it's been - ;; downloaded. - (while (and cached (< (car cached) a)) - (setq cached (cdr cached))) - (unless (equal a (car cached)) - (gnus-agent-append-to-list tail-undownloaded a)))))) - - (while headers - (let ((num (pop headers))) - (gnus-agent-append-to-list tail-undownloaded num) - (gnus-agent-append-to-list tail-unfetched num))) - - (setq gnus-newsgroup-undownloaded (cdr undownloaded) - gnus-newsgroup-unfetched (cdr unfetched)))))) - -(defun gnus-agent-catchup () - "Mark as read all unhandled articles. -An article is unhandled if it is neither cached, nor downloaded, nor -downloadable." - (interactive) - (save-excursion - (let ((articles gnus-newsgroup-undownloaded)) - (when (or gnus-newsgroup-downloadable - gnus-newsgroup-cached) - (setq articles (gnus-sorted-ndifference - (gnus-sorted-ndifference - (gnus-copy-sequence articles) - gnus-newsgroup-downloadable) - gnus-newsgroup-cached))) - - (while articles - (gnus-summary-mark-article - (pop articles) gnus-catchup-mark))) - (gnus-summary-position-point))) - -(defun gnus-agent-summary-fetch-series () - (interactive) - (when gnus-newsgroup-processable - (setq gnus-newsgroup-downloadable - (let* ((dl gnus-newsgroup-downloadable) - (processable (sort (gnus-copy-sequence gnus-newsgroup-processable) '<)) - (gnus-newsgroup-downloadable processable)) - (gnus-agent-summary-fetch-group) - - ;; For each article that I processed that is no longer - ;; undownloaded, remove its processable mark. - - (mapc #'gnus-summary-remove-process-mark - (gnus-sorted-ndifference gnus-newsgroup-processable gnus-newsgroup-undownloaded)) - - ;; The preceeding call to (gnus-agent-summary-fetch-group) - ;; updated the temporary gnus-newsgroup-downloadable to - ;; remove each article successfully fetched. Now, I - ;; update the real gnus-newsgroup-downloadable to only - ;; include undownloaded articles. - (gnus-sorted-ndifference dl (gnus-sorted-ndifference processable gnus-newsgroup-undownloaded)))))) - -(defun gnus-agent-summary-fetch-group (&optional all) - "Fetch the downloadable articles in the group. -Optional arg ALL, if non-nil, means to fetch all articles." - (interactive "P") - (let ((articles - (if all gnus-newsgroup-articles - gnus-newsgroup-downloadable)) - (gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name)) - fetched-articles) - (gnus-agent-while-plugged - (unless articles - (error "No articles to download")) - (gnus-agent-with-fetch - (setq gnus-newsgroup-undownloaded - (gnus-sorted-ndifference - gnus-newsgroup-undownloaded - (setq fetched-articles - (gnus-agent-fetch-articles - gnus-newsgroup-name articles))))) - (save-excursion - (dolist (article articles) - (let ((was-marked-downloadable - (memq article gnus-newsgroup-downloadable))) - (cond (gnus-agent-mark-unread-after-downloaded - (setq gnus-newsgroup-downloadable - (delq article gnus-newsgroup-downloadable)) - - (gnus-summary-mark-article article gnus-unread-mark)) - (was-marked-downloadable - (gnus-summary-set-agent-mark article t))) - (when (gnus-summary-goto-subject article nil t) - (gnus-summary-update-download-mark article)))))) - fetched-articles)) - -(defun gnus-agent-fetch-selected-article () - "Fetch the current article as it is selected. -This can be added to `gnus-select-article-hook' or -`gnus-mark-article-hook'." - (let ((gnus-command-method gnus-current-select-method)) - (when (and gnus-plugged (gnus-agent-method-p gnus-command-method)) - (when (gnus-agent-fetch-articles - gnus-newsgroup-name - (list gnus-current-article)) - (setq gnus-newsgroup-undownloaded - (delq gnus-current-article gnus-newsgroup-undownloaded)) - (gnus-summary-update-download-mark gnus-current-article))))) - -;;; -;;; Internal functions -;;; - -(defun gnus-agent-synchronize-group-flags (group actions server) -"Update a plugged group by performing the indicated actions." - (let* ((gnus-command-method (gnus-server-to-method server)) - (info - ;; This initializer is required as gnus-request-set-mark - ;; calls gnus-group-real-name to strip off the host name - ;; before calling the backend. Now that the backend is - ;; trying to call gnus-request-set-mark, I have to - ;; reconstruct the original group name. - (or (gnus-get-info group) - (gnus-get-info - (setq group (gnus-group-full-name - group gnus-command-method)))))) - (gnus-request-set-mark group actions) - - (when info - (dolist (action actions) - (let ((range (nth 0 action)) - (what (nth 1 action)) - (marks (nth 2 action))) - (dolist (mark marks) - (cond ((eq mark 'read) - (gnus-info-set-read - info - (funcall (if (eq what 'add) - 'gnus-range-add - 'gnus-remove-from-range) - (gnus-info-read info) - range)) - (gnus-get-unread-articles-in-group - info - (gnus-active (gnus-info-group info)))) - ((memq mark '(tick)) - (let ((info-marks (assoc mark (gnus-info-marks info)))) - (unless info-marks - (gnus-info-set-marks info (cons (setq info-marks (list mark)) (gnus-info-marks info)))) - (setcdr info-marks (funcall (if (eq what 'add) - 'gnus-range-add - 'gnus-remove-from-range) - (cdr info-marks) - range)))))))) - - ;;Marks can be synchronized at any time by simply toggling from - ;;unplugged to plugged. If that is what is happening right now, make - ;;sure that the group buffer is up to date. - (when (gnus-buffer-live-p gnus-group-buffer) - (gnus-group-update-group group t))) - nil)) - -(defun gnus-agent-save-active (method) - (when (gnus-agent-method-p method) - (let* ((gnus-command-method method) - (new (gnus-make-hashtable (count-lines (point-min) (point-max)))) - (file (gnus-agent-lib-file "active"))) - (gnus-active-to-gnus-format nil new) - (gnus-agent-write-active file new) - (erase-buffer) - (nnheader-insert-file-contents file)))) - -(defun gnus-agent-write-active (file new) - (gnus-make-directory (file-name-directory file)) - (let ((nnmail-active-file-coding-system gnus-agent-file-coding-system)) - ;; The hashtable contains real names of groups. However, do NOT - ;; add the foreign server prefix as gnus-active-to-gnus-format - ;; will add it while reading the file. - (gnus-write-active-file file new nil))) - -;;;###autoload -(defun gnus-agent-possibly-alter-active (group active &optional info) - "Possibly expand a group's active range to include articles -downloaded into the agent." - (let* ((gnus-command-method (or gnus-command-method - (gnus-find-method-for-group group)))) - (when (gnus-agent-method-p gnus-command-method) - (let* ((local (gnus-agent-get-local group)) - (active-min (or (car active) 0)) - (active-max (or (cdr active) 0)) - (agent-min (or (car local) active-min)) - (agent-max (or (cdr local) active-max))) - - (when (< agent-min active-min) - (setcar active agent-min)) - - (when (> agent-max active-max) - (setcdr active agent-max)) - - (when (and info (< agent-max (- active-min 100))) - ;; I'm expanding the active range by such a large amount - ;; that there is a gap of more than 100 articles between the - ;; last article known to the agent and the first article - ;; currently available on the server. This gap contains - ;; articles that have been lost, mark them as read so that - ;; gnus doesn't waste resources trying to fetch them. - - ;; NOTE: I don't do this for smaller gaps (< 100) as I don't - ;; want to modify the local file everytime someone restarts - ;; gnus. The small gap will cause a tiny performance hit - ;; when gnus tries, and fails, to retrieve the articles. - ;; Still that should be smaller than opening a buffer, - ;; printing this list to the buffer, and then writing it to a - ;; file. - - (let ((read (gnus-info-read info))) - (gnus-info-set-read - info - (gnus-range-add - read - (list (cons (1+ agent-max) - (1- active-min)))))) - - ;; Lie about the agent's local range for this group to - ;; disable the set read each time this server is opened. - ;; NOTE: Opening this group will restore the valid local - ;; range but it will also expand the local range to - ;; incompass the new active range. - (gnus-agent-set-local group agent-min (1- active-min))))))) - -(defun gnus-agent-save-group-info (method group active) - "Update a single group's active range in the agent's copy of the server's active file." - (when (gnus-agent-method-p method) - (let* ((gnus-command-method (or method gnus-command-method)) - (coding-system-for-write nnheader-file-coding-system) - (file-name-coding-system nnmail-pathname-coding-system) - (file (gnus-agent-lib-file "active")) - oactive-min oactive-max) - (gnus-make-directory (file-name-directory file)) - (with-temp-file file - ;; Emacs got problem to match non-ASCII group in multibyte buffer. - (mm-disable-multibyte) - (when (file-exists-p file) - (nnheader-insert-file-contents file) - - (goto-char (point-min)) - (when (re-search-forward - (concat "^" (regexp-quote group) " ") nil t) - (save-excursion - (setq oactive-max (read (current-buffer)) ;; max - oactive-min (read (current-buffer)))) ;; min - (gnus-delete-line))) - (when active - (insert (format "%S %d %d y\n" (intern group) - (max (or oactive-max (cdr active)) (cdr active)) - (min (or oactive-min (car active)) (car active)))) - (goto-char (point-max)) - (while (search-backward "\\." nil t) - (delete-char 1))))))) - -(defun gnus-agent-get-group-info (method group) - "Get a single group's active range in the agent's copy of the server's active file." - (when (gnus-agent-method-p method) - (let* ((gnus-command-method (or method gnus-command-method)) - (coding-system-for-write nnheader-file-coding-system) - (file-name-coding-system nnmail-pathname-coding-system) - (file (gnus-agent-lib-file "active")) - oactive-min oactive-max) - (gnus-make-directory (file-name-directory file)) - (with-temp-buffer - ;; Emacs got problem to match non-ASCII group in multibyte buffer. - (mm-disable-multibyte) - (when (file-exists-p file) - (nnheader-insert-file-contents file) - - (goto-char (point-min)) - (when (re-search-forward - (concat "^" (regexp-quote group) " ") nil t) - (save-excursion - (setq oactive-max (read (current-buffer)) ;; max - oactive-min (read (current-buffer))) ;; min - (cons oactive-min oactive-max)))))))) - -(defun gnus-agent-group-path (group) - "Translate GROUP into a file name." - - ;; NOTE: This is what nnmail-group-pathname does as of Apr 2003. - ;; The two methods must be kept synchronized, which is why - ;; gnus-agent-group-pathname was added. - - (setq group - (nnheader-translate-file-chars - (nnheader-replace-duplicate-chars-in-string - (nnheader-replace-chars-in-string - (gnus-group-real-name (gnus-group-decoded-name group)) - ?/ ?_) - ?. ?_))) - (if (or nnmail-use-long-file-names - (file-directory-p (expand-file-name group (gnus-agent-directory)))) - group - (mm-encode-coding-string - (nnheader-replace-chars-in-string group ?. ?/) - nnmail-pathname-coding-system))) - -(defun gnus-agent-group-pathname (group) - "Translate GROUP into a file name." - ;; nnagent uses nnmail-group-pathname to read articles while - ;; unplugged. The agent must, therefore, use the same directory - ;; while plugged. - (let ((gnus-command-method (or gnus-command-method - (gnus-find-method-for-group group)))) - (nnmail-group-pathname (gnus-group-real-name - (gnus-group-decoded-name group)) - (gnus-agent-directory)))) - -(defun gnus-agent-get-function (method) - (if (gnus-online method) - (car method) - (require 'nnagent) - 'nnagent)) - -(defun gnus-agent-covered-methods () - "Return the subset of methods that are covered by the agent." - (delq nil (mapcar #'gnus-server-to-method gnus-agent-covered-methods))) - -;;; History functions - -(defun gnus-agent-history-buffer () - (cdr (assoc (gnus-agent-method) gnus-agent-history-buffers))) - -(defun gnus-agent-open-history () - (save-excursion - (push (cons (gnus-agent-method) - (set-buffer (gnus-get-buffer-create - (format " *Gnus agent %s history*" - (gnus-agent-method))))) - gnus-agent-history-buffers) - (mm-disable-multibyte) ;; everything is binary - (erase-buffer) - (insert "\n") - (let ((file (gnus-agent-lib-file "history"))) - (when (file-exists-p file) - (nnheader-insert-file-contents file)) - (set (make-local-variable 'gnus-agent-file-name) file)))) - -(defun gnus-agent-close-history () - (when (gnus-buffer-live-p gnus-agent-current-history) - (kill-buffer gnus-agent-current-history) - (setq gnus-agent-history-buffers - (delq (assoc (gnus-agent-method) gnus-agent-history-buffers) - gnus-agent-history-buffers)))) - -;;; -;;; Fetching -;;; - -(defun gnus-agent-fetch-articles (group articles) - "Fetch ARTICLES from GROUP and put them into the Agent." - (when articles - (gnus-agent-load-alist group) - (let* ((alist gnus-agent-article-alist) - (headers (if (< (length articles) 2) nil gnus-newsgroup-headers)) - (selected-sets (list nil)) - (current-set-size 0) - article - header-number) - ;; Check each article - (while (setq article (pop articles)) - ;; Skip alist entries preceeding this article - (while (> article (or (caar alist) (1+ article))) - (setq alist (cdr alist))) - - ;; Prune off articles that we have already fetched. - (unless (and (eq article (caar alist)) - (cdar alist)) - ;; Skip headers preceeding this article - (while (> article - (setq header-number - (let* ((header (car headers))) - (if header - (mail-header-number header) - (1+ article))))) - (setq headers (cdr headers))) - - ;; Add this article to the current set - (setcar selected-sets (cons article (car selected-sets))) - - ;; Update the set size, when the set is too large start a - ;; new one. I do this after adding the article as I want at - ;; least one article in each set. - (when (< gnus-agent-max-fetch-size - (setq current-set-size - (+ current-set-size - (if (= header-number article) - (let ((char-size (mail-header-chars - (car headers)))) - (if (<= char-size 0) - ;; The char size was missing/invalid, - ;; assume a worst-case situation of - ;; 65 char/line. If the line count - ;; is missing, arbitrarily assume a - ;; size of 1000 characters. - (max (* 65 (mail-header-lines - (car headers))) - 1000) - char-size)) - 0)))) - (setcar selected-sets (nreverse (car selected-sets))) - (setq selected-sets (cons nil selected-sets) - current-set-size 0)))) - - (when (or (cdr selected-sets) (car selected-sets)) - (let* ((fetched-articles (list nil)) - (tail-fetched-articles fetched-articles) - (dir (gnus-agent-group-pathname group)) - (date (time-to-days (current-time))) - (case-fold-search t) - pos crosses id) - - (setcar selected-sets (nreverse (car selected-sets))) - (setq selected-sets (nreverse selected-sets)) - - (gnus-make-directory dir) - (gnus-message 7 "Fetching articles for %s..." group) - - (unwind-protect - (while (setq articles (pop selected-sets)) - ;; Fetch the articles from the backend. - (if (gnus-check-backend-function 'retrieve-articles group) - (setq pos (gnus-retrieve-articles articles group)) - (with-temp-buffer - (let (article) - (while (setq article (pop articles)) - (gnus-message 10 "Fetching article %s for %s..." - article group) - (when (or - (gnus-backlog-request-article group article - nntp-server-buffer) - (gnus-request-article article group)) - (goto-char (point-max)) - (push (cons article (point)) pos) - (insert-buffer-substring nntp-server-buffer))) - (copy-to-buffer - nntp-server-buffer (point-min) (point-max)) - (setq pos (nreverse pos))))) - ;; Then save these articles into the Agent. - (save-excursion - (set-buffer nntp-server-buffer) - (while pos - (narrow-to-region (cdar pos) (or (cdadr pos) (point-max))) - (goto-char (point-min)) - (unless (eobp) ;; Don't save empty articles. - (when (search-forward "\n\n" nil t) - (when (search-backward "\nXrefs: " nil t) - ;; Handle cross posting. - (goto-char (match-end 0)) ; move to end of header name - (skip-chars-forward "^ ") ; skip server name - (skip-chars-forward " ") - (setq crosses nil) - (while (looking-at "\\([^: \n]+\\):\\([0-9]+\\) *") - (push (cons (buffer-substring (match-beginning 1) - (match-end 1)) - (string-to-number - (buffer-substring (match-beginning 2) - (match-end 2)))) - crosses) - (goto-char (match-end 0))) - (gnus-agent-crosspost crosses (caar pos) date))) - (goto-char (point-min)) - (if (not (re-search-forward - "^Message-ID: *<\\([^>\n]+\\)>" nil t)) - (setq id "No-Message-ID-in-article") - (setq id (buffer-substring - (match-beginning 1) (match-end 1)))) - (let ((coding-system-for-write - gnus-agent-file-coding-system)) - (write-region (point-min) (point-max) - (concat dir (number-to-string (caar pos))) - nil 'silent)) - - (gnus-agent-append-to-list - tail-fetched-articles (caar pos))) - (widen) - (setq pos (cdr pos))))) - - (gnus-agent-save-alist group (cdr fetched-articles) date) - (gnus-message 7 "")) - (cdr fetched-articles)))))) - -(defun gnus-agent-unfetch-articles (group articles) - "Delete ARTICLES that were fetched from GROUP into the agent." - (when articles - (gnus-agent-load-alist group) - (let* ((alist (cons nil gnus-agent-article-alist)) - (articles (sort articles #'<)) - (next-possibility alist) - (delete-this (pop articles))) - (while (and (cdr next-possibility) delete-this) - (let ((have-this (caar (cdr next-possibility)))) - (cond ((< delete-this have-this) - (setq delete-this (pop articles))) - ((= delete-this have-this) - (let ((timestamp (cdar (cdr next-possibility)))) - (when timestamp - (let* ((file-name (concat (gnus-agent-group-pathname group) - (number-to-string have-this)))) - (delete-file file-name)))) - - (setcdr next-possibility (cddr next-possibility))) - (t - (setq next-possibility (cdr next-possibility)))))) - (setq gnus-agent-article-alist (cdr alist)) - (gnus-agent-save-alist group)))) - -(defun gnus-agent-crosspost (crosses article &optional date) - (setq date (or date t)) - - (let (gnus-agent-article-alist group alist beg end) - (save-excursion - (set-buffer gnus-agent-overview-buffer) - (when (nnheader-find-nov-line article) - (forward-word 1) - (setq beg (point)) - (setq end (progn (forward-line 1) (point))))) - (while crosses - (setq group (caar crosses)) - (unless (setq alist (assoc group gnus-agent-group-alist)) - (push (setq alist (list group (gnus-agent-load-alist (caar crosses)))) - gnus-agent-group-alist)) - (setcdr alist (cons (cons (cdar crosses) date) (cdr alist))) - (save-excursion - (set-buffer (gnus-get-buffer-create (format " *Gnus agent overview %s*" - group))) - (when (= (point-max) (point-min)) - (push (cons group (current-buffer)) gnus-agent-buffer-alist) - (ignore-errors - (nnheader-insert-file-contents - (gnus-agent-article-name ".overview" group)))) - (nnheader-find-nov-line (string-to-number (cdar crosses))) - (insert (string-to-number (cdar crosses))) - (insert-buffer-substring gnus-agent-overview-buffer beg end) - (gnus-agent-check-overview-buffer)) - (setq crosses (cdr crosses))))) - -(defun gnus-agent-backup-overview-buffer () - (when gnus-newsgroup-name - (let ((root (gnus-agent-article-name ".overview" gnus-newsgroup-name)) - (cnt 0) - name) - (while (file-exists-p - (setq name (concat root "~" - (int-to-string (setq cnt (1+ cnt))) "~")))) - (write-region (point-min) (point-max) name nil 'no-msg) - (gnus-message 1 "Created backup copy of overview in %s." name))) - t) - -(defun gnus-agent-check-overview-buffer (&optional buffer) - "Check the overview file given for sanity. -In particular, checks that the file is sorted by article number -and that there are no duplicates." - (let ((prev-num -1) - (backed-up nil)) - (save-excursion - (when buffer - (set-buffer buffer)) - (save-restriction - (widen) - (goto-char (point-min)) - - (while (< (point) (point-max)) - (let ((p (point)) - (cur (condition-case nil - (read (current-buffer)) - (error nil)))) - (cond - ((or (not (integerp cur)) - (not (eq (char-after) ?\t))) - (or backed-up - (setq backed-up (gnus-agent-backup-overview-buffer))) - (gnus-message 1 - "Overview buffer contains garbage '%s'." - (buffer-substring - p (gnus-point-at-eol)))) - ((= cur prev-num) - (or backed-up - (setq backed-up (gnus-agent-backup-overview-buffer))) - (gnus-message 1 - "Duplicate overview line for %d" cur) - (delete-region p (progn (forward-line 1) (point)))) - ((< cur prev-num) - (or backed-up - (setq backed-up (gnus-agent-backup-overview-buffer))) - (gnus-message 1 "Overview buffer not sorted!") - (sort-numeric-fields 1 (point-min) (point-max)) - (goto-char (point-min)) - (setq prev-num -1)) - (t - (setq prev-num cur))) - (forward-line 1))))))) - -(defun gnus-agent-flush-cache () - (save-excursion - (while gnus-agent-buffer-alist - (set-buffer (cdar gnus-agent-buffer-alist)) - (let ((coding-system-for-write - gnus-agent-file-coding-system)) - (write-region (point-min) (point-max) - (gnus-agent-article-name ".overview" - (caar gnus-agent-buffer-alist)) - nil 'silent)) - (setq gnus-agent-buffer-alist (cdr gnus-agent-buffer-alist))) - (while gnus-agent-group-alist - (with-temp-file (gnus-agent-article-name - ".agentview" (caar gnus-agent-group-alist)) - (princ (cdar gnus-agent-group-alist)) - (insert "\n") - (princ 1 (current-buffer)) - (insert "\n")) - (setq gnus-agent-group-alist (cdr gnus-agent-group-alist))))) - -;;;###autoload -(defun gnus-agent-find-parameter (group symbol) - "Search for GROUPs SYMBOL in the group's parameters, the group's -topic parameters, the group's category, or the customizable -variables. Returns the first non-nil value found." - (or (gnus-group-find-parameter group symbol t) - (gnus-group-parameter-value (cdr (gnus-group-category group)) symbol t) - (symbol-value - (cdr - (assq symbol - '((agent-short-article . gnus-agent-short-article) - (agent-long-article . gnus-agent-long-article) - (agent-low-score . gnus-agent-low-score) - (agent-high-score . gnus-agent-high-score) - (agent-days-until-old . gnus-agent-expire-days) - (agent-enable-expiration - . gnus-agent-enable-expiration) - (agent-predicate . gnus-agent-predicate))))))) - -(defun gnus-agent-fetch-headers (group &optional force) - "Fetch interesting headers into the agent. The group's overview -file will be updated to include the headers while a list of available -article numbers will be returned." - (let* ((fetch-all (and gnus-agent-consider-all-articles - ;; Do not fetch all headers if the predicate - ;; implies that we only consider unread articles. - (not (gnus-predicate-implies-unread - (gnus-agent-find-parameter group - 'agent-predicate))))) - (articles (if fetch-all - (if gnus-newsgroup-maximum-articles - (let ((active (gnus-active group))) - (gnus-uncompress-range - (cons (max (car active) - (- (cdr active) - gnus-newsgroup-maximum-articles - -1)) - (cdr active)))) - (gnus-uncompress-range (gnus-active group))) - (gnus-list-of-unread-articles group))) - (gnus-decode-encoded-word-function 'identity) - (gnus-decode-encoded-address-function 'identity) - (file (gnus-agent-article-name ".overview" group))) - - (unless fetch-all - ;; Add articles with marks to the list of article headers we want to - ;; fetch. Don't fetch articles solely on the basis of a recent or seen - ;; mark, but do fetch recent or seen articles if they have other, more - ;; interesting marks. (We have to fetch articles with boring marks - ;; because otherwise the agent will remove their marks.) - (dolist (arts (gnus-info-marks (gnus-get-info group))) - (unless (memq (car arts) '(seen recent killed cache)) - (setq articles (gnus-range-add articles (cdr arts))))) - (setq articles (sort (gnus-uncompress-sequence articles) '<))) - - ;; At this point, I have the list of articles to consider for - ;; fetching. This is the list that I'll return to my caller. Some - ;; of these articles may have already been fetched. That's OK as - ;; the fetch article code will filter those out. Internally, I'll - ;; filter this list to just those articles whose headers need to - ;; be fetched. - (let ((articles articles)) - ;; Remove known articles. - (when (and (or gnus-agent-cache - (not gnus-plugged)) - (gnus-agent-load-alist group)) - ;; Remove articles marked as downloaded. - (if fetch-all - ;; I want to fetch all headers in the active range. - ;; Therefore, exclude only those headers that are in the - ;; article alist. - ;; NOTE: This is probably NOT what I want to do after - ;; agent expiration in this group. - (setq articles (gnus-agent-uncached-articles articles group)) - - ;; I want to only fetch those headers that have never been - ;; fetched. Therefore, exclude all headers that are, or - ;; WERE, in the article alist. - (let ((low (1+ (caar (last gnus-agent-article-alist)))) - (high (cdr (gnus-active group)))) - ;; Low can be greater than High when the same group is - ;; fetched twice in the same session {The first fetch will - ;; fill the article alist such that (last - ;; gnus-agent-article-alist) equals (cdr (gnus-active - ;; group))}. The addition of one(the 1+ above) then - ;; forces Low to be greater than High. When this happens, - ;; gnus-list-range-intersection returns nil which - ;; indicates that no headers need to be fetched. -- Kevin - (setq articles (gnus-list-range-intersection - articles (list (cons low high))))))) - - (gnus-message - 10 "gnus-agent-fetch-headers: undownloaded articles are '%s'" - (gnus-compress-sequence articles t)) - - (save-excursion - (set-buffer nntp-server-buffer) - - (if articles - (progn - (gnus-message 7 "Fetching headers for %s..." group) - - ;; Fetch them. - (gnus-make-directory (nnheader-translate-file-chars - (file-name-directory file) t)) - - (unless (eq 'nov (gnus-retrieve-headers articles group)) - (nnvirtual-convert-headers)) - (gnus-agent-check-overview-buffer) - ;; Move these headers to the overview buffer so that - ;; gnus-agent-braid-nov can merge them with the contents - ;; of FILE. - (copy-to-buffer - gnus-agent-overview-buffer (point-min) (point-max)) - ;; NOTE: Call g-a-brand-nov even when the file does not - ;; exist. As a minimum, it will validate the article - ;; numbers already in the buffer. - (gnus-agent-braid-nov group articles file) - (let ((coding-system-for-write - gnus-agent-file-coding-system)) - (gnus-agent-check-overview-buffer) - (write-region (point-min) (point-max) file nil 'silent)) - (gnus-agent-save-alist group articles nil) - articles) - (ignore-errors - (erase-buffer) - (nnheader-insert-file-contents file))))) - articles)) - -(defsubst gnus-agent-read-article-number () - "Reads the article number at point. Returns nil when a valid article number can not be read." - - ;; It is unfortunate but the read function quietly overflows - ;; integer. As a result, I have to use string operations to test - ;; for overflow BEFORE calling read. - (when (looking-at "[0-9]+\t") - (let ((len (- (match-end 0) (match-beginning 0)))) - (cond ((< len 9) - (read (current-buffer))) - ((= len 9) - ;; Many 9 digit base-10 numbers can be represented in a 27-bit int - ;; Back convert from int to string to ensure that this is one of them. - (let* ((str1 (buffer-substring (match-beginning 0) (1- (match-end 0)))) - (num (read (current-buffer))) - (str2 (int-to-string num))) - (when (equal str1 str2) - num))))))) - -(defsubst gnus-agent-copy-nov-line (article) - "Copy the indicated ARTICLE from the overview buffer to the nntp server buffer." - (let (art b e) - (set-buffer gnus-agent-overview-buffer) - (while (and (not (eobp)) - (or (not (setq art (gnus-agent-read-article-number))) - (< art article))) - (forward-line 1)) - (beginning-of-line) - (if (or (eobp) - (not (eq article art))) - (set-buffer nntp-server-buffer) - (setq b (point)) - (setq e (progn (forward-line 1) (point))) - (set-buffer nntp-server-buffer) - (insert-buffer-substring gnus-agent-overview-buffer b e)))) - -(defun gnus-agent-braid-nov (group articles file) - "Merge agent overview data with given file. -Takes unvalidated headers for ARTICLES from -`gnus-agent-overview-buffer' and validated headers from the given -FILE and places the combined valid headers into -`nntp-server-buffer'. This function can be used, when file -doesn't exist, to valid the overview buffer." - (let (start last) - (set-buffer gnus-agent-overview-buffer) - (goto-char (point-min)) - (set-buffer nntp-server-buffer) - (erase-buffer) - (when (file-exists-p file) - (nnheader-insert-file-contents file)) - (goto-char (point-max)) - (forward-line -1) - - (unless (or (= (point-min) (point-max)) - (< (setq last (read (current-buffer))) (car articles))) - ;; Old and new overlap -- We do it the hard way. - (when (nnheader-find-nov-line (car articles)) - ;; Replacing existing NOV entry - (delete-region (point) (progn (forward-line 1) (point)))) - (gnus-agent-copy-nov-line (pop articles)) - - (ignore-errors - (while articles - (while (let ((art (read (current-buffer)))) - (cond ((< art (car articles)) - (forward-line 1) - t) - ((= art (car articles)) - (beginning-of-line) - (delete-region - (point) (progn (forward-line 1) (point))) - nil) - (t - (beginning-of-line) - nil)))) - - (gnus-agent-copy-nov-line (pop articles))))) - - (goto-char (point-max)) - - ;; Append the remaining lines - (when articles - (when last - (set-buffer gnus-agent-overview-buffer) - (setq start (point)) - (set-buffer nntp-server-buffer)) - - (let ((p (point))) - (insert-buffer-substring gnus-agent-overview-buffer start) - (goto-char p)) - - (setq last (or last -134217728)) - (while (catch 'problems - (let (sort art) - (while (not (eobp)) - (setq art (gnus-agent-read-article-number)) - (cond ((not art) - ;; Bad art num - delete this line - (beginning-of-line) - (delete-region (point) (progn (forward-line 1) (point)))) - ((< art last) - ;; Art num out of order - enable sort - (setq sort t) - (forward-line 1)) - ((= art last) - ;; Bad repeat of art number - delete this line - (beginning-of-line) - (delete-region (point) (progn (forward-line 1) (point)))) - (t - ;; Good art num - (setq last art) - (forward-line 1)))) - (when sort - ;; something is seriously wrong as we simply shouldn't see out-of-order data. - ;; First, we'll fix the sort. - (sort-numeric-fields 1 (point-min) (point-max)) - - ;; but now we have to consider that we may have duplicate rows... - ;; so reset to beginning of file - (goto-char (point-min)) - (setq last -134217728) - - ;; and throw a code that restarts this scan - (throw 'problems t)) - nil)))))) - -;; Keeps the compiler from warning about the free variable in -;; gnus-agent-read-agentview. -(eval-when-compile - (defvar gnus-agent-read-agentview)) - -(defun gnus-agent-load-alist (group) - "Load the article-state alist for GROUP." - ;; Bind free variable that's used in `gnus-agent-read-agentview'. - (let ((gnus-agent-read-agentview group)) - (setq gnus-agent-article-alist - (gnus-cache-file-contents - (gnus-agent-article-name ".agentview" group) - 'gnus-agent-file-loading-cache - 'gnus-agent-read-agentview)))) - -(defun gnus-agent-read-agentview (file) - "Load FILE and do a `read' there." - (with-temp-buffer - (condition-case nil - (progn - (nnheader-insert-file-contents file) - (goto-char (point-min)) - (let ((alist (read (current-buffer))) - (version (condition-case nil (read (current-buffer)) - (end-of-file 0))) - changed-version) - - (cond - ((= version 0) - (let ((inhibit-quit t) - entry) - (gnus-agent-open-history) - (set-buffer (gnus-agent-history-buffer)) - (goto-char (point-min)) - (while (not (eobp)) - (if (and (looking-at - "[^\t\n]+\t\\([0-9]+\\)\t\\([^ \n]+\\) \\([0-9]+\\)") - (string= (match-string 2) - gnus-agent-read-agentview) - (setq entry (assoc (string-to-number (match-string 3)) alist))) - (setcdr entry (string-to-number (match-string 1)))) - (forward-line 1)) - (gnus-agent-close-history) - (setq changed-version t))) - ((= version 1) - (setq changed-version (not (= 1 gnus-agent-article-alist-save-format)))) - ((= version 2) - (let (uncomp) - (mapcar - (lambda (comp-list) - (let ((state (car comp-list)) - (sequence (inline - (gnus-uncompress-range - (cdr comp-list))))) - (mapcar (lambda (article-id) - (setq uncomp (cons (cons article-id state) uncomp))) - sequence))) - alist) - (setq alist (sort uncomp 'car-less-than-car))) - (setq changed-version (not (= 2 gnus-agent-article-alist-save-format))))) - (when changed-version - (let ((gnus-agent-article-alist alist)) - (gnus-agent-save-alist gnus-agent-read-agentview))) - alist)) - (file-error nil)))) - -(defun gnus-agent-save-alist (group &optional articles state) - "Save the article-state alist for GROUP." - (let* ((file-name-coding-system nnmail-pathname-coding-system) - (prev (cons nil gnus-agent-article-alist)) - (all prev) - print-level print-length item article) - (while (setq article (pop articles)) - (while (and (cdr prev) - (< (caadr prev) article)) - (setq prev (cdr prev))) - (cond - ((not (cdr prev)) - (setcdr prev (list (cons article state)))) - ((> (caadr prev) article) - (setcdr prev (cons (cons article state) (cdr prev)))) - ((= (caadr prev) article) - (setcdr (cadr prev) state))) - (setq prev (cdr prev))) - (setq gnus-agent-article-alist (cdr all)) - - (gnus-agent-set-local group - (caar gnus-agent-article-alist) - (caar (last gnus-agent-article-alist))) - - (gnus-make-directory (gnus-agent-article-name "" group)) - (with-temp-file (gnus-agent-article-name ".agentview" group) - (cond ((eq gnus-agent-article-alist-save-format 1) - (princ gnus-agent-article-alist (current-buffer))) - ((eq gnus-agent-article-alist-save-format 2) - (let ((compressed nil)) - (mapcar (lambda (pair) - (let* ((article-id (car pair)) - (day-of-download (cdr pair)) - (comp-list (assq day-of-download compressed))) - (if comp-list - (setcdr comp-list - (cons article-id (cdr comp-list))) - (setq compressed - (cons (list day-of-download article-id) - compressed))) - nil)) gnus-agent-article-alist) - (mapcar (lambda (comp-list) - (setcdr comp-list - (gnus-compress-sequence - (nreverse (cdr comp-list))))) - compressed) - (princ compressed (current-buffer))))) - (insert "\n") - (princ gnus-agent-article-alist-save-format (current-buffer)) - (insert "\n")))) - -(defvar gnus-agent-article-local nil) -(defvar gnus-agent-file-loading-local nil) - -(defun gnus-agent-load-local (&optional method) - "Load the METHOD'S local file. The local file contains min/max -article counts for each of the method's subscribed groups." - (let ((gnus-command-method (or method gnus-command-method))) - (setq gnus-agent-article-local - (gnus-cache-file-contents - (gnus-agent-lib-file "local") - 'gnus-agent-file-loading-local - 'gnus-agent-read-and-cache-local)))) - -(defun gnus-agent-read-and-cache-local (file) - "Load and read FILE then bind its contents to -gnus-agent-article-local. If that variable had `dirty' (also known as -modified) original contents, they are first saved to their own file." - - (if (and gnus-agent-article-local - (symbol-value (intern "+dirty" gnus-agent-article-local))) - (gnus-agent-save-local)) - (gnus-agent-read-local file)) - -(defun gnus-agent-read-local (file) - "Load FILE and do a `read' there." - (let ((my-obarray (gnus-make-hashtable (count-lines (point-min) - (point-max)))) - (line 1)) - (with-temp-buffer - (condition-case nil - (let ((nnheader-file-coding-system gnus-agent-file-coding-system)) - (nnheader-insert-file-contents file)) - (file-error)) - - (goto-char (point-min)) - ;; Skip any comments at the beginning of the file (the only place where they may appear) - (while (= (following-char) ?\;) - (forward-line 1) - (setq line (1+ line))) - - (while (not (eobp)) - (condition-case err - (let (group - min - max - (cur (current-buffer)) - (obarray my-obarray)) - (setq group (read cur) - min (read cur) - max (read cur)) - - (when (stringp group) - (setq group (intern group my-obarray))) - - ;; NOTE: The '+ 0' ensure that min and max are both numerics. - (set group (cons (+ 0 min) (+ 0 max)))) - (error - (gnus-message 3 "Warning - invalid agent local: %s on line %d: %s" - file line (error-message-string err)))) - (forward-line 1) - (setq line (1+ line)))) - - (set (intern "+dirty" my-obarray) nil) - (set (intern "+method" my-obarray) gnus-command-method) - my-obarray)) - -(defun gnus-agent-save-local (&optional force) - "Save gnus-agent-article-local under it method's agent.lib directory." - (let ((my-obarray gnus-agent-article-local)) - (when (and my-obarray - (or force (symbol-value (intern "+dirty" my-obarray)))) - (let* ((gnus-command-method (symbol-value (intern "+method" my-obarray))) - ;; NOTE: gnus-command-method is used within gnus-agent-lib-file. - (dest (gnus-agent-lib-file "local"))) - (gnus-make-directory (gnus-agent-lib-file "")) - - (let ((buffer-file-coding-system gnus-agent-file-coding-system)) - (with-temp-file dest - (let ((gnus-command-method (symbol-value (intern "+method" my-obarray))) - (file-name-coding-system nnmail-pathname-coding-system) - print-level print-length item article - (standard-output (current-buffer))) - (mapatoms (lambda (symbol) - (cond ((not (boundp symbol)) - nil) - ((member (symbol-name symbol) '("+dirty" "+method")) - nil) - (t - (let ((range (symbol-value symbol))) - (when range - (prin1 symbol) - (princ " ") - (princ (car range)) - (princ " ") - (princ (cdr range)) - (princ "\n")))))) - my-obarray)))))))) - -(defun gnus-agent-get-local (group &optional gmane method) - (let* ((gmane (or gmane (gnus-group-real-name group))) - (gnus-command-method (or method (gnus-find-method-for-group group))) - (local (gnus-agent-load-local)) - (symb (intern gmane local)) - (minmax (and (boundp symb) (symbol-value symb)))) - (unless minmax - ;; Bind these so that gnus-agent-load-alist doesn't change the - ;; current alist (i.e. gnus-agent-article-alist) - (let* ((gnus-agent-article-alist gnus-agent-article-alist) - (gnus-agent-file-loading-cache gnus-agent-file-loading-cache) - (alist (gnus-agent-load-alist group))) - (when alist - (setq minmax - (cons (caar alist) - (caar (last alist)))) - (gnus-agent-set-local group (car minmax) (cdr minmax) - gmane gnus-command-method local)))) - minmax)) - -(defun gnus-agent-set-local (group min max &optional gmane method local) - (let* ((gmane (or gmane (gnus-group-real-name group))) - (gnus-command-method (or method (gnus-find-method-for-group group))) - (local (or local (gnus-agent-load-local))) - (symb (intern gmane local)) - (minmax (and (boundp symb) (symbol-value symb)))) - - (if (cond ((and minmax - (or (not (eq min (car minmax))) - (not (eq max (cdr minmax)))) - min - max) - (setcar minmax min) - (setcdr minmax max) - t) - (minmax - nil) - ((and min max) - (set symb (cons min max)) - t) - (t - (unintern symb local))) - (set (intern "+dirty" local) t)))) - -(defun gnus-agent-article-name (article group) - (expand-file-name article - (file-name-as-directory - (gnus-agent-group-pathname group)))) - -(defun gnus-agent-batch-confirmation (msg) - "Show error message and return t." - (gnus-message 1 msg) - t) - -;;;###autoload -(defun gnus-agent-batch-fetch () - "Start Gnus and fetch session." - (interactive) - (gnus) - (let ((gnus-agent-confirmation-function 'gnus-agent-batch-confirmation)) - (gnus-agent-fetch-session)) - (gnus-group-exit)) - -(defun gnus-agent-fetch-session () - "Fetch all articles and headers that are eligible for fetching." - (interactive) - (unless gnus-agent-covered-methods - (error "No servers are covered by the Gnus agent")) - (unless gnus-plugged - (error "Can't fetch articles while Gnus is unplugged")) - (let ((methods (gnus-agent-covered-methods)) - groups group gnus-command-method) - (save-excursion - (while methods - (setq gnus-command-method (car methods)) - (when (and (or (gnus-server-opened gnus-command-method) - (gnus-open-server gnus-command-method)) - (gnus-online gnus-command-method)) - (setq groups (gnus-groups-from-server (car methods))) - (gnus-agent-with-fetch - (while (setq group (pop groups)) - (when (<= (gnus-group-level group) - gnus-agent-handle-level) - (if (or debug-on-error debug-on-quit) - (gnus-agent-fetch-group-1 - group gnus-command-method) - (condition-case err - (gnus-agent-fetch-group-1 - group gnus-command-method) - (error - (unless (funcall gnus-agent-confirmation-function - (format "Error %s while fetching session. Should gnus continue? " - (error-message-string err))) - (error "Cannot fetch articles into the Gnus agent"))) - (quit - (gnus-agent-regenerate-group group) - (unless (funcall gnus-agent-confirmation-function - (format - "%s while fetching session. Should gnus continue? " - (error-message-string err))) - (signal 'quit - "Cannot fetch articles into the Gnus agent"))))))))) - (setq methods (cdr methods))) - (gnus-run-hooks 'gnus-agent-fetched-hook) - (gnus-message 6 "Finished fetching articles into the Gnus agent")))) - -(defun gnus-agent-fetch-group-1 (group method) - "Fetch GROUP." - (let ((gnus-command-method method) - (gnus-newsgroup-name group) - (gnus-newsgroup-dependencies gnus-newsgroup-dependencies) - (gnus-newsgroup-headers gnus-newsgroup-headers) - (gnus-newsgroup-scored gnus-newsgroup-scored) - (gnus-use-cache gnus-use-cache) - (gnus-summary-expunge-below gnus-summary-expunge-below) - (gnus-summary-mark-below gnus-summary-mark-below) - (gnus-orphan-score gnus-orphan-score) - ;; Maybe some other gnus-summary local variables should also - ;; be put here. - - gnus-headers - gnus-score - articles arts - category predicate info marks score-param - ) - (unless (gnus-check-group group) - (error "Can't open server for %s" group)) - - ;; Fetch headers. - (when (or gnus-newsgroup-active - (gnus-active group) - (gnus-activate-group group)) - (let ((marked-articles gnus-newsgroup-downloadable)) - ;; Identify the articles marked for download - (unless gnus-newsgroup-active - ;; The variable gnus-newsgroup-active was selected as I need - ;; a gnus-summary local variable that is NOT bound to any - ;; value (its global value should default to nil). - (dolist (mark gnus-agent-download-marks) - (let ((arts (cdr (assq mark (gnus-info-marks - (setq info (gnus-get-info group))))))) - (when arts - (setq marked-articles (nconc (gnus-uncompress-range arts) - marked-articles)) - )))) - (setq marked-articles (sort marked-articles '<)) - - ;; Fetch any new articles from the server - (setq articles (gnus-agent-fetch-headers group)) - - ;; Merge new articles with marked - (setq articles (sort (append marked-articles articles) '<)) - - (when articles - ;; Parse them and see which articles we want to fetch. - (setq gnus-newsgroup-dependencies - (or gnus-newsgroup-dependencies - (make-vector (length articles) 0))) - (setq gnus-newsgroup-headers - (or gnus-newsgroup-headers - (gnus-get-newsgroup-headers-xover articles nil nil - group))) - ;; `gnus-agent-overview-buffer' may be killed for - ;; timeout reason. If so, recreate it. - (gnus-agent-create-buffer) - - ;; Figure out how to select articles in this group - (setq category (gnus-group-category group)) - - (setq predicate - (gnus-get-predicate - (gnus-agent-find-parameter group 'agent-predicate))) - - ;; If the selection predicate requires scoring, score each header - (unless (memq predicate '(gnus-agent-true gnus-agent-false)) - (let ((score-param - (gnus-agent-find-parameter group 'agent-score-file))) - ;; Translate score-param into real one - (cond - ((not score-param)) - ((eq score-param 'file) - (setq score-param (gnus-all-score-files group))) - ((stringp (car score-param))) - (t - (setq score-param (list (list score-param))))) - (when score-param - (gnus-score-headers score-param)))) - - (unless (and (eq predicate 'gnus-agent-false) - (not marked-articles)) - (let ((arts (list nil))) - (let ((arts-tail arts) - (alist (gnus-agent-load-alist group)) - (marked-articles marked-articles) - (gnus-newsgroup-headers gnus-newsgroup-headers)) - (while (setq gnus-headers (pop gnus-newsgroup-headers)) - (let ((num (mail-header-number gnus-headers))) - ;; Determine if this article is already in the cache - (while (and alist - (> num (caar alist))) - (setq alist (cdr alist))) - - (unless (and (eq num (caar alist)) - (cdar alist)) - - ;; Determine if this article was marked for download. - (while (and marked-articles - (> num (car marked-articles))) - (setq marked-articles - (cdr marked-articles))) - - ;; When this article is marked, or selected by the - ;; predicate, add it to the download list - (when (or (eq num (car marked-articles)) - (let ((gnus-score - (or (cdr - (assq num gnus-newsgroup-scored)) - gnus-summary-default-score)) - (gnus-agent-long-article - (gnus-agent-find-parameter - group 'agent-long-article)) - (gnus-agent-short-article - (gnus-agent-find-parameter - group 'agent-short-article)) - (gnus-agent-low-score - (gnus-agent-find-parameter - group 'agent-low-score)) - (gnus-agent-high-score - (gnus-agent-find-parameter - group 'agent-high-score)) - (gnus-agent-expire-days - (gnus-agent-find-parameter - group 'agent-days-until-old))) - (funcall predicate))) - (gnus-agent-append-to-list arts-tail num)))))) - - (let (fetched-articles) - ;; Fetch all selected articles - (setq gnus-newsgroup-undownloaded - (gnus-sorted-ndifference - gnus-newsgroup-undownloaded - (setq fetched-articles - (if (cdr arts) - (gnus-agent-fetch-articles group (cdr arts)) - nil)))) - - (let ((unfetched-articles - (gnus-sorted-ndifference (cdr arts) fetched-articles))) - (if gnus-newsgroup-active - ;; Update the summary buffer - (progn - (dolist (article marked-articles) - (gnus-summary-set-agent-mark article t)) - (dolist (article fetched-articles) - (when gnus-agent-mark-unread-after-downloaded - (setq gnus-newsgroup-downloadable - (delq article gnus-newsgroup-downloadable)) - (gnus-summary-mark-article - article gnus-unread-mark)) - (when (gnus-summary-goto-subject article nil t) - (gnus-summary-update-download-mark article))) - (dolist (article unfetched-articles) - (gnus-summary-mark-article - article gnus-canceled-mark))) - - ;; Update the group buffer. - - ;; When some, or all, of the marked articles came - ;; from the download mark. Remove that mark. I - ;; didn't do this earlier as I only want to remove - ;; the marks after the fetch is completed. - - (dolist (mark gnus-agent-download-marks) - (when (eq mark 'download) - (let ((marked-arts - (assq mark (gnus-info-marks - (setq info (gnus-get-info group)))))) - (when (cdr marked-arts) - (setq marks - (delq marked-arts (gnus-info-marks info))) - (gnus-info-set-marks info marks))))) - (let ((read (gnus-info-read - (or info (setq info (gnus-get-info group)))))) - (gnus-info-set-read - info (gnus-add-to-range read unfetched-articles))) - - (gnus-group-update-group group t) - (sit-for 0) - - (gnus-dribble-enter - (concat "(gnus-group-set-info '" - (gnus-prin1-to-string info) - ")")))))))))))) - -;;; -;;; Agent Category Mode -;;; - -(defvar gnus-category-mode-hook nil - "Hook run in `gnus-category-mode' buffers.") - -(defvar gnus-category-line-format " %(%20c%): %g\n" - "Format of category lines. - -Valid specifiers include: -%c Topic name (string) -%g The number of groups in the topic (integer) - -General format specifiers can also be used. See Info node -`(gnus)Formatting Variables'.") - -(defvar gnus-category-mode-line-format "Gnus: %%b" - "The format specification for the category mode line.") - -(defvar gnus-agent-predicate 'false - "The selection predicate used when no other source is available.") - -(defvar gnus-agent-short-article 100 - "Articles that have fewer lines than this are short.") - -(defvar gnus-agent-long-article 200 - "Articles that have more lines than this are long.") - -(defvar gnus-agent-low-score 0 - "Articles that have a score lower than this have a low score.") - -(defvar gnus-agent-high-score 0 - "Articles that have a score higher than this have a high score.") - - -;;; Internal variables. - -(defvar gnus-category-buffer "*Agent Category*") - -(defvar gnus-category-line-format-alist - `((?c gnus-tmp-name ?s) - (?g gnus-tmp-groups ?d))) - -(defvar gnus-category-mode-line-format-alist - `((?u user-defined ?s))) - -(defvar gnus-category-line-format-spec nil) -(defvar gnus-category-mode-line-format-spec nil) - -(defvar gnus-category-mode-map nil) -(put 'gnus-category-mode 'mode-class 'special) - -(unless gnus-category-mode-map - (setq gnus-category-mode-map (make-sparse-keymap)) - (suppress-keymap gnus-category-mode-map) - - (gnus-define-keys gnus-category-mode-map - "q" gnus-category-exit - "k" gnus-category-kill - "c" gnus-category-copy - "a" gnus-category-add - "e" gnus-agent-customize-category - "p" gnus-category-edit-predicate - "g" gnus-category-edit-groups - "s" gnus-category-edit-score - "l" gnus-category-list - - "\C-c\C-i" gnus-info-find-node - "\C-c\C-b" gnus-bug)) - -(defvar gnus-category-menu-hook nil - "*Hook run after the creation of the menu.") - -(defun gnus-category-make-menu-bar () - (gnus-turn-off-edit-menu 'category) - (unless (boundp 'gnus-category-menu) - (easy-menu-define - gnus-category-menu gnus-category-mode-map "" - '("Categories" - ["Add" gnus-category-add t] - ["Kill" gnus-category-kill t] - ["Copy" gnus-category-copy t] - ["Edit category" gnus-agent-customize-category t] - ["Edit predicate" gnus-category-edit-predicate t] - ["Edit score" gnus-category-edit-score t] - ["Edit groups" gnus-category-edit-groups t] - ["Exit" gnus-category-exit t])) - - (gnus-run-hooks 'gnus-category-menu-hook))) - -(defun gnus-category-mode () - "Major mode for listing and editing agent categories. - -All normal editing commands are switched off. -\\ -For more in-depth information on this mode, read the manual -\(`\\[gnus-info-find-node]'). - -The following commands are available: - -\\{gnus-category-mode-map}" - (interactive) - (when (gnus-visual-p 'category-menu 'menu) - (gnus-category-make-menu-bar)) - (kill-all-local-variables) - (gnus-simplify-mode-line) - (setq major-mode 'gnus-category-mode) - (setq mode-name "Category") - (gnus-set-default-directory) - (setq mode-line-process nil) - (use-local-map gnus-category-mode-map) - (buffer-disable-undo) - (setq truncate-lines t) - (setq buffer-read-only t) - (gnus-run-mode-hooks 'gnus-category-mode-hook)) - -(defalias 'gnus-category-position-point 'gnus-goto-colon) - -(defun gnus-category-insert-line (category) - (let* ((gnus-tmp-name (format "%s" (car category))) - (gnus-tmp-groups (length (gnus-agent-cat-groups category)))) - (beginning-of-line) - (gnus-add-text-properties - (point) - (prog1 (1+ (point)) - ;; Insert the text. - (eval gnus-category-line-format-spec)) - (list 'gnus-category gnus-tmp-name)))) - -(defun gnus-enter-category-buffer () - "Go to the Category buffer." - (interactive) - (gnus-category-setup-buffer) - (gnus-configure-windows 'category) - (gnus-category-prepare)) - -(defun gnus-category-setup-buffer () - (unless (get-buffer gnus-category-buffer) - (save-excursion - (set-buffer (gnus-get-buffer-create gnus-category-buffer)) - (gnus-category-mode)))) - -(defun gnus-category-prepare () - (gnus-set-format 'category-mode) - (gnus-set-format 'category t) - (let ((alist gnus-category-alist) - (buffer-read-only nil)) - (erase-buffer) - (while alist - (gnus-category-insert-line (pop alist))) - (goto-char (point-min)) - (gnus-category-position-point))) - -(defun gnus-category-name () - (or (intern (get-text-property (gnus-point-at-bol) 'gnus-category)) - (error "No category on the current line"))) - -(defun gnus-category-read () - "Read the category alist." - (setq gnus-category-alist - (or - (with-temp-buffer - (ignore-errors - (nnheader-insert-file-contents (nnheader-concat gnus-agent-directory "lib/categories")) - (goto-char (point-min)) - ;; This code isn't temp, it will be needed so long as - ;; anyone may be migrating from an older version. - - ;; Once we're certain that people will not revert to an - ;; earlier version, we can take out the old-list code in - ;; gnus-category-write. - (let* ((old-list (read (current-buffer))) - (new-list (ignore-errors (read (current-buffer))))) - (if new-list - new-list - ;; Convert from a positional list to an alist. - (mapcar - (lambda (c) - (setcdr c - (delq nil - (gnus-mapcar - (lambda (valu symb) - (if valu - (cons symb valu))) - (cdr c) - '(agent-predicate agent-score-file agent-groups)))) - c) - old-list))))) - (list (gnus-agent-cat-make 'default 'short))))) - -(defun gnus-category-write () - "Write the category alist." - (setq gnus-category-predicate-cache nil - gnus-category-group-cache nil) - (gnus-make-directory (nnheader-concat gnus-agent-directory "lib")) - (with-temp-file (nnheader-concat gnus-agent-directory "lib/categories") - ;; This prin1 is temporary. It exists so that people can revert - ;; to an earlier version of gnus-agent. - (prin1 (mapcar (lambda (c) - (list (car c) - (cdr (assoc 'agent-predicate c)) - (cdr (assoc 'agent-score-file c)) - (cdr (assoc 'agent-groups c)))) - gnus-category-alist) - (current-buffer)) - (newline) - (prin1 gnus-category-alist (current-buffer)))) - -(defun gnus-category-edit-predicate (category) - "Edit the predicate for CATEGORY." - (interactive (list (gnus-category-name))) - (let ((info (assq category gnus-category-alist))) - (gnus-edit-form - (gnus-agent-cat-predicate info) - (format "Editing the select predicate for category %s" category) - `(lambda (predicate) - ;; Avoid run-time execution of setf form - ;; (setf (gnus-agent-cat-predicate (assq ',category gnus-category-alist)) - ;; predicate) - ;; use its expansion instead: - (gnus-agent-cat-set-property (assq ',category gnus-category-alist) - 'agent-predicate predicate) - - (gnus-category-write) - (gnus-category-list))))) - -(defun gnus-category-edit-score (category) - "Edit the score expression for CATEGORY." - (interactive (list (gnus-category-name))) - (let ((info (assq category gnus-category-alist))) - (gnus-edit-form - (gnus-agent-cat-score-file info) - (format "Editing the score expression for category %s" category) - `(lambda (score-file) - ;; Avoid run-time execution of setf form - ;; (setf (gnus-agent-cat-score-file (assq ',category gnus-category-alist)) - ;; score-file) - ;; use its expansion instead: - (gnus-agent-cat-set-property (assq ',category gnus-category-alist) - 'agent-score-file score-file) - - (gnus-category-write) - (gnus-category-list))))) - -(defun gnus-category-edit-groups (category) - "Edit the group list for CATEGORY." - (interactive (list (gnus-category-name))) - (let ((info (assq category gnus-category-alist))) - (gnus-edit-form - (gnus-agent-cat-groups info) - (format "Editing the group list for category %s" category) - `(lambda (groups) - ;; Avoid run-time execution of setf form - ;; (setf (gnus-agent-cat-groups (assq ',category gnus-category-alist)) - ;; groups) - ;; use its expansion instead: - (gnus-agent-set-cat-groups (assq ',category gnus-category-alist) - groups) - - (gnus-category-write) - (gnus-category-list))))) - -(defun gnus-category-kill (category) - "Kill the current category." - (interactive (list (gnus-category-name))) - (let ((info (assq category gnus-category-alist)) - (buffer-read-only nil)) - (gnus-delete-line) - (setq gnus-category-alist (delq info gnus-category-alist)) - (gnus-category-write))) - -(defun gnus-category-copy (category to) - "Copy the current category." - (interactive (list (gnus-category-name) (intern (read-string "New name: ")))) - (let ((info (assq category gnus-category-alist))) - (push (let ((newcat (gnus-copy-sequence info))) - (setf (gnus-agent-cat-name newcat) to) - (setf (gnus-agent-cat-groups newcat) nil) - newcat) - gnus-category-alist) - (gnus-category-write) - (gnus-category-list))) - -(defun gnus-category-add (category) - "Create a new category." - (interactive "SCategory name: ") - (when (assq category gnus-category-alist) - (error "Category %s already exists" category)) - (push (gnus-agent-cat-make category) - gnus-category-alist) - (gnus-category-write) - (gnus-category-list)) - -(defun gnus-category-list () - "List all categories." - (interactive) - (gnus-category-prepare)) - -(defun gnus-category-exit () - "Return to the group buffer." - (interactive) - (kill-buffer (current-buffer)) - (gnus-configure-windows 'group t)) - -;; To avoid having 8-bit characters in the source file. -(defvar gnus-category-not (list '! 'not (intern (format "%c" 172)))) - -(defvar gnus-category-predicate-alist - '((spam . gnus-agent-spam-p) - (short . gnus-agent-short-p) - (long . gnus-agent-long-p) - (low . gnus-agent-low-scored-p) - (high . gnus-agent-high-scored-p) - (read . gnus-agent-read-p) - (true . gnus-agent-true) - (false . gnus-agent-false)) - "Mapping from short score predicate symbols to predicate functions.") - -(defun gnus-agent-spam-p () - "Say whether an article is spam or not." - (unless gnus-agent-spam-hashtb - (setq gnus-agent-spam-hashtb (gnus-make-hashtable 1000))) - (if (not (equal (mail-header-references gnus-headers) "")) - nil - (let ((string (gnus-simplify-subject (mail-header-subject gnus-headers)))) - (prog1 - (gnus-gethash string gnus-agent-spam-hashtb) - (gnus-sethash string t gnus-agent-spam-hashtb))))) - -(defun gnus-agent-short-p () - "Say whether an article is short or not." - (< (mail-header-lines gnus-headers) gnus-agent-short-article)) - -(defun gnus-agent-long-p () - "Say whether an article is long or not." - (> (mail-header-lines gnus-headers) gnus-agent-long-article)) - -(defun gnus-agent-low-scored-p () - "Say whether an article has a low score or not." - (< gnus-score gnus-agent-low-score)) - -(defun gnus-agent-high-scored-p () - "Say whether an article has a high score or not." - (> gnus-score gnus-agent-high-score)) - -(defun gnus-agent-read-p () - "Say whether an article is read or not." - (gnus-member-of-range (mail-header-number gnus-headers) - (gnus-info-read (gnus-get-info gnus-newsgroup-name)))) - -(defun gnus-category-make-function (predicate) - "Make a function from PREDICATE." - (let ((func (gnus-category-make-function-1 predicate))) - (if (and (= (length func) 1) - (symbolp (car func))) - (car func) - (gnus-byte-compile `(lambda () ,func))))) - -(defun gnus-agent-true () - "Return t." - t) - -(defun gnus-agent-false () - "Return nil." - nil) - -(defun gnus-category-make-function-1 (predicate) - "Make a function from PREDICATE." - (cond - ;; Functions are just returned as is. - ((or (symbolp predicate) - (functionp predicate)) - `(,(or (cdr (assq predicate gnus-category-predicate-alist)) - predicate))) - ;; More complex predicate. - ((consp predicate) - `(,(cond - ((memq (car predicate) '(& and)) - 'and) - ((memq (car predicate) '(| or)) - 'or) - ((memq (car predicate) gnus-category-not) - 'not)) - ,@(mapcar 'gnus-category-make-function-1 (cdr predicate)))) - (t - (error "Unknown predicate type: %s" predicate)))) - -(defun gnus-get-predicate (predicate) - "Return the function implementing PREDICATE." - (or (cdr (assoc predicate gnus-category-predicate-cache)) - (let ((func (gnus-category-make-function predicate))) - (setq gnus-category-predicate-cache - (nconc gnus-category-predicate-cache - (list (cons predicate func)))) - func))) - -(defun gnus-predicate-implies-unread (predicate) - "Say whether PREDICATE implies unread articles only. -It is okay to miss some cases, but there must be no false positives. -That is, if this predicate returns true, then indeed the predicate must -return only unread articles." - (eq t (gnus-function-implies-unread-1 - (gnus-category-make-function-1 predicate)))) - -(defun gnus-function-implies-unread-1 (function) - "Recursively evaluate a predicate function to determine whether it can select -any read articles. Returns t if the function is known to never -return read articles, nil when it is known to always return read -articles, and t_nil when the function may return both read and unread -articles." - (let ((func (car function)) - (args (mapcar 'gnus-function-implies-unread-1 (cdr function)))) - (cond ((eq func 'and) - (cond ((memq t args) ; if any argument returns only unread articles - ;; then that argument constrains the result to only unread articles. - t) - ((memq 't_nil args) ; if any argument is indeterminate - ;; then the result is indeterminate - 't_nil))) - ((eq func 'or) - (cond ((memq nil args) ; if any argument returns read articles - ;; then that argument ensures that the results includes read articles. - nil) - ((memq 't_nil args) ; if any argument is indeterminate - ;; then that argument ensures that the results are indeterminate - 't_nil) - (t ; if all arguments return only unread articles - ;; then the result returns only unread articles - t))) - ((eq func 'not) - (cond ((eq (car args) 't_nil) ; if the argument is indeterminate - ; then the result is indeterminate - (car args)) - (t ; otherwise - ; toggle the result to be the opposite of the argument - (not (car args))))) - ((eq func 'gnus-agent-read-p) - nil) ; The read predicate NEVER returns unread articles - ((eq func 'gnus-agent-false) - t) ; The false predicate returns t as the empty set excludes all read articles - ((eq func 'gnus-agent-true) - nil) ; The true predicate ALWAYS returns read articles - ((catch 'found-match - (let ((alist gnus-category-predicate-alist)) - (while alist - (if (eq func (cdar alist)) - (throw 'found-match t) - (setq alist (cdr alist)))))) - 't_nil) ; All other predicates return read and unread articles - (t - (error "Unknown predicate function: %s" function))))) - -(defun gnus-group-category (group) - "Return the category GROUP belongs to." - (unless gnus-category-group-cache - (setq gnus-category-group-cache (gnus-make-hashtable 1000)) - (let ((cs gnus-category-alist) - groups cat) - (while (setq cat (pop cs)) - (setq groups (gnus-agent-cat-groups cat)) - (while groups - (gnus-sethash (pop groups) cat gnus-category-group-cache))))) - (or (gnus-gethash group gnus-category-group-cache) - (assq 'default gnus-category-alist))) - -(defun gnus-agent-expire-group (group &optional articles force) - "Expire all old articles in GROUP. -If you want to force expiring of certain articles, this function can -take ARTICLES, and FORCE parameters as well. - -The articles on which the expiration process runs are selected as follows: - if ARTICLES is null, all read and unmarked articles. - if ARTICLES is t, all articles. - if ARTICLES is a list, just those articles. -FORCE is equivalent to setting the expiration predicates to true." - (interactive - (list (let ((def (or (gnus-group-group-name) - gnus-newsgroup-name))) - (let ((select (read-string (if def - (concat "Group Name (" - def "): ") - "Group Name: ")))) - (if (and (equal "" select) - def) - def - select))))) - - (if (not group) - (gnus-agent-expire articles group force) - (let ( ;; Bind gnus-agent-expire-stats to enable tracking of - ;; expiration statistics of this single group - (gnus-agent-expire-stats (list 0 0 0.0))) - (if (or (not (eq articles t)) - (yes-or-no-p - (concat "Are you sure that you want to " - "expire all articles in " group "? "))) - (let ((gnus-command-method (gnus-find-method-for-group group)) - (overview (gnus-get-buffer-create " *expire overview*")) - orig) - (unwind-protect - (let ((active-file (gnus-agent-lib-file "active"))) - (when (file-exists-p active-file) - (with-temp-buffer - (nnheader-insert-file-contents active-file) - (gnus-active-to-gnus-format - gnus-command-method - (setq orig (gnus-make-hashtable - (count-lines (point-min) (point-max)))))) - (save-excursion - (gnus-agent-expire-group-1 - group overview (gnus-gethash-safe group orig) - articles force)))) - (kill-buffer overview)))) - (gnus-message 4 (gnus-agent-expire-done-message))))) - -(defun gnus-agent-expire-group-1 (group overview active articles force) - ;; Internal function - requires caller to have set - ;; gnus-command-method, initialized overview buffer, and to have - ;; provided a non-nil active - - (let ((dir (gnus-agent-group-pathname group))) - (when (boundp 'gnus-agent-expire-current-dirs) - (set 'gnus-agent-expire-current-dirs - (cons dir - (symbol-value 'gnus-agent-expire-current-dirs)))) - - (if (and (not force) - (eq 'DISABLE (gnus-agent-find-parameter group - 'agent-enable-expiration))) - (gnus-message 5 "Expiry skipping over %s" group) - (gnus-message 5 "Expiring articles in %s" group) - (gnus-agent-load-alist group) - (let* ((bytes-freed 0) - (files-deleted 0) - (nov-entries-deleted 0) - (info (gnus-get-info group)) - (alist gnus-agent-article-alist) - (day (- (time-to-days (current-time)) - (gnus-agent-find-parameter group 'agent-days-until-old))) - (specials (if (and alist - (not force)) - ;; This could be a bit of a problem. I need to - ;; keep the last article to avoid refetching - ;; headers when using nntp in the backend. At - ;; the same time, if someone uses a backend - ;; that supports article moving then I may have - ;; to remove the last article to complete the - ;; move. Right now, I'm going to assume that - ;; FORCE overrides specials. - (list (caar (last alist))))) - (unreads ;; Articles that are excluded from the - ;; expiration process - (cond (gnus-agent-expire-all - ;; All articles are marked read by global decree - nil) - ((eq articles t) - ;; All articles are marked read by function - ;; parameter - nil) - ((not articles) - ;; Unread articles are marked protected from - ;; expiration Don't call - ;; gnus-list-of-unread-articles as it returns - ;; articles that have not been fetched into the - ;; agent. - (ignore-errors - (gnus-agent-unread-articles group))) - (t - ;; All articles EXCEPT those named by the caller - ;; are protected from expiration - (gnus-sorted-difference - (gnus-uncompress-range - (cons (caar alist) - (caar (last alist)))) - (sort articles '<))))) - (marked ;; More articles that are excluded from the - ;; expiration process - (cond (gnus-agent-expire-all - ;; All articles are unmarked by global decree - nil) - ((eq articles t) - ;; All articles are unmarked by function - ;; parameter - nil) - (articles - ;; All articles may as well be unmarked as the - ;; unreads list already names the articles we are - ;; going to keep - nil) - (t - ;; Ticked and/or dormant articles are excluded - ;; from expiration - (nconc - (gnus-uncompress-range - (cdr (assq 'tick (gnus-info-marks info)))) - (gnus-uncompress-range - (cdr (assq 'dormant - (gnus-info-marks info)))))))) - (nov-file (concat dir ".overview")) - (cnt 0) - (completed -1) - dlist - type) - - ;; The normal article alist contains elements that look like - ;; (article# . fetch_date) I need to combine other - ;; information with this list. For example, a flag indicating - ;; that a particular article MUST BE KEPT. To do this, I'm - ;; going to transform the elements to look like (article# - ;; fetch_date keep_flag NOV_entry_marker) Later, I'll reverse - ;; the process to generate the expired article alist. - - ;; Convert the alist elements to (article# fetch_date nil - ;; nil). - (setq dlist (mapcar (lambda (e) - (list (car e) (cdr e) nil nil)) alist)) - - ;; Convert the keep lists to elements that look like (article# - ;; nil keep_flag nil) then append it to the expanded dlist - ;; These statements are sorted by ascending precidence of the - ;; keep_flag. - (setq dlist (nconc dlist - (mapcar (lambda (e) - (list e nil 'unread nil)) - unreads))) - (setq dlist (nconc dlist - (mapcar (lambda (e) - (list e nil 'marked nil)) - marked))) - (setq dlist (nconc dlist - (mapcar (lambda (e) - (list e nil 'special nil)) - specials))) - - (set-buffer overview) - (erase-buffer) - (buffer-disable-undo) - (when (file-exists-p nov-file) - (gnus-message 7 "gnus-agent-expire: Loading overview...") - (nnheader-insert-file-contents nov-file) - (goto-char (point-min)) - - (let (p) - (while (< (setq p (point)) (point-max)) - (condition-case nil - ;; If I successfully read an integer (the plus zero - ;; ensures a numeric type), prepend a marker entry - ;; to the list - (push (list (+ 0 (read (current-buffer))) nil nil - (set-marker (make-marker) p)) - dlist) - (error - (gnus-message 1 "gnus-agent-expire: read error \ -occurred when reading expression at %s in %s. Skipping to next \ -line." (point) nov-file))) - ;; Whether I succeeded, or failed, it doesn't matter. - ;; Move to the next line then try again. - (forward-line 1))) - - (gnus-message - 7 "gnus-agent-expire: Loading overview... Done")) - (set-buffer-modified-p nil) - - ;; At this point, all of the information is in dlist. The - ;; only problem is that much of it is spread across multiple - ;; entries. Sort then MERGE!! - (gnus-message 7 "gnus-agent-expire: Sorting entries... ") - ;; If two entries have the same article-number then sort by - ;; ascending keep_flag. - (let ((special 0) - (marked 1) - (unread 2)) - (setq dlist - (sort dlist - (lambda (a b) - (cond ((< (nth 0 a) (nth 0 b)) - t) - ((> (nth 0 a) (nth 0 b)) - nil) - (t - (let ((a (or (symbol-value (nth 2 a)) - 3)) - (b (or (symbol-value (nth 2 b)) - 3))) - (<= a b)))))))) - (gnus-message 7 "gnus-agent-expire: Sorting entries... Done") - (gnus-message 7 "gnus-agent-expire: Merging entries... ") - (let ((dlist dlist)) - (while (cdr dlist) ; I'm not at the end-of-list - (if (eq (caar dlist) (caadr dlist)) - (let ((first (cdr (car dlist))) - (secnd (cdr (cadr dlist)))) - (setcar first (or (car first) - (car secnd))) ; fetch_date - (setq first (cdr first) - secnd (cdr secnd)) - (setcar first (or (car first) - (car secnd))) ; Keep_flag - (setq first (cdr first) - secnd (cdr secnd)) - (setcar first (or (car first) - (car secnd))) ; NOV_entry_marker - - (setcdr dlist (cddr dlist))) - (setq dlist (cdr dlist))))) - (gnus-message 7 "gnus-agent-expire: Merging entries... Done") - - (let* ((len (float (length dlist))) - (alist (list nil)) - (tail-alist alist)) - (while dlist - (let ((new-completed (truncate (* 100.0 - (/ (setq cnt (1+ cnt)) - len)))) - message-log-max) - (when (> new-completed completed) - (setq completed new-completed) - (gnus-message 7 "%3d%% completed..." completed))) - (let* ((entry (car dlist)) - (article-number (nth 0 entry)) - (fetch-date (nth 1 entry)) - (keep (nth 2 entry)) - (marker (nth 3 entry))) - - (cond - ;; Kept articles are unread, marked, or special. - (keep - (gnus-agent-message 10 - "gnus-agent-expire: %s:%d: Kept %s article%s." - group article-number keep (if fetch-date " and file" "")) - (when fetch-date - (unless (file-exists-p - (concat dir (number-to-string - article-number))) - (setf (nth 1 entry) nil) - (gnus-agent-message 3 "gnus-agent-expire cleared \ -download flag on %s:%d as the cached article file is missing." - group (caar dlist))) - (unless marker - (gnus-message 1 "gnus-agent-expire detected a \ -missing NOV entry. Run gnus-agent-regenerate-group to restore it."))) - (gnus-agent-append-to-list - tail-alist - (cons article-number fetch-date))) - - ;; The following articles are READ, UNMARKED, and - ;; ORDINARY. See if they can be EXPIRED!!! - ((setq type - (cond - ((not (integerp fetch-date)) - 'read) ;; never fetched article (may expire - ;; right now) - ((not (file-exists-p - (concat dir (number-to-string - article-number)))) - (setf (nth 1 entry) nil) - 'externally-expired) ;; Can't find the cached - ;; article. Handle case - ;; as though this article - ;; was never fetched. - - ;; We now have the arrival day, so we see - ;; whether it's old enough to be expired. - ((< fetch-date day) - 'expired) - (force - 'forced))) - - ;; I found some reason to expire this entry. - - (let ((actions nil)) - (when (memq type '(forced expired)) - (ignore-errors ; Just being paranoid. - (let* ((file-name (nnheader-concat dir (number-to-string - article-number))) - (size (float (nth 7 (file-attributes file-name))))) - (incf bytes-freed size) - (incf files-deleted) - (delete-file file-name)) - (push "expired cached article" actions)) - (setf (nth 1 entry) nil) - ) - - (when marker - (push "NOV entry removed" actions) - (goto-char marker) - - (incf nov-entries-deleted) - - (let ((from (gnus-point-at-bol)) - (to (progn (forward-line 1) (point)))) - (incf bytes-freed (- to from)) - (delete-region from to))) - - ;; If considering all articles is set, I can only - ;; expire article IDs that are no longer in the - ;; active range (That is, articles that preceed the - ;; first article in the new alist). - (if (and gnus-agent-consider-all-articles - (>= article-number (car active))) - ;; I have to keep this ID in the alist - (gnus-agent-append-to-list - tail-alist (cons article-number fetch-date)) - (push (format "Removed %s article number from \ -article alist" type) actions)) - - (when actions - (gnus-agent-message 8 "gnus-agent-expire: %s:%d: %s" - group article-number - (mapconcat 'identity actions ", "))))) - (t - (gnus-agent-message - 10 "gnus-agent-expire: %s:%d: Article kept as \ -expiration tests failed." group article-number) - (gnus-agent-append-to-list - tail-alist (cons article-number fetch-date))) - ) - - ;; Clean up markers as I want to recycle this buffer - ;; over several groups. - (when marker - (set-marker marker nil)) - - (setq dlist (cdr dlist)))) - - (setq alist (cdr alist)) - - (let ((inhibit-quit t)) - (unless (equal alist gnus-agent-article-alist) - (setq gnus-agent-article-alist alist) - (gnus-agent-save-alist group)) - - (when (buffer-modified-p) - (let ((coding-system-for-write - gnus-agent-file-coding-system)) - (gnus-make-directory dir) - (write-region (point-min) (point-max) nov-file nil - 'silent) - ;; clear the modified flag as that I'm not confused by - ;; its status on the next pass through this routine. - (set-buffer-modified-p nil))) - - (when (eq articles t) - (gnus-summary-update-info)))) - - (when (boundp 'gnus-agent-expire-stats) - (let ((stats (symbol-value 'gnus-agent-expire-stats))) - (incf (nth 2 stats) bytes-freed) - (incf (nth 1 stats) files-deleted) - (incf (nth 0 stats) nov-entries-deleted))) - )))) - -(defun gnus-agent-expire (&optional articles group force) - "Expire all old articles. -If you want to force expiring of certain articles, this function can -take ARTICLES, GROUP and FORCE parameters as well. - -The articles on which the expiration process runs are selected as follows: - if ARTICLES is null, all read and unmarked articles. - if ARTICLES is t, all articles. - if ARTICLES is a list, just those articles. -Setting GROUP will limit expiration to that group. -FORCE is equivalent to setting the expiration predicates to true." - (interactive) - - (if group - (gnus-agent-expire-group group articles force) - (if (or (not (eq articles t)) - (yes-or-no-p "Are you sure that you want to expire all \ -articles in every agentized group? ")) - (let ((methods (gnus-agent-covered-methods)) - ;; Bind gnus-agent-expire-current-dirs to enable tracking - ;; of agent directories. - (gnus-agent-expire-current-dirs nil) - ;; Bind gnus-agent-expire-stats to enable tracking of - ;; expiration statistics across all groups - (gnus-agent-expire-stats (list 0 0 0.0)) - gnus-command-method overview orig) - (setq overview (gnus-get-buffer-create " *expire overview*")) - (unwind-protect - (while (setq gnus-command-method (pop methods)) - (let ((active-file (gnus-agent-lib-file "active"))) - (when (file-exists-p active-file) - (with-temp-buffer - (nnheader-insert-file-contents active-file) - (gnus-active-to-gnus-format - gnus-command-method - (setq orig (gnus-make-hashtable - (count-lines (point-min) (point-max)))))) - (dolist (expiring-group (gnus-groups-from-server - gnus-command-method)) - (let* ((active - (gnus-gethash-safe expiring-group orig))) - - (when active - (save-excursion - (gnus-agent-expire-group-1 - expiring-group overview active articles force)))))))) - (kill-buffer overview)) - (gnus-agent-expire-unagentized-dirs) - (gnus-message 4 (gnus-agent-expire-done-message)))))) - -(defun gnus-agent-expire-done-message () - (if (and (> gnus-verbose 4) - (boundp 'gnus-agent-expire-stats)) - (let* ((stats (symbol-value 'gnus-agent-expire-stats)) - (size (nth 2 stats)) - (units '(B KB MB GB))) - (while (and (> size 1024.0) - (cdr units)) - (setq size (/ size 1024.0) - units (cdr units))) - - (format "Expiry recovered %d NOV entries, deleted %d files,\ - and freed %f %s." - (nth 0 stats) - (nth 1 stats) - size (car units))) - "Expiry...done")) - -(defun gnus-agent-expire-unagentized-dirs () - (when (and gnus-agent-expire-unagentized-dirs - (boundp 'gnus-agent-expire-current-dirs)) - (let* ((keep (gnus-make-hashtable)) - ;; Formally bind gnus-agent-expire-current-dirs so that the - ;; compiler will not complain about free references. - (gnus-agent-expire-current-dirs - (symbol-value 'gnus-agent-expire-current-dirs)) - dir) - - (gnus-sethash gnus-agent-directory t keep) - (while gnus-agent-expire-current-dirs - (setq dir (pop gnus-agent-expire-current-dirs)) - (when (and (stringp dir) - (file-directory-p dir)) - (while (not (gnus-gethash dir keep)) - (gnus-sethash dir t keep) - (setq dir (file-name-directory (directory-file-name dir)))))) - - (let* (to-remove - checker - (checker - (function - (lambda (d) - "Given a directory, check it and its subdirectories for - membership in the keep hash. If it isn't found, add - it to to-remove." - (let ((files (directory-files d)) - file) - (while (setq file (pop files)) - (cond ((equal file ".") ; Ignore self - nil) - ((equal file "..") ; Ignore parent - nil) - ((equal file ".overview") - ;; Directory must contain .overview to be - ;; agent's cache of a group. - (let ((d (file-name-as-directory d)) - r) - ;; Search ancestor's for last directory NOT - ;; found in keep hash. - (while (not (gnus-gethash - (setq d (file-name-directory d)) keep)) - (setq r d - d (directory-file-name d))) - ;; if ANY ancestor was NOT in keep hash and - ;; it it's already in to-remove, add it to - ;; to-remove. - (if (and r - (not (member r to-remove))) - (push r to-remove)))) - ((file-directory-p (setq file (nnheader-concat d file))) - (funcall checker file))))))))) - (funcall checker (expand-file-name gnus-agent-directory)) - - (when (and to-remove - (or gnus-expert-user - (gnus-y-or-n-p - "gnus-agent-expire has identified local directories that are\ - not currently required by any agentized group. Do you wish to consider\ - deleting them?"))) - (while to-remove - (let ((dir (pop to-remove))) - (if (gnus-y-or-n-p (format "Delete %s? " dir)) - (let* (delete-recursive - (delete-recursive - (function - (lambda (f-or-d) - (ignore-errors - (if (file-directory-p f-or-d) - (condition-case nil - (delete-directory f-or-d) - (file-error - (mapcar (lambda (f) - (or (member f '("." "..")) - (funcall delete-recursive - (nnheader-concat - f-or-d f)))) - (directory-files f-or-d)) - (delete-directory f-or-d))) - (delete-file f-or-d))))))) - (funcall delete-recursive dir)))))))))) - -;;;###autoload -(defun gnus-agent-batch () - "Start Gnus, send queue and fetch session." - (interactive) - (let ((init-file-user "") - (gnus-always-read-dribble-file t)) - (gnus)) - (let ((gnus-agent-confirmation-function 'gnus-agent-batch-confirmation)) - (gnus-group-send-queue) - (gnus-agent-fetch-session))) - -(defun gnus-agent-unread-articles (group) - (let* ((read (gnus-info-read (gnus-get-info group))) - (known (gnus-agent-load-alist group)) - (unread (list nil)) - (tail-unread unread)) - (while (and known read) - (let ((candidate (car (pop known)))) - (while (let* ((range (car read)) - (min (if (numberp range) range (car range))) - (max (if (numberp range) range (cdr range)))) - (cond ((or (not min) - (< candidate min)) - (gnus-agent-append-to-list tail-unread candidate) - nil) - ((> candidate max) - (setq read (cdr read)) - ;; return t so that I always loop one more - ;; time. If I just iterated off the end of - ;; read, min will become nil and the current - ;; candidate will be added to the unread list. - t)))))) - (while known - (gnus-agent-append-to-list tail-unread (car (pop known)))) - (cdr unread))) - -(defun gnus-agent-uncached-articles (articles group &optional cached-header) - "Restrict ARTICLES to numbers already fetched. -Returns a sublist of ARTICLES that excludes those article ids in GROUP -that have already been fetched. -If CACHED-HEADER is nil, articles are only excluded if the article itself -has been fetched." - - ;; Logically equivalent to: (gnus-sorted-difference articles (mapcar - ;; 'car gnus-agent-article-alist)) - - ;; Functionally, I don't need to construct a temp list using mapcar. - - (if (and (or gnus-agent-cache (not gnus-plugged)) - (gnus-agent-load-alist group)) - (let* ((ref gnus-agent-article-alist) - (arts articles) - (uncached (list nil)) - (tail-uncached uncached)) - (while (and ref arts) - (let ((v1 (car arts)) - (v2 (caar ref))) - (cond ((< v1 v2) ; v1 does not appear in the reference list - (gnus-agent-append-to-list tail-uncached v1) - (setq arts (cdr arts))) - ((= v1 v2) - (unless (or cached-header (cdar ref)) ; v1 is already cached - (gnus-agent-append-to-list tail-uncached v1)) - (setq arts (cdr arts)) - (setq ref (cdr ref))) - (t ; reference article (v2) preceeds the list being filtered - (setq ref (cdr ref)))))) - (while arts - (gnus-agent-append-to-list tail-uncached (pop arts))) - (cdr uncached)) - ;; if gnus-agent-load-alist fails, no articles are cached. - articles)) - -(defun gnus-agent-retrieve-headers (articles group &optional fetch-old) - (save-excursion - (gnus-agent-create-buffer) - (let ((gnus-decode-encoded-word-function 'identity) - (gnus-decode-encoded-address-function 'identity) - (file (gnus-agent-article-name ".overview" group)) - cached-articles uncached-articles) - (gnus-make-directory (nnheader-translate-file-chars - (file-name-directory file) t)) - - ;; Populate temp buffer with known headers - (when (file-exists-p file) - (with-current-buffer gnus-agent-overview-buffer - (erase-buffer) - (let ((nnheader-file-coding-system - gnus-agent-file-coding-system)) - (nnheader-insert-nov-file file (car articles))))) - - (if (setq uncached-articles (gnus-agent-uncached-articles articles group - t)) - (progn - ;; Populate nntp-server-buffer with uncached headers - (set-buffer nntp-server-buffer) - (erase-buffer) - (cond ((not (eq 'nov (let (gnus-agent) ; Turn off agent - (gnus-retrieve-headers - uncached-articles group fetch-old)))) - (nnvirtual-convert-headers)) - ((eq 'nntp (car gnus-current-select-method)) - ;; The author of gnus-get-newsgroup-headers-xover - ;; reports that the XOVER command is commonly - ;; unreliable. The problem is that recently - ;; posted articles may not be entered into the - ;; NOV database in time to respond to my XOVER - ;; query. - ;; - ;; I'm going to use his assumption that the NOV - ;; database is updated in order of ascending - ;; article ID. Therefore, a response containing - ;; article ID N implies that all articles from 1 - ;; to N-1 are up-to-date. Therefore, missing - ;; articles in that range have expired. - - (set-buffer nntp-server-buffer) - (let* ((fetched-articles (list nil)) - (tail-fetched-articles fetched-articles) - (min (cond ((numberp fetch-old) - (max 1 (- (car articles) fetch-old))) - (fetch-old - 1) - (t - (car articles)))) - (max (car (last articles)))) - - ;; Get the list of articles that were fetched - (goto-char (point-min)) - (let ((pm (point-max)) - art) - (while (< (point) pm) - (when (setq art (gnus-agent-read-article-number)) - (gnus-agent-append-to-list tail-fetched-articles art)) - (forward-line 1))) - - ;; Clip this list to the headers that will - ;; actually be returned - (setq fetched-articles (gnus-list-range-intersection - (cdr fetched-articles) - (cons min max))) - - ;; Clip the uncached articles list to exclude - ;; IDs after the last FETCHED header. The - ;; excluded IDs may be fetchable using HEAD. - (if (car tail-fetched-articles) - (setq uncached-articles - (gnus-list-range-intersection - uncached-articles - (cons (car uncached-articles) - (car tail-fetched-articles))))) - - ;; Create the list of articles that were - ;; "successfully" fetched. Success, in this - ;; case, means that the ID should not be - ;; fetched again. In the case of an expired - ;; article, the header will not be fetched. - (setq uncached-articles - (gnus-sorted-nunion fetched-articles - uncached-articles)) - ))) - - ;; Erase the temp buffer - (set-buffer gnus-agent-overview-buffer) - (erase-buffer) - - ;; Copy the nntp-server-buffer to the temp buffer - (set-buffer nntp-server-buffer) - (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max)) - - ;; Merge the temp buffer with the known headers (found on - ;; disk in FILE) into the nntp-server-buffer - (when uncached-articles - (gnus-agent-braid-nov group uncached-articles file)) - - ;; Save the new set of known headers to FILE - (set-buffer nntp-server-buffer) - (let ((coding-system-for-write - gnus-agent-file-coding-system)) - (gnus-agent-check-overview-buffer) - (write-region (point-min) (point-max) file nil 'silent)) - - ;; Update the group's article alist to include the newly - ;; fetched articles. - (gnus-agent-load-alist group) - (gnus-agent-save-alist group uncached-articles nil) - ) - - ;; Copy the temp buffer to the nntp-server-buffer - (set-buffer nntp-server-buffer) - (erase-buffer) - (insert-buffer-substring gnus-agent-overview-buffer))) - - (if (and fetch-old - (not (numberp fetch-old))) - t ; Don't remove anything. - (nnheader-nov-delete-outside-range - (if fetch-old (max 1 (- (car articles) fetch-old)) - (car articles)) - (car (last articles))) - t) - - 'nov)) - -(defun gnus-agent-request-article (article group) - "Retrieve ARTICLE in GROUP from the agent cache." - (when (and gnus-agent - (or gnus-agent-cache - (not gnus-plugged)) - (numberp article)) - (let* ((gnus-command-method (gnus-find-method-for-group group)) - (file (gnus-agent-article-name (number-to-string article) group)) - (buffer-read-only nil)) - (when (and (file-exists-p file) - (> (nth 7 (file-attributes file)) 0)) - (erase-buffer) - (gnus-kill-all-overlays) - (let ((coding-system-for-read gnus-cache-coding-system)) - (insert-file-contents file)) - t)))) - -(defun gnus-agent-regenerate-group (group &optional reread) - "Regenerate GROUP. -If REREAD is t, all articles in the .overview are marked as unread. -If REREAD is a list, the specified articles will be marked as unread. -In addition, their NOV entries in .overview will be refreshed using -the articles' current headers. -If REREAD is not nil, downloaded articles are marked as unread." - (interactive - (list (let ((def (or (gnus-group-group-name) - gnus-newsgroup-name))) - (let ((select (read-string (if def - (concat "Group Name (" - def "): ") - "Group Name: ")))) - (if (and (equal "" select) - def) - def - select))) - (catch 'mark - (while (let (c - (cursor-in-echo-area t) - (echo-keystrokes 0)) - (message "Mark as unread: (n)one / (a)ll / all (d)ownloaded articles? (n) ") - (setq c (read-char-exclusive)) - - (cond ((or (eq c ?\r) (eq c ?n) (eq c ?N)) - (throw 'mark nil)) - ((or (eq c ?a) (eq c ?A)) - (throw 'mark t)) - ((or (eq c ?d) (eq c ?D)) - (throw 'mark 'some))) - (gnus-message 3 "Ignoring unexpected input") - (sit-for 1) - t))))) - (when group - (gnus-message 5 "Regenerating in %s" group) - (let* ((gnus-command-method (or gnus-command-method - (gnus-find-method-for-group group))) - (file (gnus-agent-article-name ".overview" group)) - (dir (file-name-directory file)) - point - (downloaded (if (file-exists-p dir) - (sort (delq nil (mapcar (lambda (name) - (and (not (file-directory-p (nnheader-concat dir name))) - (string-to-number name))) - (directory-files dir nil "^[0-9]+$" t))) - '>) - (progn (gnus-make-directory dir) nil))) - dl nov-arts - alist header - regenerated) - - (mm-with-unibyte-buffer - (if (file-exists-p file) - (let ((nnheader-file-coding-system - gnus-agent-file-coding-system)) - (nnheader-insert-file-contents file))) - (set-buffer-modified-p nil) - - ;; Load the article IDs found in the overview file. As a - ;; side-effect, validate the file contents. - (let ((load t)) - (while load - (setq load nil) - (goto-char (point-min)) - (while (< (point) (point-max)) - (cond ((and (looking-at "[0-9]+\t") - (<= (- (match-end 0) (match-beginning 0)) 9)) - (push (read (current-buffer)) nov-arts) - (forward-line 1) - (let ((l1 (car nov-arts)) - (l2 (cadr nov-arts))) - (cond ((and (listp reread) (memq l1 reread)) - (gnus-delete-line) - (setq nov-arts (cdr nov-arts)) - (gnus-message 4 "gnus-agent-regenerate-group: NOV\ - entry of article %s deleted." l1)) - ((not l2) - nil) - ((< l1 l2) - (gnus-message 3 "gnus-agent-regenerate-group: NOV\ - entries are NOT in ascending order.") - ;; Don't sort now as I haven't verified - ;; that every line begins with a number - (setq load t)) - ((= l1 l2) - (forward-line -1) - (gnus-message 4 "gnus-agent-regenerate-group: NOV\ - entries contained duplicate of article %s. Duplicate deleted." l1) - (gnus-delete-line) - (setq nov-arts (cdr nov-arts)))))) - (t - (gnus-message 1 "gnus-agent-regenerate-group: NOV\ - entries contained line that did not begin with an article number. Deleted\ - line.") - (gnus-delete-line)))) - (when load - (gnus-message 5 "gnus-agent-regenerate-group: Sorting NOV\ - entries into ascending order.") - (sort-numeric-fields 1 (point-min) (point-max)) - (setq nov-arts nil)))) - (gnus-agent-check-overview-buffer) - - ;; Construct a new article alist whose nodes match every header - ;; in the .overview file. As a side-effect, missing headers are - ;; reconstructed from the downloaded article file. - (while (or downloaded nov-arts) - (cond ((and downloaded - (or (not nov-arts) - (> (car downloaded) (car nov-arts)))) - ;; This entry is missing from the overview file - (gnus-message 3 "Regenerating NOV %s %d..." group - (car downloaded)) - (let ((file (concat dir (number-to-string (car downloaded))))) - (mm-with-unibyte-buffer - (nnheader-insert-file-contents file) - (nnheader-remove-body) - (setq header (nnheader-parse-naked-head))) - (mail-header-set-number header (car downloaded)) - (if nov-arts - (let ((key (concat "^" (int-to-string (car nov-arts)) - "\t"))) - (or (re-search-backward key nil t) - (re-search-forward key)) - (forward-line 1)) - (goto-char (point-min))) - (nnheader-insert-nov header)) - (setq nov-arts (cons (car downloaded) nov-arts))) - ((eq (car downloaded) (car nov-arts)) - ;; This entry in the overview has been downloaded - (push (cons (car downloaded) - (time-to-days - (nth 5 (file-attributes - (concat dir (number-to-string - (car downloaded))))))) alist) - (setq downloaded (cdr downloaded)) - (setq nov-arts (cdr nov-arts))) - (t - ;; This entry in the overview has not been downloaded - (push (cons (car nov-arts) nil) alist) - (setq nov-arts (cdr nov-arts))))) - - ;; When gnus-agent-consider-all-articles is set, - ;; gnus-agent-regenerate-group should NOT remove article IDs from - ;; the alist. Those IDs serve as markers to indicate that an - ;; attempt has been made to fetch that article's header. - - ;; When gnus-agent-consider-all-articles is NOT set, - ;; gnus-agent-regenerate-group can remove the article ID of every - ;; article (with the exception of the last ID in the list - it's - ;; special) that no longer appears in the overview. In this - ;; situtation, the last article ID in the list implies that it, - ;; and every article ID preceeding it, have been fetched from the - ;; server. - - (if gnus-agent-consider-all-articles - ;; Restore all article IDs that were not found in the overview file. - (let* ((n (cons nil alist)) - (merged n) - (o (gnus-agent-load-alist group))) - (while o - (let ((nID (caadr n)) - (oID (caar o))) - (cond ((not nID) - (setq n (setcdr n (list (list oID)))) - (setq o (cdr o))) - ((< oID nID) - (setcdr n (cons (list oID) (cdr n))) - (setq o (cdr o))) - ((= oID nID) - (setq o (cdr o)) - (setq n (cdr n))) - (t - (setq n (cdr n)))))) - (setq alist (cdr merged))) - ;; Restore the last article ID if it is not already in the new alist - (let ((n (last alist)) - (o (last (gnus-agent-load-alist group)))) - (cond ((not o) - nil) - ((not n) - (push (cons (caar o) nil) alist)) - ((< (caar n) (caar o)) - (setcdr n (list (car o))))))) - - (let ((inhibit-quit t)) - (if (setq regenerated (buffer-modified-p)) - (let ((coding-system-for-write gnus-agent-file-coding-system)) - (write-region (point-min) (point-max) file nil 'silent))) - - (setq regenerated (or regenerated - (and reread gnus-agent-article-alist) - (not (equal alist gnus-agent-article-alist)))) - - (setq gnus-agent-article-alist alist) - - (when regenerated - (gnus-agent-save-alist group) - - ;; I have to alter the group's active range NOW as - ;; gnus-make-ascending-articles-unread will use it to - ;; recalculate the number of unread articles in the group - - (let ((group (gnus-group-real-name group)) - (group-active (or (gnus-active group) - (gnus-activate-group group)))) - (gnus-agent-possibly-alter-active group group-active))))) - - (when (and reread gnus-agent-article-alist) - (gnus-agent-synchronize-group-flags - group - (list (list - (if (listp reread) - reread - (delq nil (mapcar (function (lambda (c) - (cond ((eq reread t) - (car c)) - ((cdr c) - (car c))))) - gnus-agent-article-alist))) - 'del '(read))) - gnus-command-method) - - (when (gnus-buffer-live-p gnus-group-buffer) - (gnus-group-update-group group t))) - - (gnus-message 5 "") - regenerated))) - -;;;###autoload -(defun gnus-agent-regenerate (&optional clean reread) - "Regenerate all agent covered files. -If CLEAN, obsolete (ignore)." - (interactive "P") - (let (regenerated) - (gnus-message 4 "Regenerating Gnus agent files...") - (dolist (gnus-command-method (gnus-agent-covered-methods)) - (dolist (group (gnus-groups-from-server gnus-command-method)) - (setq regenerated (or (gnus-agent-regenerate-group group reread) - regenerated)))) - (gnus-message 4 "Regenerating Gnus agent files...done") - - regenerated)) - -(defun gnus-agent-go-online (&optional force) - "Switch servers into online status." - (interactive (list t)) - (dolist (server gnus-opened-servers) - (when (eq (nth 1 server) 'offline) - (if (if (eq force 'ask) - (gnus-y-or-n-p - (format "Switch %s:%s into online status? " - (caar server) (cadar server))) - force) - (setcar (nthcdr 1 server) 'close))))) - -(defun gnus-agent-toggle-group-plugged (group) - "Toggle the status of the server of the current group." - (interactive (list (gnus-group-group-name))) - (let* ((method (gnus-find-method-for-group group)) - (status (cadr (assoc method gnus-opened-servers)))) - (if (eq status 'offline) - (gnus-server-set-status method 'closed) - (gnus-close-server method) - (gnus-server-set-status method 'offline)) - (message "Turn %s:%s from %s to %s." (car method) (cadr method) - (if (eq status 'offline) 'offline 'online) - (if (eq status 'offline) 'online 'offline)))) - -(defun gnus-agent-group-covered-p (group) - (gnus-agent-method-p (gnus-group-method group))) - -(provide 'gnus-agent) - -;;; arch-tag: b0ba4afc-5229-4cee-ad25-9956daa4e91e -;;; gnus-agent.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-art.el b/xemacs-packages/gnus/lisp/gnus-art.el deleted file mode 100644 index b70e7c9d..00000000 --- a/xemacs-packages/gnus/lisp/gnus-art.el +++ /dev/null @@ -1,7659 +0,0 @@ -;;; gnus-art.el --- article mode commands for Gnus - -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile - (require 'cl) - (defvar tool-bar-map) - (defvar w3m-minor-mode-map)) - -(require 'gnus) -(require 'gnus-sum) -(require 'gnus-spec) -(require 'gnus-int) -(require 'gnus-win) -(require 'mm-bodies) -(require 'mail-parse) -(require 'mm-decode) -(require 'mm-view) -(require 'wid-edit) -(require 'mm-uu) -(require 'message) - -(autoload 'gnus-msg-mail "gnus-msg" nil t) -(autoload 'gnus-button-mailto "gnus-msg") -(autoload 'gnus-button-reply "gnus-msg" nil t) -(autoload 'parse-time-string "parse-time" nil nil) -(autoload 'mm-extern-cache-contents "mm-extern") - -(defgroup gnus-article nil - "Article display." - :link '(custom-manual "(gnus)Article Buffer") - :group 'gnus) - -(defgroup gnus-article-treat nil - "Treating article parts." - :link '(custom-manual "(gnus)Article Hiding") - :group 'gnus-article) - -(defgroup gnus-article-hiding nil - "Hiding article parts." - :link '(custom-manual "(gnus)Article Hiding") - :group 'gnus-article) - -(defgroup gnus-article-highlight nil - "Article highlighting." - :link '(custom-manual "(gnus)Article Highlighting") - :group 'gnus-article - :group 'gnus-visual) - -(defgroup gnus-article-signature nil - "Article signatures." - :link '(custom-manual "(gnus)Article Signature") - :group 'gnus-article) - -(defgroup gnus-article-headers nil - "Article headers." - :link '(custom-manual "(gnus)Hiding Headers") - :group 'gnus-article) - -(defgroup gnus-article-washing nil - "Special commands on articles." - :link '(custom-manual "(gnus)Article Washing") - :group 'gnus-article) - -(defgroup gnus-article-emphasis nil - "Fontisizing articles." - :link '(custom-manual "(gnus)Article Fontisizing") - :group 'gnus-article) - -(defgroup gnus-article-saving nil - "Saving articles." - :link '(custom-manual "(gnus)Saving Articles") - :group 'gnus-article) - -(defgroup gnus-article-mime nil - "Worshiping the MIME wonder." - :link '(custom-manual "(gnus)Using MIME") - :group 'gnus-article) - -(defgroup gnus-article-buttons nil - "Pushable buttons in the article buffer." - :link '(custom-manual "(gnus)Article Buttons") - :group 'gnus-article) - -(defgroup gnus-article-various nil - "Other article options." - :link '(custom-manual "(gnus)Misc Article") - :group 'gnus-article) - -(defcustom gnus-ignored-headers - (mapcar - (lambda (header) - (concat "^" header ":")) - '("Path" "Expires" "Date-Received" "References" "Xref" "Lines" - "Relay-Version" "Message-ID" "Approved" "Sender" "Received" - "X-UIDL" "MIME-Version" "Return-Path" "In-Reply-To" - "Content-Type" "Content-Transfer-Encoding" "X-WebTV-Signature" - "X-MimeOLE" "X-MSMail-Priority" "X-Priority" "X-Loop" - "X-Authentication-Warning" "X-MIME-Autoconverted" "X-Face" - "X-Attribution" "X-Originating-IP" "Delivered-To" - "NNTP-[-A-Za-z]+" "Distribution" "X-no-archive" "X-Trace" - "X-Complaints-To" "X-NNTP-Posting-Host" "X-Orig.*" - "Abuse-Reports-To" "Cache-Post-Path" "X-Article-Creation-Date" - "X-Poster" "X-Mail2News-Path" "X-Server-Date" "X-Cache" - "Originator" "X-Problems-To" "X-Auth-User" "X-Post-Time" - "X-Admin" "X-UID" "Resent-[-A-Za-z]+" "X-Mailing-List" - "Precedence" "Original-[-A-Za-z]+" "X-filename" "X-Orcpt" - "Old-Received" "X-Pgp" "X-Auth" "X-From-Line" - "X-Gnus-Article-Number" "X-Majordomo" "X-Url" "X-Sender" - "MBOX-Line" "Priority" "X400-[-A-Za-z]+" - "Status" "X-Gnus-Mail-Source" "Cancel-Lock" - "X-FTN" "X-EXP32-SerialNo" "Encoding" "Importance" - "Autoforwarded" "Original-Encoded-Information-Types" "X-Ya-Pop3" - "X-Face-Version" "X-Vms-To" "X-ML-NAME" "X-ML-COUNT" - "Mailing-List" "X-finfo" "X-md5sum" "X-md5sum-Origin" - "X-Sun-Charset" "X-Accept-Language" "X-Envelope-Sender" - "List-[A-Za-z]+" "X-Listprocessor-Version" - "X-Received" "X-Distribute" "X-Sequence" "X-Juno-Line-Breaks" - "X-Notes-Item" "X-MS-TNEF-Correlator" "x-uunet-gateway" - "X-Received" "Content-length" "X-precedence" - "X-Authenticated-User" "X-Comment" "X-Report" "X-Abuse-Info" - "X-HTTP-Proxy" "X-Mydeja-Info" "X-Copyright" "X-No-Markup" - "X-Abuse-Info" "X-From_" "X-Accept-Language" "Errors-To" - "X-BeenThere" "X-Mailman-Version" "List-Help" "List-Post" - "List-Subscribe" "List-Id" "List-Unsubscribe" "List-Archive" - "X-Content-length" "X-Posting-Agent" "Original-Received" - "X-Request-PGP" "X-Fingerprint" "X-WRIEnvto" "X-WRIEnvfrom" - "X-Virus-Scanned" "X-Delivery-Agent" "Posted-Date" "X-Gateway" - "X-Local-Origin" "X-Local-Destination" "X-UserInfo1" - "X-Received-Date" "X-Hashcash" "Face" "X-DMCA-Notifications" - "X-Abuse-and-DMCA-Info" "X-Postfilter" "X-Gpg-.*" "X-Disclaimer")) - "*All headers that start with this regexp will be hidden. -This variable can also be a list of regexps of headers to be ignored. -If `gnus-visible-headers' is non-nil, this variable will be ignored." - :type '(choice :custom-show nil - regexp - (repeat regexp)) - :group 'gnus-article-hiding) - -(defcustom gnus-visible-headers - "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^[BGF]?Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Mail-Followup-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-From:\\|^X-Sent:" - "*All headers that do not match this regexp will be hidden. -This variable can also be a list of regexp of headers to remain visible. -If this variable is non-nil, `gnus-ignored-headers' will be ignored." - :type '(repeat :value-to-internal (lambda (widget value) - (custom-split-regexp-maybe value)) - :match (lambda (widget value) - (or (stringp value) - (widget-editable-list-match widget value))) - regexp) - :group 'gnus-article-hiding) - -(defcustom gnus-sorted-header-list - '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:" - "^Followup-To:" "^To:" "^Cc:" "^Date:" "^Organization:") - "*This variable is a list of regular expressions. -If it is non-nil, headers that match the regular expressions will -be placed first in the article buffer in the sequence specified by -this list." - :type '(repeat regexp) - :group 'gnus-article-hiding) - -(defcustom gnus-boring-article-headers '(empty followup-to reply-to) - "Headers that are only to be displayed if they have interesting data. -Possible values in this list are: - - 'empty Headers with no content. - 'newsgroups Newsgroup identical to Gnus group. - 'to-address To identical to To-address. - 'to-list To identical to To-list. - 'cc-list CC identical to To-list. - 'followup-to Followup-to identical to Newsgroups. - 'reply-to Reply-to identical to From. - 'date Date less than four days old. - 'long-to To and/or Cc longer than 1024 characters. - 'many-to Multiple To and/or Cc." - :type '(set (const :tag "Headers with no content." empty) - (const :tag "Newsgroups identical to Gnus group." newsgroups) - (const :tag "To identical to To-address." to-address) - (const :tag "To identical to To-list." to-list) - (const :tag "CC identical to To-list." cc-list) - (const :tag "Followup-to identical to Newsgroups." followup-to) - (const :tag "Reply-to identical to From." reply-to) - (const :tag "Date less than four days old." date) - (const :tag "To and/or Cc longer than 1024 characters." long-to) - (const :tag "Multiple To and/or Cc headers." many-to)) - :group 'gnus-article-hiding) - -(defcustom gnus-article-skip-boring nil - "Skip over text that is not worth reading. -By default, if you set this t, then Gnus will display citations and -signatures, but will never scroll down to show you a page consisting -only of boring text. Boring text is controlled by -`gnus-article-boring-faces'." - :version "22.1" - :type 'boolean - :group 'gnus-article-hiding) - -(defcustom gnus-signature-separator '("^-- $" "^-- *$") - "Regexp matching signature separator. -This can also be a list of regexps. In that case, it will be checked -from head to tail looking for a separator. Searches will be done from -the end of the buffer." - :type '(choice :format "%{%t%}: %[Value Menu%]\n%v" - (regexp) - (repeat :tag "List of regexp" regexp)) - :group 'gnus-article-signature) - -(defcustom gnus-signature-limit nil - "Provide a limit to what is considered a signature. -If it is a number, no signature may not be longer (in characters) than -that number. If it is a floating point number, no signature may be -longer (in lines) than that number. If it is a function, the function -will be called without any parameters, and if it returns nil, there is -no signature in the buffer. If it is a string, it will be used as a -regexp. If it matches, the text in question is not a signature." - :type '(choice (const nil) - (integer :value 200) - (number :value 4.0) - function - (regexp :value ".*")) - :group 'gnus-article-signature) - -(defcustom gnus-hidden-properties '(invisible t intangible t) - "Property list to use for hiding text." - :type 'sexp - :group 'gnus-article-hiding) - -;; Fixme: This isn't the right thing for mixed graphical and non-graphical -;; frames in a session. -(defcustom gnus-article-x-face-command - (if (featurep 'xemacs) - (if (or (gnus-image-type-available-p 'xface) - (gnus-image-type-available-p 'pbm)) - 'gnus-display-x-face-in-from - "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | ee -") - (if (gnus-image-type-available-p 'pbm) - 'gnus-display-x-face-in-from - "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | \ -display -")) - "*String or function to be executed to display an X-Face header. -If it is a string, the command will be executed in a sub-shell -asynchronously. The compressed face will be piped to this command." - :type `(choice string - (function-item gnus-display-x-face-in-from) - function) - :version "21.1" - :group 'gnus-picon - :group 'gnus-article-washing) - -(defcustom gnus-article-x-face-too-ugly nil - "Regexp matching posters whose face shouldn't be shown automatically." - :type '(choice regexp (const nil)) - :group 'gnus-article-washing) - -(defcustom gnus-article-banner-alist nil - "Banner alist for stripping. -For example, - ((egroups . \"^[ \\t\\n]*-------------------+\\\\( \\\\(e\\\\|Yahoo! \\\\)Groups Sponsor -+\\\\)?....\\n\\\\(.+\\n\\\\)+\"))" - :version "21.1" - :type '(repeat (cons symbol regexp)) - :group 'gnus-article-washing) - -(gnus-define-group-parameter - banner - :variable-document - "Alist of regexps (to match group names) and banner." - :variable-group gnus-article-washing - :parameter-type - '(choice :tag "Banner" - :value nil - (const :tag "Remove signature" signature) - (symbol :tag "Item in `gnus-article-banner-alist'" none) - regexp - (const :tag "None" nil)) - :parameter-document - "If non-nil, specify how to remove `banners' from articles. - -Symbol `signature' means to remove signatures delimited by -`gnus-signature-separator'. Any other symbol is used to look up a -regular expression to match the banner in `gnus-article-banner-alist'. -A string is used as a regular expression to match the banner -directly.") - -(defcustom gnus-article-address-banner-alist nil - "Alist of mail addresses and banners. -Each element has the form (ADDRESS . BANNER), where ADDRESS is a regexp -to match a mail address in the From: header, BANNER is one of a symbol -`signature', an item in `gnus-article-banner-alist', a regexp and nil. -If ADDRESS matches author's mail address, it will remove things like -advertisements. For example: - -\((\"@yoo-hoo\\\\.co\\\\.jp\\\\'\" . \"\\n_+\\nDo You Yoo-hoo!\\\\?\\n.*\\n.*\\n\")) -" - :type '(repeat - (cons - (regexp :tag "Address") - (choice :tag "Banner" :value nil - (const :tag "Remove signature" signature) - (symbol :tag "Item in `gnus-article-banner-alist'" none) - regexp - (const :tag "None" nil)))) - :version "22.1" - :group 'gnus-article-washing) - -(defmacro gnus-emphasis-custom-with-format (&rest body) - `(let ((format "\ -\\(\\s-\\|^\\|\\=\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\ -\\(\\([-,.;:!?\"]\\|\\s)\\)+\\s-\\|[?!.]\\s-\\|\\s)\\|\\s-\\)")) - ,@body)) - -(defun gnus-emphasis-custom-value-to-external (value) - (gnus-emphasis-custom-with-format - (if (consp (car value)) - (list (format format (car (car value)) (cdr (car value))) - 2 - (if (nth 1 value) 2 3) - (nth 2 value)) - value))) - -(defun gnus-emphasis-custom-value-to-internal (value) - (gnus-emphasis-custom-with-format - (let ((regexp (concat "\\`" - (format (regexp-quote format) - "\\([^()]+\\)" "\\([^()]+\\)") - "\\'")) - pattern) - (if (string-match regexp (setq pattern (car value))) - (list (cons (match-string 1 pattern) (match-string 2 pattern)) - (= (nth 2 value) 2) - (nth 3 value)) - value)))) - -(defcustom gnus-emphasis-alist - (let ((types - '(("\\*" "\\*" bold nil 2) - ("_" "_" underline) - ("/" "/" italic) - ("_/" "/_" underline-italic) - ("_\\*" "\\*_" underline-bold) - ("\\*/" "/\\*" bold-italic) - ("_\\*/" "/\\*_" underline-bold-italic)))) - (nconc - (gnus-emphasis-custom-with-format - (mapcar (lambda (spec) - (list (format format (car spec) (cadr spec)) - (or (nth 3 spec) 2) - (or (nth 4 spec) 3) - (intern (format "gnus-emphasis-%s" (nth 2 spec))))) - types)) - '(;; I've never seen anyone use this strikethru convention whereas I've - ;; several times seen it triggered by normal text. --Stef - ;; Miles suggests that this form is sometimes used but for italics, - ;; so maybe we should map it to `italic'. - ;; ("\\(\\s-\\|^\\)\\(-\\(\\(\\w\\|-[^-]\\)+\\)-\\)\\(\\s-\\|[?!.,;]\\)" - ;; 2 3 gnus-emphasis-strikethru) - ("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)" - 2 3 gnus-emphasis-underline)))) - "*Alist that says how to fontify certain phrases. -Each item looks like this: - - (\"_\\\\(\\\\w+\\\\)_\" 0 1 'underline) - -The first element is a regular expression to be matched. The second -is a number that says what regular expression grouping used to find -the entire emphasized word. The third is a number that says what -regexp grouping should be displayed and highlighted. The fourth -is the face used for highlighting." - :type - '(repeat - (menu-choice - :format "%[Customizing Style%]\n%v" - :indent 2 - (group :tag "Default" - :value ("" 0 0 default) - :value-create - (lambda (widget) - (let ((value (widget-get - (cadr (widget-get (widget-get widget :parent) - :args)) - :value))) - (if (not (eq (nth 2 value) 'default)) - (widget-put - widget - :value - (gnus-emphasis-custom-value-to-external value)))) - (widget-group-value-create widget)) - regexp - (integer :format "Match group: %v") - (integer :format "Emphasize group: %v") - face) - (group :tag "Simple" - :value (("_" . "_") nil default) - (cons :format "%v" - (regexp :format "Start regexp: %v") - (regexp :format "End regexp: %v")) - (boolean :format "Show start and end patterns: %[%v%]\n" - :on " On " :off " Off ") - face))) - :get (lambda (symbol) - (mapcar 'gnus-emphasis-custom-value-to-internal - (default-value symbol))) - :set (lambda (symbol value) - (set-default symbol (mapcar 'gnus-emphasis-custom-value-to-external - value))) - :group 'gnus-article-emphasis) - -(defcustom gnus-emphasize-whitespace-regexp "^[ \t]+\\|[ \t]*\n" - "A regexp to describe whitespace which should not be emphasized. -Typical values are \"^[ \\t]+\\\\|[ \\t]*\\n\" and \"[ \\t]+\\\\|[ \\t]*\\n\". -The former avoids underlining of leading and trailing whitespace, -and the latter avoids underlining any whitespace at all." - :version "21.1" - :group 'gnus-article-emphasis - :type 'regexp) - -(defface gnus-emphasis-bold '((t (:bold t))) - "Face used for displaying strong emphasized text (*word*)." - :group 'gnus-article-emphasis) - -(defface gnus-emphasis-italic '((t (:italic t))) - "Face used for displaying italic emphasized text (/word/)." - :group 'gnus-article-emphasis) - -(defface gnus-emphasis-underline '((t (:underline t))) - "Face used for displaying underlined emphasized text (_word_)." - :group 'gnus-article-emphasis) - -(defface gnus-emphasis-underline-bold '((t (:bold t :underline t))) - "Face used for displaying underlined bold emphasized text (_*word*_)." - :group 'gnus-article-emphasis) - -(defface gnus-emphasis-underline-italic '((t (:italic t :underline t))) - "Face used for displaying underlined italic emphasized text (_/word/_)." - :group 'gnus-article-emphasis) - -(defface gnus-emphasis-bold-italic '((t (:bold t :italic t))) - "Face used for displaying bold italic emphasized text (/*word*/)." - :group 'gnus-article-emphasis) - -(defface gnus-emphasis-underline-bold-italic - '((t (:bold t :italic t :underline t))) - "Face used for displaying underlined bold italic emphasized text. -Example: (_/*word*/_)." - :group 'gnus-article-emphasis) - -(defface gnus-emphasis-strikethru (if (featurep 'xemacs) - '((t (:strikethru t))) - '((t (:strike-through t)))) - "Face used for displaying strike-through text (-word-)." - :group 'gnus-article-emphasis) - -(defface gnus-emphasis-highlight-words - '((t (:background "black" :foreground "yellow"))) - "Face used for displaying highlighted words." - :group 'gnus-article-emphasis) - -(defcustom gnus-article-time-format "%a, %b %d %Y %T %Z" - "Format for display of Date headers in article bodies. -See `format-time-string' for the possible values. - -The variable can also be function, which should return a complete Date -header. The function is called with one argument, the time, which can -be fed to `format-time-string'." - :type '(choice string symbol) - :link '(custom-manual "(gnus)Article Date") - :group 'gnus-article-washing) - -(defcustom gnus-save-all-headers t - "*If non-nil, don't remove any headers before saving. -This will be overridden by the `:headers' property that the symbol of -the saver function, which is specified by `gnus-default-article-saver', -might have." - :group 'gnus-article-saving - :type 'boolean) - -(defcustom gnus-prompt-before-saving 'always - "*This variable says how much prompting is to be done when saving articles. -If it is nil, no prompting will be done, and the articles will be -saved to the default files. If this variable is `always', each and -every article that is saved will be preceded by a prompt, even when -saving large batches of articles. If this variable is neither nil not -`always', there the user will be prompted once for a file name for -each invocation of the saving commands." - :group 'gnus-article-saving - :type '(choice (item always) - (item :tag "never" nil) - (sexp :tag "once" :format "%t\n" :value t))) - -(defcustom gnus-saved-headers gnus-visible-headers - "Headers to keep if `gnus-save-all-headers' is nil. -If `gnus-save-all-headers' is non-nil, this variable will be ignored. -If that variable is nil, however, all headers that match this regexp -will be kept while the rest will be deleted before saving. This and -`gnus-save-all-headers' will be overridden by the `:headers' property -that the symbol of the saver function, which is specified by -`gnus-default-article-saver', might have." - :group 'gnus-article-saving - :type 'regexp) - -(defcustom gnus-default-article-saver 'gnus-summary-save-in-rmail - "A function to save articles in your favourite format. -The function will be called by way of the `gnus-summary-save-article' -command, and friends such as `gnus-summary-save-article-rmail'. - -Gnus provides the following functions: - -* gnus-summary-save-in-rmail (Rmail format) -* gnus-summary-save-in-mail (Unix mail format) -* gnus-summary-save-in-folder (MH folder) -* gnus-summary-save-in-file (article format) -* gnus-summary-save-body-in-file (article body) -* gnus-summary-save-in-vm (use VM's folder format) -* gnus-summary-write-to-file (article format -- overwrite) -* gnus-summary-write-body-to-file (article body -- overwrite) - -The symbol of each function may have the following properties: - -* :decode -The value non-nil means save decoded articles. This is meaningful -only with `gnus-summary-save-in-file', `gnus-summary-save-body-in-file', -`gnus-summary-write-to-file', and `gnus-summary-write-body-to-file'. - -* :function -The value specifies an alternative function which appends, not -overwrites, articles to a file. This implies that when saving many -articles at a time, `gnus-prompt-before-saving' is bound to t and all -articles are saved in a single file. This is meaningful only with -`gnus-summary-write-to-file' and `gnus-summary-write-body-to-file'. - -* :headers -The value specifies the symbol of a variable of which the value -specifies headers to be saved. If it is omitted, -`gnus-save-all-headers' and `gnus-saved-headers' control what -headers should be saved." - :group 'gnus-article-saving - :type '(radio (function-item gnus-summary-save-in-rmail) - (function-item gnus-summary-save-in-mail) - (function-item gnus-summary-save-in-folder) - (function-item gnus-summary-save-in-file) - (function-item gnus-summary-save-body-in-file) - (function-item gnus-summary-save-in-vm) - (function-item gnus-summary-write-to-file) - (function-item gnus-summary-write-body-to-file) - (function))) - -(defcustom gnus-article-save-coding-system - (or (and (mm-coding-system-p 'utf-8) 'utf-8) - (and (mm-coding-system-p 'iso-2022-7bit) 'iso-2022-7bit) - (and (mm-coding-system-p 'emacs-mule) 'emacs-mule) - (and (mm-coding-system-p 'escape-quoted) 'escape-quoted)) - "Coding system used to save decoded articles to a file. - -The recommended coding systems are `utf-8', `iso-2022-7bit' and so on, -which can safely encode any characters in text. This is used by the -commands including: - -* gnus-summary-save-article-file -* gnus-summary-save-article-body-file -* gnus-summary-write-article-file -* gnus-summary-write-article-body-file - -and the functions to which you may set `gnus-default-article-saver': - -* gnus-summary-save-in-file -* gnus-summary-save-body-in-file -* gnus-summary-write-to-file -* gnus-summary-write-body-to-file - -Those commands and functions save just text displayed in the article -buffer to a file if the value of this variable is non-nil. Note that -buttonized MIME parts will be lost in a saved file in that case. -Otherwise, raw articles will be saved." - :group 'gnus-article-saving - :type `(choice - :format "%{%t%}:\n %[Value Menu%] %v" - (const :tag "Save raw articles" nil) - ,@(delq nil - (mapcar - (lambda (arg) (if (mm-coding-system-p (nth 3 arg)) arg)) - '((const :tag "UTF-8" utf-8) - (const :tag "iso-2022-7bit" iso-2022-7bit) - (const :tag "Emacs internal" emacs-mule) - (const :tag "escape-quoted" escape-quoted)))) - (symbol :tag "Coding system"))) - -(defcustom gnus-rmail-save-name 'gnus-plain-save-name - "A function generating a file name to save articles in Rmail format. -The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE." - :group 'gnus-article-saving - :type 'function) - -(defcustom gnus-mail-save-name 'gnus-plain-save-name - "A function generating a file name to save articles in Unix mail format. -The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE." - :group 'gnus-article-saving - :type 'function) - -(defcustom gnus-folder-save-name 'gnus-folder-save-name - "A function generating a file name to save articles in MH folder. -The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER." - :group 'gnus-article-saving - :type 'function) - -(defcustom gnus-file-save-name 'gnus-numeric-save-name - "A function generating a file name to save articles in article format. -The function is called with NEWSGROUP, HEADERS, and optional -LAST-FILE." - :group 'gnus-article-saving - :type 'function) - -(defcustom gnus-split-methods - '((gnus-article-archive-name) - (gnus-article-nndoc-name)) - "*Variable used to suggest where articles are to be saved. -For instance, if you would like to save articles related to Gnus in -the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\", -you could set this variable to something like: - - '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\") - (\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\")) - -This variable is an alist where the where the key is the match and the -value is a list of possible files to save in if the match is non-nil. - -If the match is a string, it is used as a regexp match on the -article. If the match is a symbol, that symbol will be funcalled -from the buffer of the article to be saved with the newsgroup as the -parameter. If it is a list, it will be evalled in the same buffer. - -If this form or function returns a string, this string will be used as -a possible file name; and if it returns a non-nil list, that list will -be used as possible file names." - :group 'gnus-article-saving - :type '(repeat (choice (list :value (fun) function) - (cons :value ("" "") regexp (repeat string)) - (sexp :value nil)))) - -(defcustom gnus-page-delimiter "^\^L" - "*Regexp describing what to use as article page delimiters. -The default value is \"^\^L\", which is a form linefeed at the -beginning of a line." - :type 'regexp - :group 'gnus-article-various) - -(defcustom gnus-article-mode-line-format "Gnus: %g [%w] %S%m" - "*The format specification for the article mode line. -See `gnus-summary-mode-line-format' for a closer description. - -The following additional specs are available: - -%w The article washing status. -%m The number of MIME parts in the article." - :type 'string - :group 'gnus-article-various) - -(defcustom gnus-article-mode-hook nil - "*A hook for Gnus article mode." - :type 'hook - :group 'gnus-article-various) - -(when (featurep 'xemacs) - ;; Extracted from gnus-xmas-define in order to preserve user settings - (when (fboundp 'turn-off-scroll-in-place) - (add-hook 'gnus-article-mode-hook 'turn-off-scroll-in-place)) - ;; Extracted from gnus-xmas-redefine in order to preserve user settings - (add-hook 'gnus-article-mode-hook 'gnus-xmas-article-menu-add)) - -(defcustom gnus-article-menu-hook nil - "*Hook run after the creation of the article mode menu." - :type 'hook - :group 'gnus-article-various) - -(defcustom gnus-article-prepare-hook nil - "*A hook called after an article has been prepared in the article buffer." - :type 'hook - :group 'gnus-article-various) - -(make-obsolete-variable 'gnus-article-hide-pgp-hook - "This variable is obsolete in Gnus 5.10.") - -(defcustom gnus-article-button-face 'bold - "Face used for highlighting buttons in the article buffer. - -An article button is a piece of text that you can activate by pressing -`RET' or `mouse-2' above it." - :type 'face - :group 'gnus-article-buttons) - -(defcustom gnus-article-mouse-face 'highlight - "Face used for mouse highlighting in the article buffer. - -Article buttons will be displayed in this face when the cursor is -above them." - :type 'face - :group 'gnus-article-buttons) - -(defcustom gnus-signature-face 'gnus-signature - "Face used for highlighting a signature in the article buffer. -Obsolete; use the face `gnus-signature' for customizations instead." - :type 'face - :group 'gnus-article-highlight - :group 'gnus-article-signature) - -(defface gnus-signature - '((t - (:italic t))) - "Face used for highlighting a signature in the article buffer." - :group 'gnus-article-highlight - :group 'gnus-article-signature) -;; backward-compatibility alias -(put 'gnus-signature-face 'face-alias 'gnus-signature) - -(defface gnus-header-from - '((((class color) - (background dark)) - (:foreground "spring green")) - (((class color) - (background light)) - (:foreground "red3")) - (t - (:italic t))) - "Face used for displaying from headers." - :group 'gnus-article-headers - :group 'gnus-article-highlight) -;; backward-compatibility alias -(put 'gnus-header-from-face 'face-alias 'gnus-header-from) - -(defface gnus-header-subject - '((((class color) - (background dark)) - (:foreground "SeaGreen3")) - (((class color) - (background light)) - (:foreground "red4")) - (t - (:bold t :italic t))) - "Face used for displaying subject headers." - :group 'gnus-article-headers - :group 'gnus-article-highlight) -;; backward-compatibility alias -(put 'gnus-header-subject-face 'face-alias 'gnus-header-subject) - -(defface gnus-header-newsgroups - '((((class color) - (background dark)) - (:foreground "yellow" :italic t)) - (((class color) - (background light)) - (:foreground "MidnightBlue" :italic t)) - (t - (:italic t))) - "Face used for displaying newsgroups headers. -In the default setup this face is only used for crossposted -articles." - :group 'gnus-article-headers - :group 'gnus-article-highlight) -;; backward-compatibility alias -(put 'gnus-header-newsgroups-face 'face-alias 'gnus-header-newsgroups) - -(defface gnus-header-name - '((((class color) - (background dark)) - (:foreground "SeaGreen")) - (((class color) - (background light)) - (:foreground "maroon")) - (t - (:bold t))) - "Face used for displaying header names." - :group 'gnus-article-headers - :group 'gnus-article-highlight) -;; backward-compatibility alias -(put 'gnus-header-name-face 'face-alias 'gnus-header-name) - -(defface gnus-header-content - '((((class color) - (background dark)) - (:foreground "forest green" :italic t)) - (((class color) - (background light)) - (:foreground "indianred4" :italic t)) - (t - (:italic t))) "Face used for displaying header content." - :group 'gnus-article-headers - :group 'gnus-article-highlight) -;; backward-compatibility alias -(put 'gnus-header-content-face 'face-alias 'gnus-header-content) - -(defcustom gnus-header-face-alist - '(("From" nil gnus-header-from) - ("Subject" nil gnus-header-subject) - ("Newsgroups:.*," nil gnus-header-newsgroups) - ("" gnus-header-name gnus-header-content)) - "*Controls highlighting of article headers. - -An alist of the form (HEADER NAME CONTENT). - -HEADER is a regular expression which should match the name of a -header and NAME and CONTENT are either face names or nil. - -The name of each header field will be displayed using the face -specified by the first element in the list where HEADER matches -the header name and NAME is non-nil. Similarly, the content will -be displayed by the first non-nil matching CONTENT face." - :group 'gnus-article-headers - :group 'gnus-article-highlight - :type '(repeat (list (regexp :tag "Header") - (choice :tag "Name" - (item :tag "skip" nil) - (face :value default)) - (choice :tag "Content" - (item :tag "skip" nil) - (face :value default))))) - -(defcustom gnus-article-decode-hook - '(article-decode-charset article-decode-encoded-words - article-decode-group-name article-decode-idna-rhs) - "*Hook run to decode charsets in articles." - :group 'gnus-article-headers - :type 'hook) - -(defcustom gnus-display-mime-function 'gnus-display-mime - "Function to display MIME articles." - :group 'gnus-article-mime - :type 'function) - -(defvar gnus-decode-header-function 'mail-decode-encoded-word-region - "Function used to decode headers.") - -(defvar gnus-decode-address-function 'mail-decode-encoded-address-region - "Function used to decode addresses.") - -(defvar gnus-article-dumbquotes-map - '(("\200" "EUR") - ("\202" ",") - ("\203" "f") - ("\204" ",,") - ("\205" "...") - ("\213" "<") - ("\214" "OE") - ("\221" "`") - ("\222" "'") - ("\223" "``") - ("\224" "\"") - ("\225" "*") - ("\226" "-") - ("\227" "--") - ("\230" "~") - ("\231" "(TM)") - ("\233" ">") - ("\234" "oe") - ("\264" "'")) - "Table for MS-to-Latin1 translation.") - -(defcustom gnus-ignored-mime-types nil - "List of MIME types that should be ignored by Gnus." - :version "21.1" - :group 'gnus-article-mime - :type '(repeat regexp)) - -(defcustom gnus-unbuttonized-mime-types '(".*/.*") - "List of MIME types that should not be given buttons when rendered inline. -See also `gnus-buttonized-mime-types' which may override this variable. -This variable is only used when `gnus-inhibit-mime-unbuttonizing' is nil." - :version "21.1" - :group 'gnus-article-mime - :type '(repeat regexp)) - -(defcustom gnus-buttonized-mime-types nil - "List of MIME types that should be given buttons when rendered inline. -If set, this variable overrides `gnus-unbuttonized-mime-types'. -To see e.g. security buttons you could set this to -`(\"multipart/signed\")'. You could also add \"multipart/alternative\" to -this list to display radio buttons that allow you to choose one of two -media types those mails include. See also `mm-discouraged-alternatives'. -This variable is only used when `gnus-inhibit-mime-unbuttonizing' is nil." - :version "22.1" - :group 'gnus-article-mime - :type '(repeat regexp)) - -(defcustom gnus-inhibit-mime-unbuttonizing nil - "If non-nil, all MIME parts get buttons. -When nil (the default value), then some MIME parts do not get buttons, -as described by the variables `gnus-buttonized-mime-types' and -`gnus-unbuttonized-mime-types'." - :version "22.1" - :group 'gnus-article-mime - :type 'boolean) - -(defcustom gnus-body-boundary-delimiter "_" - "String used to delimit header and body. -This variable is used by `gnus-article-treat-body-boundary' which can -be controlled by `gnus-treat-body-boundary'." - :version "22.1" - :group 'gnus-article-various - :type '(choice (item :tag "None" :value nil) - string)) - -(defcustom gnus-picon-databases '("/usr/lib/picon" "/usr/local/faces" - "/usr/share/picons") - "Defines the location of the faces database. -For information on obtaining this database of pretty pictures, please -see http://www.cs.indiana.edu/picons/ftp/index.html" - :version "22.1" - :type '(repeat directory) - :link '(url-link :tag "download" - "http://www.cs.indiana.edu/picons/ftp/index.html") - :link '(custom-manual "(gnus)Picons") - :group 'gnus-picon) - -(defun gnus-picons-installed-p () - "Say whether picons are installed on your machine." - (let ((installed nil)) - (dolist (database gnus-picon-databases) - (when (file-exists-p database) - (setq installed t))) - installed)) - -(defcustom gnus-article-mime-part-function nil - "Function called with a MIME handle as the argument. -This is meant for people who want to do something automatic based -on parts -- for instance, adding Vcard info to a database." - :group 'gnus-article-mime - :type '(choice (const nil) - function)) - -(defcustom gnus-mime-multipart-functions nil - "An alist of MIME types to functions to display them." - :version "21.1" - :group 'gnus-article-mime - :type 'alist) - -(defcustom gnus-article-date-lapsed-new-header nil - "Whether the X-Sent and Date headers can coexist. -When using `gnus-treat-date-lapsed', the \"X-Sent:\" header will -either replace the old \"Date:\" header (if this variable is nil), or -be added below it (otherwise)." - :version "21.1" - :group 'gnus-article-headers - :type 'boolean) - -(defcustom gnus-article-mime-match-handle-function 'undisplayed-alternative - "Function called with a MIME handle as the argument. -This is meant for people who want to view first matched part. -For `undisplayed-alternative' (default), the first undisplayed -part or alternative part is used. For `undisplayed', the first -undisplayed part is used. For a function, the first part which -the function return t is used. For nil, the first part is -used." - :version "21.1" - :group 'gnus-article-mime - :type '(choice - (item :tag "first" :value nil) - (item :tag "undisplayed" :value undisplayed) - (item :tag "undisplayed or alternative" - :value undisplayed-alternative) - (function))) - -(defcustom gnus-mime-action-alist - '(("save to file" . gnus-mime-save-part) - ("save and strip" . gnus-mime-save-part-and-strip) - ("delete part" . gnus-mime-delete-part) - ("display as text" . gnus-mime-inline-part) - ("view the part" . gnus-mime-view-part) - ("pipe to command" . gnus-mime-pipe-part) - ("toggle display" . gnus-article-press-button) - ("toggle display" . gnus-article-view-part-as-charset) - ("view as type" . gnus-mime-view-part-as-type) - ("view internally" . gnus-mime-view-part-internally) - ("view externally" . gnus-mime-view-part-externally)) - "An alist of actions that run on the MIME attachment." - :group 'gnus-article-mime - :type '(repeat (cons (string :tag "name") - (function)))) - -;;; -;;; The treatment variables -;;; - -(defvar gnus-part-display-hook nil - "Hook called on parts that are to receive treatment.") - -(defvar gnus-article-treat-custom - '(choice (const :tag "Off" nil) - (const :tag "On" t) - (const :tag "Header" head) - (const :tag "Last" last) - (integer :tag "Less") - (repeat :tag "Groups" regexp) - (sexp :tag "Predicate"))) - -(defvar gnus-article-treat-head-custom - '(choice (const :tag "Off" nil) - (const :tag "Header" head))) - -(defvar gnus-article-treat-types '("text/plain") - "Parts to treat.") - -(defvar gnus-inhibit-treatment nil - "Whether to inhibit treatment.") - -(defcustom gnus-treat-highlight-signature '(or t (typep "text/x-vcard")) - "Highlight the signature. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles'." - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-custom) -(put 'gnus-treat-highlight-signature 'highlight t) - -(defcustom gnus-treat-buttonize 100000 - "Add buttons. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles'." - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-custom) -(put 'gnus-treat-buttonize 'highlight t) - -(defcustom gnus-treat-buttonize-head 'head - "Add buttons to the head. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-head-custom) -(put 'gnus-treat-buttonize-head 'highlight t) - -(defcustom gnus-treat-emphasize - (and (or window-system - (featurep 'xemacs) - (>= (string-to-number emacs-version) 21)) - 50000) - "Emphasize text. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-custom) -(put 'gnus-treat-emphasize 'highlight t) - -(defcustom gnus-treat-strip-cr nil - "Remove carriage returns. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." - :version "22.1" - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-custom) - -(defcustom gnus-treat-unsplit-urls nil - "Remove newlines from within URLs. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." - :version "22.1" - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-custom) - -(defcustom gnus-treat-leading-whitespace nil - "Remove leading whitespace in headers. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." - :version "22.1" - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-custom) - -(defcustom gnus-treat-hide-headers 'head - "Hide headers. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-head-custom) - -(defcustom gnus-treat-hide-boring-headers nil - "Hide boring headers. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-head-custom) - -(defcustom gnus-treat-hide-signature nil - "Hide the signature. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-custom) - -(defcustom gnus-treat-fill-article nil - "Fill the article. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-custom) - -(defcustom gnus-treat-hide-citation nil - "Hide cited text. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-custom) - -(defcustom gnus-treat-hide-citation-maybe nil - "Hide cited text. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-custom) - -(defcustom gnus-treat-strip-list-identifiers 'head - "Strip list identifiers from `gnus-list-identifiers`. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." - :version "21.1" - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-custom) - -(make-obsolete-variable 'gnus-treat-strip-pgp - "This option is obsolete in Gnus 5.10.") - -(defcustom gnus-treat-strip-pem nil - "Strip PEM signatures. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-custom) - -(defcustom gnus-treat-strip-banner t - "Strip banners from articles. -The banner to be stripped is specified in the `banner' group parameter. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-custom) - -(defcustom gnus-treat-highlight-headers 'head - "Highlight the headers. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-head-custom) -(put 'gnus-treat-highlight-headers 'highlight t) - -(defcustom gnus-treat-highlight-citation t - "Highlight cited text. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-custom) -(put 'gnus-treat-highlight-citation 'highlight t) - -(defcustom gnus-treat-date-ut nil - "Display the Date in UT (GMT). -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-head-custom) - -(defcustom gnus-treat-date-local nil - "Display the Date in the local timezone. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-head-custom) - -(defcustom gnus-treat-date-english nil - "Display the Date in a format that can be read aloud in English. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." - :version "22.1" - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-head-custom) - -(defcustom gnus-treat-date-lapsed nil - "Display the Date header in a way that says how much time has elapsed. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-head-custom) - -(defcustom gnus-treat-date-original nil - "Display the date in the original timezone. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-head-custom) - -(defcustom gnus-treat-date-iso8601 nil - "Display the date in the ISO8601 format. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." - :version "21.1" - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-head-custom) - -(defcustom gnus-treat-date-user-defined nil - "Display the date in a user-defined format. -The format is defined by the `gnus-article-time-format' variable. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-head-custom) - -(defcustom gnus-treat-strip-headers-in-body t - "Strip the X-No-Archive header line from the beginning of the body. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." - :version "21.1" - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-custom) - -(defcustom gnus-treat-strip-trailing-blank-lines nil - "Strip trailing blank lines. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details. - -When set to t, it also strips trailing blanks in all MIME parts. -Consider to use `last' instead." - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-custom) - -(defcustom gnus-treat-strip-leading-blank-lines nil - "Strip leading blank lines. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details. - -When set to t, it also strips trailing blanks in all MIME parts." - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-custom) - -(defcustom gnus-treat-strip-multiple-blank-lines nil - "Strip multiple blank lines. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-custom) - -(defcustom gnus-treat-unfold-headers 'head - "Unfold folded header lines. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." - :version "22.1" - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-custom) - -(defcustom gnus-treat-fold-headers nil - "Fold headers. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." - :version "22.1" - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-custom) - -(defcustom gnus-treat-fold-newsgroups 'head - "Fold the Newsgroups and Followup-To headers. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." - :version "22.1" - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-custom) - -(defcustom gnus-treat-overstrike t - "Treat overstrike highlighting. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-custom) -(put 'gnus-treat-overstrike 'highlight t) - -(make-obsolete-variable 'gnus-treat-display-xface - 'gnus-treat-display-x-face) - -(defcustom gnus-treat-display-x-face - (and (not noninteractive) - (gnus-image-type-available-p 'xbm) - (if (featurep 'xemacs) - (featurep 'xface) - (and (string-match "^0x" (shell-command-to-string "uncompface")) - (executable-find "icontopbm"))) - 'head) - "Display X-Face headers. -Valid values are nil and `head'. -See Info node `(gnus)Customizing Articles' and Info node -`(gnus)X-Face' for details." - :group 'gnus-article-treat - :version "21.1" - :link '(custom-manual "(gnus)Customizing Articles") - :link '(custom-manual "(gnus)X-Face") - :type gnus-article-treat-head-custom - :set (lambda (symbol value) - (set-default - symbol - (cond ((or (boundp symbol) (get symbol 'saved-value)) - value) - ((boundp 'gnus-treat-display-xface) - (message "\ -** gnus-treat-display-xface is an obsolete variable;\ - use gnus-treat-display-x-face instead") - (default-value 'gnus-treat-display-xface)) - ((get 'gnus-treat-display-xface 'saved-value) - (message "\ -** gnus-treat-display-xface is an obsolete variable;\ - use gnus-treat-display-x-face instead") - (eval (car (get 'gnus-treat-display-xface 'saved-value)))) - (t - value))))) -(put 'gnus-treat-display-x-face 'highlight t) - -(defcustom gnus-treat-display-face - (and (not noninteractive) - (gnus-image-type-available-p 'png) - 'head) - "Display Face headers. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' and Info node -`(gnus)X-Face' for details." - :group 'gnus-article-treat - :version "22.1" - :link '(custom-manual "(gnus)Customizing Articles") - :link '(custom-manual "(gnus)X-Face") - :type gnus-article-treat-head-custom) -(put 'gnus-treat-display-face 'highlight t) - -(defcustom gnus-treat-display-smileys (gnus-image-type-available-p 'xpm) - "Display smileys. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' and Info node -`(gnus)Smileys' for details." - :group 'gnus-article-treat - :version "21.1" - :link '(custom-manual "(gnus)Customizing Articles") - :link '(custom-manual "(gnus)Smileys") - :type gnus-article-treat-custom) -(put 'gnus-treat-display-smileys 'highlight t) - -(defcustom gnus-treat-from-picon - (if (and (gnus-image-type-available-p 'xpm) - (gnus-picons-installed-p)) - 'head nil) - "Display picons in the From header. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' and Info node -`(gnus)Picons' for details." - :version "22.1" - :group 'gnus-article-treat - :group 'gnus-picon - :link '(custom-manual "(gnus)Customizing Articles") - :link '(custom-manual "(gnus)Picons") - :type gnus-article-treat-head-custom) -(put 'gnus-treat-from-picon 'highlight t) - -(defcustom gnus-treat-mail-picon - (if (and (gnus-image-type-available-p 'xpm) - (gnus-picons-installed-p)) - 'head nil) - "Display picons in To and Cc headers. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' and Info node -`(gnus)Picons' for details." - :version "22.1" - :group 'gnus-article-treat - :group 'gnus-picon - :link '(custom-manual "(gnus)Customizing Articles") - :link '(custom-manual "(gnus)Picons") - :type gnus-article-treat-head-custom) -(put 'gnus-treat-mail-picon 'highlight t) - -(defcustom gnus-treat-newsgroups-picon - (if (and (gnus-image-type-available-p 'xpm) - (gnus-picons-installed-p)) - 'head nil) - "Display picons in the Newsgroups and Followup-To headers. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' and Info node -`(gnus)Picons' for details." - :version "22.1" - :group 'gnus-article-treat - :group 'gnus-picon - :link '(custom-manual "(gnus)Customizing Articles") - :link '(custom-manual "(gnus)Picons") - :type gnus-article-treat-head-custom) -(put 'gnus-treat-newsgroups-picon 'highlight t) - -(defcustom gnus-treat-body-boundary - (if (or gnus-treat-newsgroups-picon - gnus-treat-mail-picon - gnus-treat-from-picon) - 'head nil) - "Draw a boundary at the end of the headers. -Valid values are nil and `head'. -See Info node `(gnus)Customizing Articles' for details." - :version "22.1" - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-head-custom) - -(defcustom gnus-treat-capitalize-sentences nil - "Capitalize sentence-starting words. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." - :version "21.1" - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-custom) - -(defcustom gnus-treat-wash-html nil - "Format as HTML. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." - :version "22.1" - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-custom) - -(defcustom gnus-treat-fill-long-lines nil - "Fill long lines. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-custom) - -(defcustom gnus-treat-play-sounds nil - "Play sounds. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." - :version "21.1" - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-custom) - -(defcustom gnus-treat-translate nil - "Translate articles from one language to another. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." - :version "21.1" - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-custom) - -(defcustom gnus-treat-x-pgp-sig nil - "Verify X-PGP-Sig. -To automatically treat X-PGP-Sig, set it to head. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." - :version "22.1" - :group 'gnus-article-treat - :group 'mime-security - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-custom) - -(defvar gnus-article-encrypt-protocol-alist - '(("PGP" . mml2015-self-encrypt))) - -;; Set to nil if more than one protocol added to -;; gnus-article-encrypt-protocol-alist. -(defcustom gnus-article-encrypt-protocol "PGP" - "The protocol used for encrypt articles. -It is a string, such as \"PGP\". If nil, ask user." - :version "22.1" - :type 'string - :group 'mime-security) - -(defvar gnus-article-wash-function nil - "Function used for converting HTML into text.") - -;; XEmacs change: Don't calculate a default value -(defcustom gnus-use-idna nil - "Whether IDNA decoding of headers is used when viewing messages. -This requires GNU Libidn, and by default only enabled if it is found." - :version "22.1" - :group 'gnus-article-headers - :type 'boolean) - -(defcustom gnus-article-over-scroll nil - "If non-nil, allow scrolling the article buffer even when there no more text." - :version "22.1" - :group 'gnus-article - :type 'boolean) - -;;; Internal variables - -(defvar gnus-english-month-names - '("January" "February" "March" "April" "May" "June" "July" "August" - "September" "October" "November" "December")) - -(defvar article-goto-body-goes-to-point-min-p nil) -(defvar gnus-article-wash-types nil) -(defvar gnus-article-emphasis-alist nil) -(defvar gnus-article-image-alist nil) - -(defvar gnus-article-mime-handle-alist-1 nil) -(defvar gnus-treatment-function-alist - '((gnus-treat-x-pgp-sig gnus-article-verify-x-pgp-sig) - (gnus-treat-strip-banner gnus-article-strip-banner) - (gnus-treat-strip-headers-in-body gnus-article-strip-headers-in-body) - (gnus-treat-highlight-signature gnus-article-highlight-signature) - (gnus-treat-buttonize gnus-article-add-buttons) - (gnus-treat-fill-article gnus-article-fill-cited-article) - (gnus-treat-fill-long-lines gnus-article-fill-long-lines) - (gnus-treat-strip-cr gnus-article-remove-cr) - (gnus-treat-unsplit-urls gnus-article-unsplit-urls) - (gnus-treat-date-ut gnus-article-date-ut) - (gnus-treat-date-local gnus-article-date-local) - (gnus-treat-date-english gnus-article-date-english) - (gnus-treat-date-original gnus-article-date-original) - (gnus-treat-date-user-defined gnus-article-date-user) - (gnus-treat-date-iso8601 gnus-article-date-iso8601) - (gnus-treat-date-lapsed gnus-article-date-lapsed) - (gnus-treat-display-x-face gnus-article-display-x-face) - (gnus-treat-display-face gnus-article-display-face) - (gnus-treat-hide-headers gnus-article-maybe-hide-headers) - (gnus-treat-hide-boring-headers gnus-article-hide-boring-headers) - (gnus-treat-hide-signature gnus-article-hide-signature) - (gnus-treat-strip-list-identifiers gnus-article-hide-list-identifiers) - (gnus-treat-leading-whitespace gnus-article-remove-leading-whitespace) - (gnus-treat-strip-pem gnus-article-hide-pem) - (gnus-treat-from-picon gnus-treat-from-picon) - (gnus-treat-mail-picon gnus-treat-mail-picon) - (gnus-treat-newsgroups-picon gnus-treat-newsgroups-picon) - (gnus-treat-highlight-headers gnus-article-highlight-headers) - (gnus-treat-highlight-signature gnus-article-highlight-signature) - (gnus-treat-strip-trailing-blank-lines - gnus-article-remove-trailing-blank-lines) - (gnus-treat-strip-leading-blank-lines - gnus-article-strip-leading-blank-lines) - (gnus-treat-strip-multiple-blank-lines - gnus-article-strip-multiple-blank-lines) - (gnus-treat-overstrike gnus-article-treat-overstrike) - (gnus-treat-unfold-headers gnus-article-treat-unfold-headers) - (gnus-treat-fold-headers gnus-article-treat-fold-headers) - (gnus-treat-fold-newsgroups gnus-article-treat-fold-newsgroups) - (gnus-treat-buttonize-head gnus-article-add-buttons-to-head) - (gnus-treat-display-smileys gnus-treat-smiley) - (gnus-treat-capitalize-sentences gnus-article-capitalize-sentences) - (gnus-treat-wash-html gnus-article-wash-html) - (gnus-treat-emphasize gnus-article-emphasize) - (gnus-treat-hide-citation gnus-article-hide-citation) - (gnus-treat-hide-citation-maybe gnus-article-hide-citation-maybe) - (gnus-treat-highlight-citation gnus-article-highlight-citation) - (gnus-treat-body-boundary gnus-article-treat-body-boundary) - (gnus-treat-play-sounds gnus-earcon-display))) - -(defvar gnus-article-mime-handle-alist nil) -(defvar article-lapsed-timer nil) -(defvar gnus-article-current-summary nil) - -(defvar gnus-article-mode-syntax-table - (let ((table (copy-syntax-table text-mode-syntax-table))) - ;; This causes the citation match run O(2^n). - ;; (modify-syntax-entry ?- "w" table) - (modify-syntax-entry ?> ")<" table) - (modify-syntax-entry ?< "(>" table) - ;; make M-. in article buffers work for `foo' strings - (modify-syntax-entry ?' " " table) - (modify-syntax-entry ?` " " table) - table) - "Syntax table used in article mode buffers. -Initialized from `text-mode-syntax-table.") - -(defvar gnus-save-article-buffer nil) - -(defvar gnus-article-mode-line-format-alist - (nconc '((?w (gnus-article-wash-status) ?s) - (?m (gnus-article-mime-part-status) ?s)) - gnus-summary-mode-line-format-alist)) - -(defvar gnus-number-of-articles-to-be-saved nil) - -(defvar gnus-inhibit-hiding nil) - -(defvar gnus-article-edit-mode nil) - -;;; Macros for dealing with the article buffer. - -(defmacro gnus-with-article-headers (&rest forms) - `(save-excursion - (set-buffer gnus-article-buffer) - (save-restriction - (let ((inhibit-read-only t) - (inhibit-point-motion-hooks t) - (case-fold-search t)) - (article-narrow-to-head) - ,@forms)))) - -(put 'gnus-with-article-headers 'lisp-indent-function 0) -(put 'gnus-with-article-headers 'edebug-form-spec '(body)) - -(defmacro gnus-with-article-buffer (&rest forms) - `(save-excursion - (set-buffer gnus-article-buffer) - (let ((inhibit-read-only t)) - ,@forms))) - -(put 'gnus-with-article-buffer 'lisp-indent-function 0) -(put 'gnus-with-article-buffer 'edebug-form-spec '(body)) - -(defun gnus-article-goto-header (header) - "Go to HEADER, which is a regular expression." - (re-search-forward (concat "^\\(" header "\\):") nil t)) - -(defsubst gnus-article-hide-text (b e props) - "Set text PROPS on the B to E region, extending `intangible' 1 past B." - (gnus-add-text-properties-when 'article-type nil b e props) - (when (memq 'intangible props) - (put-text-property - (max (1- b) (point-min)) - b 'intangible (cddr (memq 'intangible props))))) - -(defsubst gnus-article-unhide-text (b e) - "Remove hidden text properties from region between B and E." - (remove-text-properties b e gnus-hidden-properties) - (when (memq 'intangible gnus-hidden-properties) - (put-text-property (max (1- b) (point-min)) - b 'intangible nil))) - -(defun gnus-article-hide-text-type (b e type) - "Hide text of TYPE between B and E." - (gnus-add-wash-type type) - (gnus-article-hide-text - b e (cons 'article-type (cons type gnus-hidden-properties)))) - -(defun gnus-article-unhide-text-type (b e type) - "Unhide text of TYPE between B and E." - (gnus-delete-wash-type type) - (remove-text-properties - b e (cons 'article-type (cons type gnus-hidden-properties))) - (when (memq 'intangible gnus-hidden-properties) - (put-text-property (max (1- b) (point-min)) - b 'intangible nil))) - -(defun gnus-article-hide-text-of-type (type) - "Hide text of TYPE in the current buffer." - (save-excursion - (let ((b (point-min)) - (e (point-max))) - (while (setq b (text-property-any b e 'article-type type)) - (add-text-properties b (incf b) gnus-hidden-properties))))) - -(defun gnus-article-delete-text-of-type (type) - "Delete text of TYPE in the current buffer." - (save-excursion - (let ((b (point-min))) - (if (eq type 'multipart) - ;; Remove MIME buttons associated with multipart/alternative parts. - (progn - (goto-char b) - (while (if (get-text-property (point) 'gnus-part) - (setq b (point)) - (when (setq b (next-single-property-change (point) - 'gnus-part)) - (goto-char b) - t)) - (end-of-line) - (skip-chars-forward "\n") - (when (eq (get-text-property b 'article-type) 'multipart) - (delete-region b (point))))) - (while (setq b (text-property-any b (point-max) 'article-type type)) - (delete-region - b (or (text-property-not-all b (point-max) 'article-type type) - (point-max)))))))) - -(defun gnus-article-delete-invisible-text () - "Delete all invisible text in the current buffer." - (save-excursion - (let ((b (point-min))) - (while (setq b (text-property-any b (point-max) 'invisible t)) - (delete-region - b (or (text-property-not-all b (point-max) 'invisible t) - (point-max))))))) - -(defun gnus-article-text-type-exists-p (type) - "Say whether any text of type TYPE exists in the buffer." - (text-property-any (point-min) (point-max) 'article-type type)) - -(defsubst gnus-article-header-rank () - "Give the rank of the string HEADER as given by `gnus-sorted-header-list'." - (let ((list gnus-sorted-header-list) - (i 1)) - (while list - (if (looking-at (car list)) - (setq list nil) - (setq list (cdr list)) - (incf i))) - i)) - -(defun article-hide-headers (&optional arg delete) - "Hide unwanted headers and possibly sort them as well." - (interactive) - ;; This function might be inhibited. - (unless gnus-inhibit-hiding - (let ((inhibit-read-only t) - (case-fold-search t) - (max (1+ (length gnus-sorted-header-list))) - (inhibit-point-motion-hooks t) - (cur (current-buffer)) - ignored visible beg) - (save-excursion - ;; `gnus-ignored-headers' and `gnus-visible-headers' may be - ;; group parameters, so we should go to the summary buffer. - (when (prog1 - (condition-case nil - (progn (set-buffer gnus-summary-buffer) t) - (error nil)) - (setq ignored (when (not gnus-visible-headers) - (cond ((stringp gnus-ignored-headers) - gnus-ignored-headers) - ((listp gnus-ignored-headers) - (mapconcat 'identity - gnus-ignored-headers - "\\|")))) - visible (cond ((stringp gnus-visible-headers) - gnus-visible-headers) - ((and gnus-visible-headers - (listp gnus-visible-headers)) - (mapconcat 'identity - gnus-visible-headers - "\\|"))))) - (set-buffer cur)) - (save-restriction - ;; First we narrow to just the headers. - (article-narrow-to-head) - ;; Hide any "From " lines at the beginning of (mail) articles. - (while (looking-at "From ") - (forward-line 1)) - (unless (bobp) - (delete-region (point-min) (point))) - ;; Then treat the rest of the header lines. - ;; Then we use the two regular expressions - ;; `gnus-ignored-headers' and `gnus-visible-headers' to - ;; select which header lines is to remain visible in the - ;; article buffer. - (while (re-search-forward "^[^ \t:]*:" nil t) - (beginning-of-line) - ;; Mark the rank of the header. - (put-text-property - (point) (1+ (point)) 'message-rank - (if (or (and visible (looking-at visible)) - (and ignored - (not (looking-at ignored)))) - (gnus-article-header-rank) - (+ 2 max))) - (forward-line 1)) - (message-sort-headers-1) - (when (setq beg (text-property-any - (point-min) (point-max) 'message-rank (+ 2 max))) - ;; We delete the unwanted headers. - (gnus-add-wash-type 'headers) - (add-text-properties (point-min) (+ 5 (point-min)) - '(article-type headers dummy-invisible t)) - (delete-region beg (point-max)))))))) - -(defun article-hide-boring-headers (&optional arg) - "Toggle hiding of headers that aren't very interesting. -If given a negative prefix, always show; if given a positive prefix, -always hide." - (interactive (gnus-article-hidden-arg)) - (when (and (not (gnus-article-check-hidden-text 'boring-headers arg)) - (not gnus-show-all-headers)) - (save-excursion - (save-restriction - (let ((inhibit-read-only t) - (list gnus-boring-article-headers) - (inhibit-point-motion-hooks t) - elem) - (article-narrow-to-head) - (while list - (setq elem (pop list)) - (goto-char (point-min)) - (cond - ;; Hide empty headers. - ((eq elem 'empty) - (while (re-search-forward "^[^: \t]+:[ \t]*\n[^ \t]" nil t) - (forward-line -1) - (gnus-article-hide-text-type - (gnus-point-at-bol) - (progn - (end-of-line) - (if (re-search-forward "^[^ \t]" nil t) - (match-beginning 0) - (point-max))) - 'boring-headers))) - ;; Hide boring Newsgroups header. - ((eq elem 'newsgroups) - (when (gnus-string-equal - (gnus-fetch-field "newsgroups") - (gnus-group-real-name - (if (boundp 'gnus-newsgroup-name) - gnus-newsgroup-name - ""))) - (gnus-article-hide-header "newsgroups"))) - ((eq elem 'to-address) - (let ((to (message-fetch-field "to")) - (to-address - (gnus-parameter-to-address - (if (boundp 'gnus-newsgroup-name) - gnus-newsgroup-name "")))) - (when (and to to-address - (ignore-errors - (gnus-string-equal - ;; only one address in To - (nth 1 (mail-extract-address-components to)) - to-address))) - (gnus-article-hide-header "to")))) - ((eq elem 'to-list) - (let ((to (message-fetch-field "to")) - (to-list - (gnus-parameter-to-list - (if (boundp 'gnus-newsgroup-name) - gnus-newsgroup-name "")))) - (when (and to to-list - (ignore-errors - (gnus-string-equal - ;; only one address in To - (nth 1 (mail-extract-address-components to)) - to-list))) - (gnus-article-hide-header "to")))) - ((eq elem 'cc-list) - (let ((cc (message-fetch-field "cc")) - (to-list - (gnus-parameter-to-list - (if (boundp 'gnus-newsgroup-name) - gnus-newsgroup-name "")))) - (when (and cc to-list - (ignore-errors - (gnus-string-equal - ;; only one address in CC - (nth 1 (mail-extract-address-components cc)) - to-list))) - (gnus-article-hide-header "cc")))) - ((eq elem 'followup-to) - (when (gnus-string-equal - (message-fetch-field "followup-to") - (message-fetch-field "newsgroups")) - (gnus-article-hide-header "followup-to"))) - ((eq elem 'reply-to) - (if (gnus-group-find-parameter - gnus-newsgroup-name 'broken-reply-to) - (gnus-article-hide-header "reply-to") - (let ((from (message-fetch-field "from")) - (reply-to (message-fetch-field "reply-to"))) - (when - (and - from reply-to - (ignore-errors - (equal - (sort (mapcar - (lambda (x) (downcase (cadr x))) - (mail-extract-address-components from t)) - 'string<) - (sort (mapcar - (lambda (x) (downcase (cadr x))) - (mail-extract-address-components reply-to t)) - 'string<)))) - (gnus-article-hide-header "reply-to"))))) - ((eq elem 'date) - (let ((date (with-current-buffer gnus-original-article-buffer - ;; If date in `gnus-article-buffer' is localized - ;; (`gnus-treat-date-user-defined'), - ;; `days-between' might fail. - (message-fetch-field "date")))) - (when (and date - (< (days-between (current-time-string) date) - 4)) - (gnus-article-hide-header "date")))) - ((eq elem 'long-to) - (let ((to (message-fetch-field "to")) - (cc (message-fetch-field "cc"))) - (when (> (length to) 1024) - (gnus-article-hide-header "to")) - (when (> (length cc) 1024) - (gnus-article-hide-header "cc")))) - ((eq elem 'many-to) - (let ((to-count 0) - (cc-count 0)) - (goto-char (point-min)) - (while (re-search-forward "^to:" nil t) - (setq to-count (1+ to-count))) - (when (> to-count 1) - (while (> to-count 0) - (goto-char (point-min)) - (save-restriction - (re-search-forward "^to:" nil nil to-count) - (forward-line -1) - (narrow-to-region (point) (point-max)) - (gnus-article-hide-header "to")) - (setq to-count (1- to-count)))) - (goto-char (point-min)) - (while (re-search-forward "^cc:" nil t) - (setq cc-count (1+ cc-count))) - (when (> cc-count 1) - (while (> cc-count 0) - (goto-char (point-min)) - (save-restriction - (re-search-forward "^cc:" nil nil cc-count) - (forward-line -1) - (narrow-to-region (point) (point-max)) - (gnus-article-hide-header "cc")) - (setq cc-count (1- cc-count))))))))))))) - -(defun gnus-article-hide-header (header) - (save-excursion - (goto-char (point-min)) - (when (re-search-forward (concat "^" header ":") nil t) - (gnus-article-hide-text-type - (gnus-point-at-bol) - (progn - (end-of-line) - (if (re-search-forward "^[^ \t]" nil t) - (match-beginning 0) - (point-max))) - 'boring-headers)))) - -(defvar gnus-article-normalized-header-length 40 - "Length of normalized headers.") - -(defun article-normalize-headers () - "Make all header lines 40 characters long." - (interactive) - (let ((inhibit-read-only t) - column) - (save-excursion - (save-restriction - (article-narrow-to-head) - (while (not (eobp)) - (cond - ((< (setq column (- (gnus-point-at-eol) (point))) - gnus-article-normalized-header-length) - (end-of-line) - (insert (make-string - (- gnus-article-normalized-header-length column) - ? ))) - ((> column gnus-article-normalized-header-length) - (gnus-put-text-property - (progn - (forward-char gnus-article-normalized-header-length) - (point)) - (gnus-point-at-eol) - 'invisible t)) - (t - ;; Do nothing. - )) - (forward-line 1)))))) - -(defun article-treat-dumbquotes () - "Translate M****s*** sm*rtq**t*s and other symbols into proper text. -Note that this function guesses whether a character is a sm*rtq**t* or -not, so it should only be used interactively. - -Sm*rtq**t*s are M****s***'s unilateral extension to the -iso-8859-1 character map in an attempt to provide more quoting -characters. If you see something like \\222 or \\264 where -you're expecting some kind of apostrophe or quotation mark, then -try this wash." - (interactive) - (article-translate-strings gnus-article-dumbquotes-map)) - -(defun article-translate-characters (from to) - "Translate all characters in the body of the article according to FROM and TO. -FROM is a string of characters to translate from; to is a string of -characters to translate to." - (save-excursion - (when (article-goto-body) - (let ((inhibit-read-only t) - (x (make-string 225 ?x)) - (i -1)) - (while (< (incf i) (length x)) - (aset x i i)) - (setq i 0) - (while (< i (length from)) - (aset x (aref from i) (aref to i)) - (incf i)) - (translate-region (point) (point-max) x))))) - -(defun article-translate-strings (map) - "Translate all string in the body of the article according to MAP. -MAP is an alist where the elements are on the form (\"from\" \"to\")." - (save-excursion - (when (article-goto-body) - (let ((inhibit-read-only t) - elem) - (while (setq elem (pop map)) - (save-excursion - (while (search-forward (car elem) nil t) - (replace-match (cadr elem))))))))) - -(defun article-treat-overstrike () - "Translate overstrikes into bold text." - (interactive) - (save-excursion - (when (article-goto-body) - (let ((inhibit-read-only t)) - (while (search-forward "\b" nil t) - (let ((next (char-after)) - (previous (char-after (- (point) 2)))) - ;; We do the boldification/underlining by hiding the - ;; overstrikes and putting the proper text property - ;; on the letters. - (cond - ((eq next previous) - (gnus-article-hide-text-type (- (point) 2) (point) 'overstrike) - (put-text-property (point) (1+ (point)) 'face 'bold)) - ((eq next ?_) - (gnus-article-hide-text-type - (1- (point)) (1+ (point)) 'overstrike) - (put-text-property - (- (point) 2) (1- (point)) 'face 'underline)) - ((eq previous ?_) - (gnus-article-hide-text-type (- (point) 2) (point) 'overstrike) - (put-text-property - (point) (1+ (point)) 'face 'underline))))))))) - -(defun gnus-article-treat-unfold-headers () - "Unfold folded message headers. -Only the headers that fit into the current window width will be -unfolded." - (interactive) - (gnus-with-article-headers - (let (length) - (while (not (eobp)) - (save-restriction - (mail-header-narrow-to-field) - (let ((header (buffer-string))) - (with-temp-buffer - (insert header) - (goto-char (point-min)) - (while (re-search-forward "\n[\t ]" nil t) - (replace-match " " t t))) - (setq length (- (point-max) (point-min) 1))) - (when (< length (window-width)) - (while (re-search-forward "\n[\t ]" nil t) - (replace-match " " t t))) - (goto-char (point-max))))))) - -(defun gnus-article-treat-fold-headers () - "Fold message headers." - (interactive) - (gnus-with-article-headers - (while (not (eobp)) - (save-restriction - (mail-header-narrow-to-field) - (mail-header-fold-field) - (goto-char (point-max)))))) - -(defun gnus-treat-smiley () - "Toggle display of textual emoticons (\"smileys\") as small graphical icons." - (interactive) - (gnus-with-article-buffer - (if (memq 'smiley gnus-article-wash-types) - (gnus-delete-images 'smiley) - (article-goto-body) - (let ((images (smiley-region (point) (point-max)))) - (when images - (gnus-add-wash-type 'smiley) - (dolist (image images) - (gnus-add-image 'smiley image))))))) - -(defun gnus-article-remove-images () - "Remove all images from the article buffer." - (interactive) - (gnus-with-article-buffer - (dolist (elem gnus-article-image-alist) - (gnus-delete-images (car elem))))) - -(defun gnus-article-treat-fold-newsgroups () - "Unfold folded message headers. -Only the headers that fit into the current window width will be -unfolded." - (interactive) - (gnus-with-article-headers - (while (gnus-article-goto-header "newsgroups\\|followup-to") - (save-restriction - (mail-header-narrow-to-field) - (while (re-search-forward ", *" nil t) - (replace-match ", " t t)) - (mail-header-fold-field) - (goto-char (point-max)))))) - -(defun gnus-article-treat-body-boundary () - "Place a boundary line at the end of the headers." - (interactive) - (when (and gnus-body-boundary-delimiter - (> (length gnus-body-boundary-delimiter) 0)) - (gnus-with-article-headers - (goto-char (point-max)) - (let ((start (point))) - (insert "X-Boundary: ") - (gnus-add-text-properties start (point) '(invisible t intangible t)) - (insert (let (str) - (while (>= (1- (window-width)) (length str)) - (setq str (concat str gnus-body-boundary-delimiter))) - (substring str 0 (1- (window-width)))) - "\n") - (gnus-put-text-property start (point) 'gnus-decoration 'header))))) - -(defun article-fill-long-lines () - "Fill lines that are wider than the window width." - (interactive) - (save-excursion - (let ((inhibit-read-only t) - (width (window-width (get-buffer-window (current-buffer))))) - (save-restriction - (article-goto-body) - (let ((adaptive-fill-mode nil)) ;Why? -sm - (while (not (eobp)) - (end-of-line) - (when (>= (current-column) (min fill-column width)) - (narrow-to-region (min (1+ (point)) (point-max)) - (gnus-point-at-bol)) - (let ((goback (point-marker))) - (fill-paragraph nil) - (goto-char (marker-position goback))) - (widen)) - (forward-line 1))))))) - -(defun article-capitalize-sentences () - "Capitalize the first word in each sentence." - (interactive) - (save-excursion - (let ((inhibit-read-only t) - (paragraph-start "^[\n\^L]")) - (article-goto-body) - (while (not (eobp)) - (capitalize-word 1) - (forward-sentence))))) - -(defun article-remove-cr () - "Remove trailing CRs and then translate remaining CRs into LFs." - (interactive) - (save-excursion - (let ((inhibit-read-only t)) - (goto-char (point-min)) - (while (re-search-forward "\r+$" nil t) - (replace-match "" t t)) - (goto-char (point-min)) - (while (search-forward "\r" nil t) - (replace-match "\n" t t))))) - -(defun article-remove-trailing-blank-lines () - "Remove all trailing blank lines from the article." - (interactive) - (save-excursion - (let ((inhibit-read-only t)) - (goto-char (point-max)) - (delete-region - (point) - (progn - (while (and (not (bobp)) - (looking-at "^[ \t]*$") - (not (gnus-annotation-in-region-p - (point) (gnus-point-at-eol)))) - (forward-line -1)) - (forward-line 1) - (point)))))) - -(defun article-display-face () - "Display any Face headers in the header." - (interactive) - (let ((wash-face-p buffer-read-only)) - (gnus-with-article-headers - ;; When displaying parts, this function can be called several times on - ;; the same article, without any intended toggle semantic (as typing `W - ;; D d' would have). So face deletion must occur only when we come from - ;; an interactive command, that is when the *Article* buffer is - ;; read-only. - (if (and wash-face-p (memq 'face gnus-article-wash-types)) - (gnus-delete-images 'face) - (let (face faces from) - (save-current-buffer - (when (and wash-face-p - (gnus-buffer-live-p gnus-original-article-buffer) - (not (re-search-forward "^Face:[\t ]*" nil t))) - (set-buffer gnus-original-article-buffer)) - (save-restriction - (mail-narrow-to-head) - (while (gnus-article-goto-header "Face") - (push (mail-header-field-value) faces)))) - (when faces - (goto-char (point-min)) - (let ((from (gnus-article-goto-header "from")) - png image) - (unless from - (insert "From:") - (setq from (point)) - (insert "[no `from' set]\n")) - (while faces - (when (setq png (gnus-convert-face-to-png (pop faces))) - (setq image (gnus-create-image png 'png t)) - (goto-char from) - (gnus-add-wash-type 'face) - (gnus-add-image 'face image) - (gnus-put-image image nil 'face)))))))))) - -(defun article-display-x-face (&optional force) - "Look for an X-Face header and display it if present." - (interactive (list 'force)) - (let ((wash-face-p buffer-read-only)) ;; When type `W f' - (gnus-with-article-headers - ;; Delete the old process, if any. - (when (process-status "article-x-face") - (delete-process "article-x-face")) - ;; See the comment in `article-display-face'. - (if (and wash-face-p (memq 'xface gnus-article-wash-types)) - ;; We have already displayed X-Faces, so we remove them - ;; instead. - (gnus-delete-images 'xface) - ;; Display X-Faces. - (let (x-faces from face) - (save-current-buffer - (when (and wash-face-p - (gnus-buffer-live-p gnus-original-article-buffer) - (not (re-search-forward "^X-Face:[\t ]*" nil t))) - ;; If type `W f', use gnus-original-article-buffer, - ;; otherwise use the current buffer because displaying - ;; RFC822 parts calls this function too. - (set-buffer gnus-original-article-buffer)) - (save-restriction - (mail-narrow-to-head) - (while (gnus-article-goto-header "X-Face") - (push (mail-header-field-value) x-faces)) - (setq from (message-fetch-field "from")))) - ;; Sending multiple EOFs to xv doesn't work, so we only do a - ;; single external face. - (when (stringp gnus-article-x-face-command) - (setq x-faces (list (car x-faces)))) - (when (and x-faces - gnus-article-x-face-command - (or force - ;; Check whether this face is censored. - (not gnus-article-x-face-too-ugly) - (and from - (not (string-match gnus-article-x-face-too-ugly - from))))) - (while (setq face (pop x-faces)) - ;; We display the face. - (cond ((stringp gnus-article-x-face-command) - ;; The command is a string, so we interpret the command - ;; as a, well, command, and fork it off. - (let ((process-connection-type nil)) - (gnus-set-process-query-on-exit-flag - (start-process - "article-x-face" nil shell-file-name - shell-command-switch gnus-article-x-face-command) - nil) - (with-temp-buffer - (insert face) - (process-send-region "article-x-face" - (point-min) (point-max))) - (process-send-eof "article-x-face"))) - ((functionp gnus-article-x-face-command) - ;; The command is a lisp function, so we call it. - (funcall gnus-article-x-face-command face)) - (t - (error "%s is not a function" - gnus-article-x-face-command)))))))))) - -(defun article-decode-mime-words () - "Decode all MIME-encoded words in the article." - (interactive) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((inhibit-point-motion-hooks t) - (inhibit-read-only t) - (mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets - (save-excursion (set-buffer gnus-summary-buffer) - gnus-newsgroup-ignored-charsets))) - (mail-decode-encoded-word-region (point-min) (point-max))))) - -(defun article-decode-charset (&optional prompt) - "Decode charset-encoded text in the article. -If PROMPT (the prefix), prompt for a coding system to use." - (interactive "P") - (let ((inhibit-point-motion-hooks t) (case-fold-search t) - (inhibit-read-only t) - (mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets - (save-excursion (condition-case nil - (set-buffer gnus-summary-buffer) - (error)) - gnus-newsgroup-ignored-charsets)) - ct cte ctl charset format) - (save-excursion - (save-restriction - (article-narrow-to-head) - (setq ct (message-fetch-field "Content-Type" t) - cte (message-fetch-field "Content-Transfer-Encoding" t) - ctl (and ct (mail-header-parse-content-type ct)) - charset (cond - (prompt - (mm-read-coding-system "Charset to decode: ")) - (ctl - (mail-content-type-get ctl 'charset))) - format (and ctl (mail-content-type-get ctl 'format))) - (when cte - (setq cte (mail-header-strip cte))) - (if (and ctl (not (string-match "/" (car ctl)))) - (setq ctl nil)) - (goto-char (point-max))) - (forward-line 1) - (save-restriction - (narrow-to-region (point) (point-max)) - (when (and (eq mail-parse-charset 'gnus-decoded) - (eq (mm-body-7-or-8) '8bit)) - ;; The text code could have been decoded. - (setq charset mail-parse-charset)) - (when (and (or (not ctl) - (equal (car ctl) "text/plain")) - (not format)) ;; article with format will decode later. - (mm-decode-body - charset (and cte (intern (downcase - (gnus-strip-whitespace cte)))) - (car ctl))))))) - -(defun article-decode-encoded-words () - "Remove encoded-word encoding from headers." - (let ((inhibit-point-motion-hooks t) - (mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets - (save-excursion (condition-case nil - (set-buffer gnus-summary-buffer) - (error)) - gnus-newsgroup-ignored-charsets)) - (inhibit-read-only t) - end start) - (goto-char (point-min)) - (when (search-forward "\n\n" nil 'move) - (forward-line -1)) - (setq end (point)) - (while (not (bobp)) - (while (progn - (forward-line -1) - (and (not (bobp)) - (memq (char-after) '(?\t ? ))))) - (setq start (point)) - (if (looking-at "\ -\\(?:Resent-\\)?\\(?:From\\|Cc\\|To\\|Bcc\\|\\(?:In-\\)?Reply-To\\|Sender\ -\\|Mail-Followup-To\\|Mail-Copies-To\\|Approved\\):") - (funcall gnus-decode-address-function start end) - (funcall gnus-decode-header-function start end)) - (goto-char (setq end start))))) - -(defun article-decode-group-name () - "Decode group names in `Newsgroups:'." - (let ((inhibit-point-motion-hooks t) - (inhibit-read-only t) - (method (gnus-find-method-for-group gnus-newsgroup-name))) - (when (and (or gnus-group-name-charset-method-alist - gnus-group-name-charset-group-alist) - (gnus-buffer-live-p gnus-original-article-buffer)) - (save-restriction - (article-narrow-to-head) - (with-current-buffer gnus-original-article-buffer - (goto-char (point-min))) - (while (re-search-forward - "^Newsgroups:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]" nil t) - (replace-match (save-match-data - (gnus-decode-newsgroups - ;; XXX how to use data in article buffer? - (with-current-buffer gnus-original-article-buffer - (re-search-forward - "^Newsgroups:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]" - nil t) - (match-string 1)) - gnus-newsgroup-name method)) - t t nil 1)) - (goto-char (point-min)) - (with-current-buffer gnus-original-article-buffer - (goto-char (point-min))) - (while (re-search-forward - "^Followup-To:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]" nil t) - (replace-match (save-match-data - (gnus-decode-newsgroups - ;; XXX how to use data in article buffer? - (with-current-buffer gnus-original-article-buffer - (re-search-forward - "^Followup-To:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]" - nil t) - (match-string 1)) - gnus-newsgroup-name method)) - t t nil 1)))))) - -(autoload 'idna-to-unicode "idna") - -(defun article-decode-idna-rhs () - "Decode IDNA strings in RHS in various headers in current buffer. -The following headers are decoded: From:, To:, Cc:, Reply-To:, -Mail-Reply-To: and Mail-Followup-To:." - (when gnus-use-idna - (save-restriction - (let ((inhibit-point-motion-hooks t) - (inhibit-read-only t)) - (article-narrow-to-head) - (goto-char (point-min)) - (while (re-search-forward "@[^ \t\n\r,>]*\\(xn--[-A-Za-z0-9.]*\\)[ \t\n\r,>]" nil t) - (let (ace unicode) - (when (save-match-data - (and (setq ace (match-string 1)) - (save-excursion - (and (re-search-backward "^[^ \t]" nil t) - (looking-at "From\\|To\\|Cc\\|Reply-To\\|Mail-Reply-To\\|Mail-Followup-To"))) - (setq unicode (idna-to-unicode ace)))) - (unless (string= ace unicode) - (replace-match unicode nil nil nil 1))))))))) - -(defun article-de-quoted-unreadable (&optional force read-charset) - "Translate a quoted-printable-encoded article. -If FORCE, decode the article whether it is marked as quoted-printable -or not. -If READ-CHARSET, ask for a coding system." - (interactive (list 'force current-prefix-arg)) - (save-excursion - (let ((inhibit-read-only t) type charset) - (if (gnus-buffer-live-p gnus-original-article-buffer) - (with-current-buffer gnus-original-article-buffer - (setq type - (gnus-fetch-field "content-transfer-encoding")) - (let* ((ct (gnus-fetch-field "content-type")) - (ctl (and ct (mail-header-parse-content-type ct)))) - (setq charset (and ctl - (mail-content-type-get ctl 'charset))) - (if (stringp charset) - (setq charset (intern (downcase charset))))))) - (if read-charset - (setq charset (mm-read-coding-system "Charset: " charset))) - (unless charset - (setq charset gnus-newsgroup-charset)) - (when (or force - (and type (let ((case-fold-search t)) - (string-match "quoted-printable" type)))) - (article-goto-body) - (quoted-printable-decode-region - (point) (point-max) (mm-charset-to-coding-system charset)))))) - -(defun article-de-base64-unreadable (&optional force read-charset) - "Translate a base64 article. -If FORCE, decode the article whether it is marked as base64 not. -If READ-CHARSET, ask for a coding system." - (interactive (list 'force current-prefix-arg)) - (save-excursion - (let ((inhibit-read-only t) type charset) - (if (gnus-buffer-live-p gnus-original-article-buffer) - (with-current-buffer gnus-original-article-buffer - (setq type - (gnus-fetch-field "content-transfer-encoding")) - (let* ((ct (gnus-fetch-field "content-type")) - (ctl (and ct (mail-header-parse-content-type ct)))) - (setq charset (and ctl - (mail-content-type-get ctl 'charset))) - (if (stringp charset) - (setq charset (intern (downcase charset))))))) - (if read-charset - (setq charset (mm-read-coding-system "Charset: " charset))) - (unless charset - (setq charset gnus-newsgroup-charset)) - (when (or force - (and type (let ((case-fold-search t)) - (string-match "base64" type)))) - (article-goto-body) - (save-restriction - (narrow-to-region (point) (point-max)) - (base64-decode-region (point-min) (point-max)) - (mm-decode-coding-region - (point-min) (point-max) (mm-charset-to-coding-system charset))))))) - -(eval-when-compile - (require 'rfc1843)) - -(defun article-decode-HZ () - "Translate a HZ-encoded article." - (interactive) - (require 'rfc1843) - (save-excursion - (let ((inhibit-read-only t)) - (rfc1843-decode-region (point-min) (point-max))))) - -(defun article-unsplit-urls () - "Remove the newlines that some other mailers insert into URLs." - (interactive) - (save-excursion - (let ((inhibit-read-only t)) - (goto-char (point-min)) - (while (re-search-forward - "\\(\\(https?\\|ftp\\)://\\S-+\\) *\n\\(\\S-+\\)" nil t) - (replace-match "\\1\\3" t))) - (when (interactive-p) - (gnus-treat-article nil)))) - - -(defun article-wash-html (&optional read-charset) - "Format an HTML article. -If READ-CHARSET, ask for a coding system. If it is a number, the -charset defined in `gnus-summary-show-article-charset-alist' is used." - (interactive "P") - (save-excursion - (let ((inhibit-read-only t) - charset) - (if read-charset - (if (or (and (numberp read-charset) - (setq charset - (cdr - (assq read-charset - gnus-summary-show-article-charset-alist)))) - (setq charset (mm-read-coding-system "Charset: "))) - (let ((gnus-summary-show-article-charset-alist - (list (cons 1 charset)))) - (with-current-buffer gnus-summary-buffer - (gnus-summary-show-article 1))) - (error "No charset is given")) - (when (gnus-buffer-live-p gnus-original-article-buffer) - (with-current-buffer gnus-original-article-buffer - (let* ((ct (gnus-fetch-field "content-type")) - (ctl (and ct (mail-header-parse-content-type ct)))) - (setq charset (and ctl - (mail-content-type-get ctl 'charset))) - (when (stringp charset) - (setq charset (intern (downcase charset))))))) - (unless charset - (setq charset gnus-newsgroup-charset))) - (article-goto-body) - (save-window-excursion - (save-restriction - (narrow-to-region (point) (point-max)) - (let* ((func (or gnus-article-wash-function mm-text-html-renderer)) - (entry (assq func mm-text-html-washer-alist))) - (when entry - (setq func (cdr entry))) - (cond - ((functionp func) - (funcall func)) - (t - (apply (car func) (cdr func)))))))))) - -(defun gnus-article-wash-html-with-w3 () - "Wash the current buffer with w3." - (mm-setup-w3) - (let ((w3-strict-width (window-width)) - (url-standalone-mode t) - (url-gateway-unplugged t) - (w3-honor-stylesheets nil)) - (condition-case () - (w3-region (point-min) (point-max)) - (error)))) - -(defun gnus-article-wash-html-with-w3m () - "Wash the current buffer with emacs-w3m." - (mm-setup-w3m) - (let ((w3m-safe-url-regexp mm-w3m-safe-url-regexp) - w3m-force-redisplay) - (w3m-region (point-min) (point-max))) - (when (and mm-inline-text-html-with-w3m-keymap - (boundp 'w3m-minor-mode-map) - w3m-minor-mode-map) - (add-text-properties - (point-min) (point-max) - (list 'keymap w3m-minor-mode-map - ;; Put the mark meaning this part was rendered by emacs-w3m. - 'mm-inline-text-html-with-w3m t)))) - -(eval-when-compile (defvar charset)) ;; Bound by `article-wash-html'. - -(defun gnus-article-wash-html-with-w3m-standalone () - "Wash the current buffer with w3m." - (if (mm-w3m-standalone-supports-m17n-p) - (progn - (unless (mm-coding-system-p charset) ;; Bound by `article-wash-html'. - ;; The default. - (setq charset 'iso-8859-1)) - (let ((coding-system-for-write charset) - (coding-system-for-read charset)) - (call-process-region - (point-min) (point-max) - "w3m" t t nil "-dump" "-T" "text/html" - "-I" (symbol-name charset) "-O" (symbol-name charset)))) - (mm-inline-wash-with-stdin nil "w3m" "-dump" "-T" "text/html"))) - -(defun article-hide-list-identifiers () - "Remove list identifies from the Subject header. -The `gnus-list-identifiers' variable specifies what to do." - (interactive) - (let ((inhibit-point-motion-hooks t) - (regexp (if (consp gnus-list-identifiers) - (mapconcat 'identity gnus-list-identifiers " *\\|") - gnus-list-identifiers)) - (inhibit-read-only t)) - (when regexp - (save-excursion - (save-restriction - (article-narrow-to-head) - (goto-char (point-min)) - (while (re-search-forward - (concat "^Subject: +\\(R[Ee]: +\\)*\\(" regexp " *\\)") - nil t) - (delete-region (match-beginning 2) (match-end 0)) - (beginning-of-line)) - (when (re-search-forward - "^Subject: +\\(\\(R[Ee]: +\\)+\\)R[Ee]: +" nil t) - (delete-region (match-beginning 1) (match-end 1)))))))) - -(defun article-hide-pem (&optional arg) - "Toggle hiding of any PEM headers and signatures in the current article. -If given a negative prefix, always show; if given a positive prefix, -always hide." - (interactive (gnus-article-hidden-arg)) - (unless (gnus-article-check-hidden-text 'pem arg) - (save-excursion - (let ((inhibit-read-only t) end) - (goto-char (point-min)) - ;; Hide the horrendously ugly "header". - (when (and (search-forward - "\n-----BEGIN PRIVACY-ENHANCED MESSAGE-----\n" - nil t) - (setq end (1+ (match-beginning 0)))) - (gnus-add-wash-type 'pem) - (gnus-article-hide-text-type - end - (if (search-forward "\n\n" nil t) - (match-end 0) - (point-max)) - 'pem) - ;; Hide the trailer as well - (when (search-forward "\n-----END PRIVACY-ENHANCED MESSAGE-----\n" - nil t) - (gnus-article-hide-text-type - (match-beginning 0) (match-end 0) 'pem))))))) - -(defun article-strip-banner () - "Strip the banners specified by the `banner' group parameter and by -`gnus-article-address-banner-alist'." - (interactive) - (save-excursion - (save-restriction - (let ((inhibit-point-motion-hooks t)) - (when (gnus-parameter-banner gnus-newsgroup-name) - (article-really-strip-banner - (gnus-parameter-banner gnus-newsgroup-name))) - (when gnus-article-address-banner-alist - ;; Note that the From header is decoded here, so it is - ;; required that the *-extract-address-components function - ;; supports non-ASCII text. - (let ((from (save-restriction - (widen) - (article-narrow-to-head) - (mail-fetch-field "from")))) - (when (and from - (setq from - (cadr (funcall gnus-extract-address-components - from)))) - (catch 'found - (dolist (pair gnus-article-address-banner-alist) - (when (string-match (car pair) from) - (throw 'found - (article-really-strip-banner (cdr pair))))))))))))) - -(defun article-really-strip-banner (banner) - "Strip the banner specified by the argument." - (save-excursion - (save-restriction - (let ((inhibit-point-motion-hooks t) - (gnus-signature-limit nil) - (inhibit-read-only t)) - (article-goto-body) - (cond - ((eq banner 'signature) - (when (gnus-article-narrow-to-signature) - (widen) - (forward-line -1) - (delete-region (point) (point-max)))) - ((symbolp banner) - (if (setq banner (cdr (assq banner gnus-article-banner-alist))) - (while (re-search-forward banner nil t) - (delete-region (match-beginning 0) (match-end 0))))) - ((stringp banner) - (while (re-search-forward banner nil t) - (delete-region (match-beginning 0) (match-end 0))))))))) - -(defun article-babel () - "Translate article using an online translation service." - (interactive) - (require 'babel) - (save-excursion - (set-buffer gnus-article-buffer) - (when (article-goto-body) - (let* ((inhibit-read-only t) - (start (point)) - (end (point-max)) - (orig (buffer-substring start end)) - (trans (babel-as-string orig))) - (save-restriction - (narrow-to-region start end) - (delete-region start end) - (insert trans)))))) - -(defun article-hide-signature (&optional arg) - "Hide the signature in the current article. -If given a negative prefix, always show; if given a positive prefix, -always hide." - (interactive (gnus-article-hidden-arg)) - (unless (gnus-article-check-hidden-text 'signature arg) - (save-excursion - (save-restriction - (let ((inhibit-read-only t)) - (when (gnus-article-narrow-to-signature) - (gnus-article-hide-text-type - (point-min) (point-max) 'signature)))))) - (gnus-set-mode-line 'article)) - -(defun article-strip-headers-in-body () - "Strip offensive headers from bodies." - (interactive) - (save-excursion - (article-goto-body) - (let ((case-fold-search t)) - (when (looking-at "x-no-archive:") - (gnus-delete-line))))) - -(defun article-strip-leading-blank-lines () - "Remove all blank lines from the beginning of the article." - (interactive) - (save-excursion - (let ((inhibit-point-motion-hooks t) - (inhibit-read-only t)) - (when (article-goto-body) - (while (and (not (eobp)) - (looking-at "[ \t]*$")) - (gnus-delete-line)))))) - -(defun article-narrow-to-head () - "Narrow the buffer to the head of the message. -Point is left at the beginning of the narrowed-to region." - (narrow-to-region - (goto-char (point-min)) - (if (search-forward "\n\n" nil 1) - (1- (point)) - (point-max))) - (goto-char (point-min))) - -(defun article-goto-body () - "Place point at the start of the body." - (goto-char (point-min)) - (cond - ;; This variable is only bound when dealing with separate - ;; MIME body parts. - (article-goto-body-goes-to-point-min-p - t) - ((search-forward "\n\n" nil t) - t) - (t - (goto-char (point-max)) - nil))) - -(defun article-strip-multiple-blank-lines () - "Replace consecutive blank lines with one empty line." - (interactive) - (save-excursion - (let ((inhibit-point-motion-hooks t) - (inhibit-read-only t)) - ;; First make all blank lines empty. - (article-goto-body) - (while (re-search-forward "^[ \t]+$" nil t) - (unless (gnus-annotation-in-region-p - (match-beginning 0) (match-end 0)) - (replace-match "" nil t))) - ;; Then replace multiple empty lines with a single empty line. - (article-goto-body) - (while (re-search-forward "\n\n\\(\n+\\)" nil t) - (unless (gnus-annotation-in-region-p - (match-beginning 0) (match-end 0)) - (delete-region (match-beginning 1) (match-end 1))))))) - -(defun article-strip-leading-space () - "Remove all white space from the beginning of the lines in the article." - (interactive) - (save-excursion - (let ((inhibit-point-motion-hooks t) - (inhibit-read-only t)) - (article-goto-body) - (while (re-search-forward "^[ \t]+" nil t) - (replace-match "" t t))))) - -(defun article-strip-trailing-space () - "Remove all white space from the end of the lines in the article." - (interactive) - (save-excursion - (let ((inhibit-point-motion-hooks t) - (inhibit-read-only t)) - (article-goto-body) - (while (re-search-forward "[ \t]+$" nil t) - (replace-match "" t t))))) - -(defun article-strip-blank-lines () - "Strip leading, trailing and multiple blank lines." - (interactive) - (article-strip-leading-blank-lines) - (article-remove-trailing-blank-lines) - (article-strip-multiple-blank-lines)) - -(defun article-strip-all-blank-lines () - "Strip all blank lines." - (interactive) - (save-excursion - (let ((inhibit-point-motion-hooks t) - (inhibit-read-only t)) - (article-goto-body) - (while (re-search-forward "^[ \t]*\n" nil t) - (replace-match "" t t))))) - -(defun gnus-article-narrow-to-signature () - "Narrow to the signature; return t if a signature is found, else nil." - (let ((inhibit-point-motion-hooks t)) - (when (gnus-article-search-signature) - (forward-line 1) - ;; Check whether we have some limits to what we consider - ;; to be a signature. - (let ((limits (if (listp gnus-signature-limit) gnus-signature-limit - (list gnus-signature-limit))) - limit limited) - (while (setq limit (pop limits)) - (if (or (and (integerp limit) - (< (- (point-max) (point)) limit)) - (and (floatp limit) - (< (count-lines (point) (point-max)) limit)) - (and (functionp limit) - (funcall limit)) - (and (stringp limit) - (not (re-search-forward limit nil t)))) - () ; This limit did not succeed. - (setq limited t - limits nil))) - (unless limited - (narrow-to-region (point) (point-max)) - t))))) - -(defun gnus-article-search-signature () - "Search the current buffer for the signature separator. -Put point at the beginning of the signature separator." - (let ((cur (point))) - (goto-char (point-max)) - (if (if (stringp gnus-signature-separator) - (re-search-backward gnus-signature-separator nil t) - (let ((seps gnus-signature-separator)) - (while (and seps - (not (re-search-backward (car seps) nil t))) - (pop seps)) - seps)) - t - (goto-char cur) - nil))) - -(defun gnus-article-hidden-arg () - "Return the current prefix arg as a number, or 0 if no prefix." - (list (if current-prefix-arg - (prefix-numeric-value current-prefix-arg) - 0))) - -(defun gnus-article-check-hidden-text (type arg) - "Return nil if hiding is necessary. -Arg can be nil or a number. nil and positive means hide, negative -means show, 0 means toggle." - (save-excursion - (save-restriction - (let ((hide (gnus-article-hidden-text-p type))) - (cond - ((or (null arg) - (> arg 0)) - nil) - ((< arg 0) - (gnus-article-show-hidden-text type) - t) - (t - (if (eq hide 'hidden) - (progn - (gnus-article-show-hidden-text type) - t) - nil))))))) - -(defun gnus-article-hidden-text-p (type) - "Say whether the current buffer contains hidden text of type TYPE." - (let ((pos (text-property-any (point-min) (point-max) 'article-type type))) - (while (and pos - (not (get-text-property pos 'invisible)) - (not (get-text-property pos 'dummy-invisible))) - (setq pos - (text-property-any (1+ pos) (point-max) 'article-type type))) - (if pos - 'hidden - nil))) - -(defun gnus-article-show-hidden-text (type &optional dummy) - "Show all hidden text of type TYPE. -Originally it is hide instead of DUMMY." - (let ((inhibit-read-only t) - (inhibit-point-motion-hooks t)) - (gnus-remove-text-properties-when - 'article-type type - (point-min) (point-max) - (cons 'article-type (cons type - gnus-hidden-properties))) - (gnus-delete-wash-type type))) - -(defconst article-time-units - `((year . ,(* 365.25 24 60 60)) - (week . ,(* 7 24 60 60)) - (day . ,(* 24 60 60)) - (hour . ,(* 60 60)) - (minute . 60) - (second . 1)) - "Mapping from time units to seconds.") - -(defun gnus-article-forward-header () - "Move point to the start of the next header. -If the current header is a continuation header, this can be several -lines forward." - (let ((ended nil)) - (while (not ended) - (forward-line 1) - (if (looking-at "[ \t]+[^ \t]") - (forward-line 1) - (setq ended t))))) - -(defun article-date-ut (&optional type highlight) - "Convert DATE date to universal time in the current article. -If TYPE is `local', convert to local time; if it is `lapsed', output -how much time has lapsed since DATE. For `lapsed', the value of -`gnus-article-date-lapsed-new-header' says whether the \"X-Sent:\" header -should replace the \"Date:\" one, or should be added below it." - (interactive (list 'ut t)) - (let* ((tdate-regexp "^Date:[ \t]\\|^X-Sent:[ \t]") - (date-regexp (cond ((not gnus-article-date-lapsed-new-header) - tdate-regexp) - ((eq type 'lapsed) - "^X-Sent:[ \t]") - (article-lapsed-timer - "^Date:[ \t]") - (t - tdate-regexp))) - (case-fold-search t) - (inhibit-read-only t) - (inhibit-point-motion-hooks t) - pos date bface eface) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while (or (setq date (get-text-property (setq pos (point)) - 'original-date)) - (when (setq pos (next-single-property-change - (point) 'original-date)) - (setq date (get-text-property pos 'original-date)) - t)) - (narrow-to-region pos (or (text-property-any pos (point-max) - 'original-date nil) - (point-max))) - (goto-char (point-min)) - (when (re-search-forward tdate-regexp nil t) - (setq bface (get-text-property (gnus-point-at-bol) 'face) - eface (get-text-property (1- (gnus-point-at-eol)) 'face))) - (goto-char (point-min)) - (setq pos nil) - ;; Delete any old Date headers. - (while (re-search-forward date-regexp nil t) - (if pos - (delete-region (gnus-point-at-bol) - (progn - (gnus-article-forward-header) - (point))) - (delete-region (gnus-point-at-bol) - (progn - (gnus-article-forward-header) - (forward-char -1) - (point))) - (setq pos (point)))) - (when (and (not pos) - (re-search-forward tdate-regexp nil t)) - (forward-line 1)) - (gnus-goto-char pos) - (insert (article-make-date-line date (or type 'ut))) - (unless pos - (insert "\n") - (forward-line -1)) - ;; Do highlighting. - (beginning-of-line) - (when (looking-at "\\([^:]+\\): *\\(.*\\)$") - (put-text-property (match-beginning 1) (1+ (match-end 1)) - 'face bface) - (put-text-property (match-beginning 2) (match-end 2) - 'face eface)) - (put-text-property (point-min) (1- (point-max)) 'original-date date) - (goto-char (point-max)) - (widen)))))) - -(defun article-make-date-line (date type) - "Return a DATE line of TYPE." - (unless (memq type '(local ut original user iso8601 lapsed english)) - (error "Unknown conversion type: %s" type)) - (condition-case () - (let ((time (date-to-time date))) - (cond - ;; Convert to the local timezone. - ((eq type 'local) - (let ((tz (car (current-time-zone time)))) - (format "Date: %s %s%02d%02d" (current-time-string time) - (if (> tz 0) "+" "-") (/ (abs tz) 3600) - (/ (% (abs tz) 3600) 60)))) - ;; Convert to Universal Time. - ((eq type 'ut) - (concat "Date: " - (current-time-string - (let* ((e (parse-time-string date)) - (tm (apply 'encode-time e)) - (ms (car tm)) - (ls (- (cadr tm) (car (current-time-zone time))))) - (cond ((< ls 0) (list (1- ms) (+ ls 65536))) - ((> ls 65535) (list (1+ ms) (- ls 65536))) - (t (list ms ls))))) - " UT")) - ;; Get the original date from the article. - ((eq type 'original) - (concat "Date: " (if (string-match "\n+$" date) - (substring date 0 (match-beginning 0)) - date))) - ;; Let the user define the format. - ((eq type 'user) - (let ((format (or (condition-case nil - (with-current-buffer gnus-summary-buffer - gnus-article-time-format) - (error nil)) - gnus-article-time-format))) - (if (functionp format) - (funcall format time) - (concat "Date: " (format-time-string format time))))) - ;; ISO 8601. - ((eq type 'iso8601) - (let ((tz (car (current-time-zone time)))) - (concat - "Date: " - (format-time-string "%Y%m%dT%H%M%S" time) - (format "%s%02d%02d" - (if (> tz 0) "+" "-") (/ (abs tz) 3600) - (/ (% (abs tz) 3600) 60))))) - ;; Do an X-Sent lapsed format. - ((eq type 'lapsed) - ;; If the date is seriously mangled, the timezone functions are - ;; liable to bug out, so we ignore all errors. - (let* ((now (current-time)) - (real-time (subtract-time now time)) - (real-sec (and real-time - (+ (* (float (car real-time)) 65536) - (cadr real-time)))) - (sec (and real-time (abs real-sec))) - num prev) - (cond - ((null real-time) - "X-Sent: Unknown") - ((zerop sec) - "X-Sent: Now") - (t - (concat - "X-Sent: " - ;; This is a bit convoluted, but basically we go - ;; through the time units for years, weeks, etc, - ;; and divide things to see whether that results - ;; in positive answers. - (mapconcat - (lambda (unit) - (if (zerop (setq num (ffloor (/ sec (cdr unit))))) - ;; The (remaining) seconds are too few to - ;; be divided into this time unit. - "" - ;; It's big enough, so we output it. - (setq sec (- sec (* num (cdr unit)))) - (prog1 - (concat (if prev ", " "") (int-to-string - (floor num)) - " " (symbol-name (car unit)) - (if (> num 1) "s" "")) - (setq prev t)))) - article-time-units "") - ;; If dates are odd, then it might appear like the - ;; article was sent in the future. - (if (> real-sec 0) - " ago" - " in the future")))))) - ;; Display the date in proper English - ((eq type 'english) - (let ((dtime (decode-time time))) - (concat - "Date: the " - (number-to-string (nth 3 dtime)) - (let ((digit (% (nth 3 dtime) 10))) - (cond - ((memq (nth 3 dtime) '(11 12 13)) "th") - ((= digit 1) "st") - ((= digit 2) "nd") - ((= digit 3) "rd") - (t "th"))) - " of " - (nth (1- (nth 4 dtime)) gnus-english-month-names) - " " - (number-to-string (nth 5 dtime)) - " at " - (format "%02d" (nth 2 dtime)) - ":" - (format "%02d" (nth 1 dtime))))))) - (error - (format "Date: %s (from Gnus)" date)))) - -(defun article-date-local (&optional highlight) - "Convert the current article date to the local timezone." - (interactive (list t)) - (article-date-ut 'local highlight)) - -(defun article-date-english (&optional highlight) - "Convert the current article date to something that is proper English." - (interactive (list t)) - (article-date-ut 'english highlight)) - -(defun article-date-original (&optional highlight) - "Convert the current article date to what it was originally. -This is only useful if you have used some other date conversion -function and want to see what the date was before converting." - (interactive (list t)) - (article-date-ut 'original highlight)) - -(defun article-date-lapsed (&optional highlight) - "Convert the current article date to time lapsed since it was sent." - (interactive (list t)) - (article-date-ut 'lapsed highlight)) - -(defun article-update-date-lapsed () - "Function to be run from a timer to update the lapsed time line." - (save-match-data - (let (deactivate-mark) - (save-excursion - (ignore-errors - (walk-windows - (lambda (w) - (set-buffer (window-buffer w)) - (when (eq major-mode 'gnus-article-mode) - (let ((mark (point-marker))) - (goto-char (point-min)) - (when (re-search-forward "^X-Sent:" nil t) - (article-date-lapsed t)) - (goto-char (marker-position mark)) - (move-marker mark nil)))) - nil 'visible)))))) - -(defun gnus-start-date-timer (&optional n) - "Start a timer to update the X-Sent header in the article buffers. -The numerical prefix says how frequently (in seconds) the function -is to run." - (interactive "p") - (unless n - (setq n 1)) - (gnus-stop-date-timer) - (setq article-lapsed-timer - (nnheader-run-at-time 1 n 'article-update-date-lapsed))) - -(defun gnus-stop-date-timer () - "Stop the X-Sent timer." - (interactive) - (when article-lapsed-timer - (nnheader-cancel-timer article-lapsed-timer) - (setq article-lapsed-timer nil))) - -(defun article-date-user (&optional highlight) - "Convert the current article date to the user-defined format. -This format is defined by the `gnus-article-time-format' variable." - (interactive (list t)) - (article-date-ut 'user highlight)) - -(defun article-date-iso8601 (&optional highlight) - "Convert the current article date to ISO8601." - (interactive (list t)) - (article-date-ut 'iso8601 highlight)) - -(defmacro gnus-article-save-original-date (&rest forms) - "Save the original date as a text property and evaluate FORMS." - `(let* ((case-fold-search t) - (start (progn - (goto-char (point-min)) - (when (and (re-search-forward "^date:[\t\n ]+" nil t) - (not (bolp))) - (match-end 0)))) - (date (when (and start - (re-search-forward "[\t ]*\n\\([^\t ]\\|\\'\\)" - nil t)) - (buffer-substring-no-properties start - (match-beginning 0))))) - (goto-char (point-max)) - (skip-chars-backward "\n") - (put-text-property (point-min) (point) 'original-date date) - ,@forms - (goto-char (point-max)) - (skip-chars-backward "\n") - (put-text-property (point-min) (point) 'original-date date))) - -;; (defun article-show-all () -;; "Show all hidden text in the article buffer." -;; (interactive) -;; (save-excursion -;; (let ((inhibit-read-only t)) -;; (gnus-article-unhide-text (point-min) (point-max))))) - -(defun article-remove-leading-whitespace () - "Remove excessive whitespace from all headers." - (interactive) - (save-excursion - (save-restriction - (let ((inhibit-read-only t)) - (article-narrow-to-head) - (goto-char (point-min)) - (while (re-search-forward "^[^ :]+: \\([ \t]+\\)" nil t) - (delete-region (match-beginning 1) (match-end 1))))))) - -(defun article-emphasize (&optional arg) - "Emphasize text according to `gnus-emphasis-alist'." - (interactive (gnus-article-hidden-arg)) - (unless (gnus-article-check-hidden-text 'emphasis arg) - (save-excursion - (let ((alist (or - (condition-case nil - (with-current-buffer gnus-summary-buffer - gnus-article-emphasis-alist) - (error)) - gnus-emphasis-alist)) - (inhibit-read-only t) - (props (append '(article-type emphasis) - gnus-hidden-properties)) - regexp elem beg invisible visible face) - (article-goto-body) - (setq beg (point)) - (while (setq elem (pop alist)) - (goto-char beg) - (setq regexp (car elem) - invisible (nth 1 elem) - visible (nth 2 elem) - face (nth 3 elem)) - (while (re-search-forward regexp nil t) - (when (and (match-beginning visible) (match-beginning invisible)) - (gnus-article-hide-text - (match-beginning invisible) (match-end invisible) props) - (gnus-article-unhide-text-type - (match-beginning visible) (match-end visible) 'emphasis) - (gnus-put-overlay-excluding-newlines - (match-beginning visible) (match-end visible) 'face face) - (gnus-add-wash-type 'emphasis) - (goto-char (match-end invisible))))))))) - -(defun gnus-article-setup-highlight-words (&optional highlight-words) - "Setup newsgroup emphasis alist." - (unless gnus-article-emphasis-alist - (let ((name (and gnus-newsgroup-name - (gnus-group-real-name gnus-newsgroup-name)))) - (make-local-variable 'gnus-article-emphasis-alist) - (setq gnus-article-emphasis-alist - (nconc - (let ((alist gnus-group-highlight-words-alist) elem highlight) - (while (setq elem (pop alist)) - (when (and name (string-match (car elem) name)) - (setq alist nil - highlight (copy-sequence (cdr elem))))) - highlight) - (copy-sequence highlight-words) - (if gnus-newsgroup-name - (copy-sequence (gnus-group-find-parameter - gnus-newsgroup-name 'highlight-words t))) - gnus-emphasis-alist))))) - -(eval-when-compile - (defvar gnus-summary-article-menu) - (defvar gnus-summary-post-menu)) - -;;; Saving functions. - -(defun gnus-article-save (save-buffer file &optional num) - "Save the currently selected article." - (when (or (get gnus-default-article-saver :headers) - (not gnus-save-all-headers)) - ;; Remove headers according to `gnus-saved-headers' or the value - ;; of the `:headers' property that the saver function might have. - (let ((gnus-visible-headers - (or (symbol-value (get gnus-default-article-saver :headers)) - gnus-saved-headers gnus-visible-headers)) - (gnus-article-buffer save-buffer)) - (save-excursion - (set-buffer save-buffer) - (article-hide-headers 1 t)))) - (save-window-excursion - (if (not gnus-default-article-saver) - (error "No default saver is defined") - ;; !!! Magic! The saving functions all save - ;; `gnus-save-article-buffer' (or so they think), but we - ;; bind that variable to our save-buffer. - (set-buffer gnus-article-buffer) - (let* ((gnus-save-article-buffer save-buffer) - (filename - (cond - ((not gnus-prompt-before-saving) 'default) - ((eq gnus-prompt-before-saving 'always) nil) - (t file))) - (gnus-number-of-articles-to-be-saved - (when (eq gnus-prompt-before-saving t) - num))) ; Magic - (set-buffer gnus-article-current-summary) - (funcall gnus-default-article-saver filename))))) - -(defun gnus-read-save-file-name (prompt &optional filename - function group headers variable - dir-var) - (let ((default-name - (funcall function group headers (symbol-value variable))) - result) - (setq result - (expand-file-name - (cond - ((eq filename 'default) - default-name) - ((eq filename t) - default-name) - (filename filename) - (t - (when (symbol-value dir-var) - (setq default-name (expand-file-name - (file-name-nondirectory default-name) - (symbol-value dir-var)))) - (let* ((split-name (gnus-get-split-value gnus-split-methods)) - (prompt - (format prompt - (if (and gnus-number-of-articles-to-be-saved - (> gnus-number-of-articles-to-be-saved 1)) - (format "these %d articles" - gnus-number-of-articles-to-be-saved) - "this article"))) - (file - ;; Let the split methods have their say. - (cond - ;; No split name was found. - ((null split-name) - (read-file-name - (concat prompt " (default " - (file-name-nondirectory default-name) "): ") - (file-name-directory default-name) - default-name)) - ;; A single group name is returned. - ((stringp split-name) - (setq default-name - (funcall function split-name headers - (symbol-value variable))) - (read-file-name - (concat prompt " (default " - (file-name-nondirectory default-name) "): ") - (file-name-directory default-name) - default-name)) - ;; A single split name was found - ((= 1 (length split-name)) - (let* ((name (expand-file-name - (car split-name) - gnus-article-save-directory)) - (dir (cond ((file-directory-p name) - (file-name-as-directory name)) - ((file-exists-p name) name) - (t gnus-article-save-directory)))) - (read-file-name - (concat prompt " (default " name "): ") - dir name))) - ;; A list of splits was found. - (t - (setq split-name (nreverse split-name)) - (let (result) - (let ((file-name-history - (nconc split-name file-name-history))) - (setq result - (expand-file-name - (read-file-name - (concat prompt " (`M-p' for defaults): ") - gnus-article-save-directory - (car split-name)) - gnus-article-save-directory))) - (car (push result file-name-history))))))) - ;; Create the directory. - (gnus-make-directory (file-name-directory file)) - ;; If we have read a directory, we append the default file name. - (when (file-directory-p file) - (setq file (expand-file-name (file-name-nondirectory - default-name) - (file-name-as-directory file)))) - ;; Possibly translate some characters. - (nnheader-translate-file-chars file)))))) - (gnus-make-directory (file-name-directory result)) - (when variable - (set variable result)) - (when dir-var - (set dir-var (file-name-directory result))) - result)) - -(defun gnus-article-archive-name (group) - "Return the first instance of an \"Archive-name\" in the current buffer." - (let ((case-fold-search t)) - (when (re-search-forward "archive-name: *\\([^ \n\t]+\\)[ \t]*$" nil t) - (nnheader-concat gnus-article-save-directory - (match-string 1))))) - -(defun gnus-article-nndoc-name (group) - "If GROUP is an nndoc group, return the name of the parent group." - (when (eq (car (gnus-find-method-for-group group)) 'nndoc) - (gnus-group-get-parameter group 'save-article-group))) - -(defun gnus-summary-save-in-rmail (&optional filename) - "Append this article to Rmail file. -Optional argument FILENAME specifies file name. -Directory to save to is default to `gnus-article-save-directory'." - (setq filename (gnus-read-save-file-name - "Save %s in rmail file" filename - gnus-rmail-save-name gnus-newsgroup-name - gnus-current-headers 'gnus-newsgroup-last-rmail)) - (gnus-eval-in-buffer-window gnus-save-article-buffer - (save-excursion - (save-restriction - (widen) - (gnus-output-to-rmail filename)))) - filename) - -(defun gnus-summary-save-in-mail (&optional filename) - "Append this article to Unix mail file. -Optional argument FILENAME specifies file name. -Directory to save to is default to `gnus-article-save-directory'." - (setq filename (gnus-read-save-file-name - "Save %s in Unix mail file" filename - gnus-mail-save-name gnus-newsgroup-name - gnus-current-headers 'gnus-newsgroup-last-mail)) - (gnus-eval-in-buffer-window gnus-save-article-buffer - (save-excursion - (save-restriction - (widen) - (if (and (file-readable-p filename) - (file-regular-p filename) - (mail-file-babyl-p filename)) - (rmail-output-to-rmail-file filename t) - (gnus-output-to-mail filename))))) - filename) - -(put 'gnus-summary-save-in-file :decode t) -(put 'gnus-summary-save-in-file :headers 'gnus-saved-headers) -(defun gnus-summary-save-in-file (&optional filename overwrite) - "Append this article to file. -Optional argument FILENAME specifies file name. -Directory to save to is default to `gnus-article-save-directory'." - (setq filename (gnus-read-save-file-name - "Save %s in file" filename - gnus-file-save-name gnus-newsgroup-name - gnus-current-headers 'gnus-newsgroup-last-file)) - (gnus-eval-in-buffer-window gnus-save-article-buffer - (save-excursion - (save-restriction - (widen) - (when (and overwrite - (file-exists-p filename)) - (delete-file filename)) - (gnus-output-to-file filename)))) - filename) - -(put 'gnus-summary-write-to-file :decode t) -(put 'gnus-summary-write-to-file :function 'gnus-summary-save-in-file) -(put 'gnus-summary-write-to-file :headers 'gnus-saved-headers) -(defun gnus-summary-write-to-file (&optional filename) - "Write this article to a file, overwriting it if the file exists. -Optional argument FILENAME specifies file name. -The directory to save in defaults to `gnus-article-save-directory'." - (setq filename (gnus-read-save-file-name - "Save %s in file" filename - gnus-file-save-name gnus-newsgroup-name - gnus-current-headers nil 'gnus-newsgroup-last-directory)) - (gnus-summary-save-in-file filename t)) - -(put 'gnus-summary-save-body-in-file :decode t) -(defun gnus-summary-save-body-in-file (&optional filename overwrite) - "Append this article body to a file. -Optional argument FILENAME specifies file name. -The directory to save in defaults to `gnus-article-save-directory'." - (setq filename (gnus-read-save-file-name - "Save %s body in file" filename - gnus-file-save-name gnus-newsgroup-name - gnus-current-headers 'gnus-newsgroup-last-file)) - (gnus-eval-in-buffer-window gnus-save-article-buffer - (save-excursion - (save-restriction - (widen) - (when (article-goto-body) - (narrow-to-region (point) (point-max))) - (when (and overwrite - (file-exists-p filename)) - (delete-file filename)) - (gnus-output-to-file filename)))) - filename) - -(put 'gnus-summary-write-body-to-file :decode t) -(put 'gnus-summary-write-body-to-file - :function 'gnus-summary-save-body-in-file) -(defun gnus-summary-write-body-to-file (&optional filename) - "Write this article body to a file, overwriting it if the file exists. -Optional argument FILENAME specifies file name. -The directory to save in defaults to `gnus-article-save-directory'." - (setq filename (gnus-read-save-file-name - "Save %s body in file" filename - gnus-file-save-name gnus-newsgroup-name - gnus-current-headers nil 'gnus-newsgroup-last-directory)) - (gnus-summary-save-body-in-file filename t)) - -(defun gnus-summary-save-in-pipe (&optional command) - "Pipe this article to subprocess." - (setq command - (cond ((and (eq command 'default) - gnus-last-shell-command) - gnus-last-shell-command) - ((stringp command) - command) - (t (read-string - (format - "Shell command on %s: " - (if (and gnus-number-of-articles-to-be-saved - (> gnus-number-of-articles-to-be-saved 1)) - (format "these %d articles" - gnus-number-of-articles-to-be-saved) - "this article")) - gnus-last-shell-command)))) - (when (string-equal command "") - (if gnus-last-shell-command - (setq command gnus-last-shell-command) - (error "A command is required"))) - (gnus-eval-in-buffer-window gnus-article-buffer - (save-restriction - (widen) - (shell-command-on-region (point-min) (point-max) command nil))) - (setq gnus-last-shell-command command)) - -(defmacro gnus-read-string (prompt &optional initial-contents history - default-value) - "Like `read-string' but allow for older XEmacsen that don't have the 5th arg." - (if (and (featurep 'xemacs) - (< emacs-minor-version 2)) - `(read-string ,prompt ,initial-contents ,history) - `(read-string ,prompt ,initial-contents ,history ,default-value))) - -(defun gnus-summary-pipe-to-muttprint (&optional command) - "Pipe this article to muttprint." - (setq command (gnus-read-string - "Print using command: " gnus-summary-muttprint-program - nil gnus-summary-muttprint-program)) - (gnus-summary-save-in-pipe command)) - -;;; Article file names when saving. - -(defun gnus-capitalize-newsgroup (newsgroup) - "Capitalize NEWSGROUP name." - (when (not (zerop (length newsgroup))) - (concat (char-to-string (upcase (aref newsgroup 0))) - (substring newsgroup 1)))) - -(defun gnus-Numeric-save-name (newsgroup headers &optional last-file) - "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. -If variable `gnus-use-long-file-name' is non-nil, it is ~/News/News.group/num. -Otherwise, it is like ~/News/news/group/num." - (let ((default - (expand-file-name - (concat (if (gnus-use-long-file-name 'not-save) - (gnus-capitalize-newsgroup newsgroup) - (gnus-newsgroup-directory-form newsgroup)) - "/" (int-to-string (mail-header-number headers))) - gnus-article-save-directory))) - (if (and last-file - (string-equal (file-name-directory default) - (file-name-directory last-file)) - (string-match "^[0-9]+$" (file-name-nondirectory last-file))) - default - (or last-file default)))) - -(defun gnus-numeric-save-name (newsgroup headers &optional last-file) - "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. -If variable `gnus-use-long-file-name' is non-nil, it is -~/News/news.group/num. Otherwise, it is like ~/News/news/group/num." - (let ((default - (expand-file-name - (concat (if (gnus-use-long-file-name 'not-save) - newsgroup - (gnus-newsgroup-directory-form newsgroup)) - "/" (int-to-string (mail-header-number headers))) - gnus-article-save-directory))) - (if (and last-file - (string-equal (file-name-directory default) - (file-name-directory last-file)) - (string-match "^[0-9]+$" (file-name-nondirectory last-file))) - default - (or last-file default)))) - -(defun gnus-plain-save-name (newsgroup headers &optional last-file) - "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. -If variable `gnus-use-long-file-name' is non-nil, it is -~/News/news.group. Otherwise, it is like ~/News/news/group/news." - (or last-file - (expand-file-name - (if (gnus-use-long-file-name 'not-save) - newsgroup - (file-relative-name - (expand-file-name "news" (gnus-newsgroup-directory-form newsgroup)) - default-directory)) - gnus-article-save-directory))) - -(defun gnus-sender-save-name (newsgroup headers &optional last-file) - "Generate file name from sender." - (let ((from (mail-header-from headers))) - (expand-file-name - (if (and from (string-match "\\([^ <]+\\)@" from)) - (match-string 1 from) - "nobody") - gnus-article-save-directory))) - -(defun article-verify-x-pgp-sig () - "Verify X-PGP-Sig." - (interactive) - (if (gnus-buffer-live-p gnus-original-article-buffer) - (let ((sig (with-current-buffer gnus-original-article-buffer - (gnus-fetch-field "X-PGP-Sig"))) - items info headers) - (when (and sig - mml2015-use - (mml2015-clear-verify-function)) - (with-temp-buffer - (insert-buffer-substring gnus-original-article-buffer) - (setq items (split-string sig)) - (message-narrow-to-head) - (let ((inhibit-point-motion-hooks t) - (case-fold-search t)) - ;; Don't verify multiple headers. - (setq headers (mapconcat (lambda (header) - (concat header ": " - (mail-fetch-field header) - "\n")) - (split-string (nth 1 items) ",") ""))) - (delete-region (point-min) (point-max)) - (insert "-----BEGIN PGP SIGNED MESSAGE-----\n\n") - (insert "X-Signed-Headers: " (nth 1 items) "\n") - (insert headers) - (widen) - (forward-line) - (while (not (eobp)) - (if (looking-at "^-") - (insert "- ")) - (forward-line)) - (insert "\n-----BEGIN PGP SIGNATURE-----\n") - (insert "Version: " (car items) "\n\n") - (insert (mapconcat 'identity (cddr items) "\n")) - (insert "\n-----END PGP SIGNATURE-----\n") - (let ((mm-security-handle (list (format "multipart/signed")))) - (mml2015-clean-buffer) - (let ((coding-system-for-write (or gnus-newsgroup-charset - 'iso-8859-1))) - (funcall (mml2015-clear-verify-function))) - (setq info - (or (mm-handle-multipart-ctl-parameter - mm-security-handle 'gnus-details) - (mm-handle-multipart-ctl-parameter - mm-security-handle 'gnus-info))))) - (when info - (let ((inhibit-read-only t) bface eface) - (save-restriction - (message-narrow-to-head) - (goto-char (point-max)) - (forward-line -1) - (setq bface (get-text-property (gnus-point-at-bol) 'face) - eface (get-text-property (1- (gnus-point-at-eol)) 'face)) - (message-remove-header "X-Gnus-PGP-Verify") - (if (re-search-forward "^X-PGP-Sig:" nil t) - (forward-line) - (goto-char (point-max))) - (narrow-to-region (point) (point)) - (insert "X-Gnus-PGP-Verify: " info "\n") - (goto-char (point-min)) - (forward-line) - (while (not (eobp)) - (if (not (looking-at "^[ \t]")) - (insert " ")) - (forward-line)) - ;; Do highlighting. - (goto-char (point-min)) - (when (looking-at "\\([^:]+\\): *") - (put-text-property (match-beginning 1) (1+ (match-end 1)) - 'face bface) - (put-text-property (match-end 0) (point-max) - 'face eface))))))))) - -(defun article-verify-cancel-lock () - "Verify Cancel-Lock header." - (interactive) - (if (gnus-buffer-live-p gnus-original-article-buffer) - (canlock-verify gnus-original-article-buffer))) - -(eval-and-compile - (mapcar - (lambda (func) - (let (afunc gfunc) - (if (consp func) - (setq afunc (car func) - gfunc (cdr func)) - (setq afunc func - gfunc (intern (format "gnus-%s" func)))) - (defalias gfunc - (when (fboundp afunc) - `(lambda (&optional interactive &rest args) - ,(documentation afunc t) - (interactive (list t)) - (save-excursion - (set-buffer gnus-article-buffer) - (if interactive - (call-interactively ',afunc) - (apply ',afunc args)))))))) - '(article-hide-headers - article-verify-x-pgp-sig - article-verify-cancel-lock - article-hide-boring-headers - article-treat-overstrike - article-fill-long-lines - article-capitalize-sentences - article-remove-cr - article-remove-leading-whitespace - article-display-x-face - article-display-face - article-de-quoted-unreadable - article-de-base64-unreadable - article-decode-HZ - article-wash-html - article-unsplit-urls - article-hide-list-identifiers - article-strip-banner - article-babel - article-hide-pem - article-hide-signature - article-strip-headers-in-body - article-remove-trailing-blank-lines - article-strip-leading-blank-lines - article-strip-multiple-blank-lines - article-strip-leading-space - article-strip-trailing-space - article-strip-blank-lines - article-strip-all-blank-lines - article-date-local - article-date-english - article-date-iso8601 - article-date-original - article-date-ut - article-decode-mime-words - article-decode-charset - article-decode-encoded-words - article-date-user - article-date-lapsed - article-emphasize - article-treat-dumbquotes - article-normalize-headers -;; (article-show-all . gnus-article-show-all-headers) - ))) - -;;; -;;; Gnus article mode -;;; - -(put 'gnus-article-mode 'mode-class 'special) - -(set-keymap-parent gnus-article-mode-map widget-keymap) - -(gnus-define-keys gnus-article-mode-map - " " gnus-article-goto-next-page - "\177" gnus-article-goto-prev-page - [delete] gnus-article-goto-prev-page - [backspace] gnus-article-goto-prev-page - "\C-c^" gnus-article-refer-article - "h" gnus-article-show-summary - "s" gnus-article-show-summary - "\C-c\C-m" gnus-article-mail - "?" gnus-article-describe-briefly - "e" gnus-summary-edit-article - "<" beginning-of-buffer - ">" end-of-buffer - "\C-c\C-i" gnus-info-find-node - "\C-c\C-b" gnus-bug - "R" gnus-article-reply-with-original - "F" gnus-article-followup-with-original - "\C-hk" gnus-article-describe-key - "\C-hc" gnus-article-describe-key-briefly - - "\C-d" gnus-article-read-summary-keys - "\M-*" gnus-article-read-summary-keys - "\M-#" gnus-article-read-summary-keys - "\M-^" gnus-article-read-summary-keys - "\M-g" gnus-article-read-summary-keys) - -(substitute-key-definition - 'undefined 'gnus-article-read-summary-keys gnus-article-mode-map) - -(defun gnus-article-make-menu-bar () - (unless (boundp 'gnus-article-commands-menu) - (gnus-summary-make-menu-bar)) - (gnus-turn-off-edit-menu 'article) - (unless (boundp 'gnus-article-article-menu) - (easy-menu-define - gnus-article-article-menu gnus-article-mode-map "" - '("Article" - ["Scroll forwards" gnus-article-goto-next-page t] - ["Scroll backwards" gnus-article-goto-prev-page t] - ["Show summary" gnus-article-show-summary t] - ["Fetch Message-ID at point" gnus-article-refer-article t] - ["Mail to address at point" gnus-article-mail t] - ["Send a bug report" gnus-bug t])) - - (easy-menu-define - gnus-article-treatment-menu gnus-article-mode-map "" - ;; Fixme: this should use :active (and maybe :visible). - '("Treatment" - ["Hide headers" gnus-article-hide-headers t] - ["Hide signature" gnus-article-hide-signature t] - ["Hide citation" gnus-article-hide-citation t] - ["Treat overstrike" gnus-article-treat-overstrike t] - ["Remove carriage return" gnus-article-remove-cr t] - ["Remove leading whitespace" gnus-article-remove-leading-whitespace t] - ["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t] - ["Remove base64" gnus-article-de-base64-unreadable t] - ["Treat html" gnus-article-wash-html t] - ["Remove newlines from within URLs" gnus-article-unsplit-urls t] - ["Decode HZ" gnus-article-decode-HZ t])) - - ;; Note "Commands" menu is defined in gnus-sum.el for consistency - - ;; Note "Post" menu is defined in gnus-sum.el for consistency - - (gnus-run-hooks 'gnus-article-menu-hook))) - -(defun gnus-article-mode () - "Major mode for displaying an article. - -All normal editing commands are switched off. - -The following commands are available in addition to all summary mode -commands: -\\ -\\[gnus-article-next-page]\t Scroll the article one page forwards -\\[gnus-article-prev-page]\t Scroll the article one page backwards -\\[gnus-article-refer-article]\t Go to the article referred to by an article id near point -\\[gnus-article-show-summary]\t Display the summary buffer -\\[gnus-article-mail]\t Send a reply to the address near point -\\[gnus-article-describe-briefly]\t Describe the current mode briefly -\\[gnus-info-find-node]\t Go to the Gnus info node" - (interactive) - (kill-all-local-variables) - (gnus-simplify-mode-line) - (setq mode-name "Article") - (setq major-mode 'gnus-article-mode) - (make-local-variable 'minor-mode-alist) - (use-local-map gnus-article-mode-map) - (when (gnus-visual-p 'article-menu 'menu) - (gnus-article-make-menu-bar) - (when gnus-summary-tool-bar-map - (set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map))) - (gnus-update-format-specifications nil 'article-mode) - (set (make-local-variable 'page-delimiter) gnus-page-delimiter) - (set (make-local-variable 'gnus-page-broken) nil) - (make-local-variable 'gnus-button-marker-list) - (make-local-variable 'gnus-article-current-summary) - (make-local-variable 'gnus-article-mime-handles) - (make-local-variable 'gnus-article-decoded-p) - (make-local-variable 'gnus-article-mime-handle-alist) - (make-local-variable 'gnus-article-wash-types) - (make-local-variable 'gnus-article-image-alist) - (make-local-variable 'gnus-article-charset) - (make-local-variable 'gnus-article-ignored-charsets) - ;; Prevent Emacs 22 from displaying non-break space with `nobreak-space' - ;; face. - (set (make-local-variable 'nobreak-char-display) nil) - (setq cursor-in-non-selected-windows nil) - (gnus-set-default-directory) - (buffer-disable-undo) - (setq buffer-read-only t) - (set-syntax-table gnus-article-mode-syntax-table) - (mm-enable-multibyte) - (gnus-run-mode-hooks 'gnus-article-mode-hook)) - -;; Internal variables. Are `gnus-button-regexp' and `gnus-button-last' used -;; at all? -(defvar gnus-button-regexp nil) -(defvar gnus-button-marker-list nil - "Regexp matching any of the regexps from `gnus-button-alist'.") -(defvar gnus-button-last nil - "The value of `gnus-button-alist' when `gnus-button-regexp' was build.") - -(defun gnus-article-setup-buffer () - "Initialize the article buffer." - (let* ((name (if gnus-single-article-buffer "*Article*" - (concat "*Article " gnus-newsgroup-name "*"))) - (original - (progn (string-match "\\*Article" name) - (concat " *Original Article" - (substring name (match-end 0)))))) - (setq gnus-article-buffer name) - (setq gnus-original-article-buffer original) - (setq gnus-article-mime-handle-alist nil) - ;; This might be a variable local to the summary buffer. - (unless gnus-single-article-buffer - (save-excursion - (set-buffer gnus-summary-buffer) - (setq gnus-article-buffer name) - (setq gnus-original-article-buffer original) - (gnus-set-global-variables))) - (gnus-article-setup-highlight-words) - ;; Init original article buffer. - (save-excursion - (set-buffer (gnus-get-buffer-create gnus-original-article-buffer)) - (mm-enable-multibyte) - (setq major-mode 'gnus-original-article-mode) - (make-local-variable 'gnus-original-article)) - (if (and (get-buffer name) - (with-current-buffer name - (if gnus-article-edit-mode - (if (y-or-n-p "Article mode edit in progress; discard? ") - (progn - (set-buffer-modified-p nil) - (gnus-kill-buffer name) - (message "") - nil) - (error "Action aborted")) - t))) - (save-excursion - (set-buffer name) - (set (make-local-variable 'gnus-article-edit-mode) nil) - (when gnus-article-mime-handles - (mm-destroy-parts gnus-article-mime-handles) - (setq gnus-article-mime-handles nil)) - ;; Set it to nil in article-buffer! - (setq gnus-article-mime-handle-alist nil) - (buffer-disable-undo) - (setq buffer-read-only t) - ;; This list just keeps growing if we don't reset it. - (setq gnus-button-marker-list nil) - (unless (eq major-mode 'gnus-article-mode) - (gnus-article-mode)) - (current-buffer)) - (save-excursion - (set-buffer (gnus-get-buffer-create name)) - (gnus-article-mode) - (make-local-variable 'gnus-summary-buffer) - (gnus-summary-set-local-parameters gnus-newsgroup-name) - (current-buffer))))) - -;; Set article window start at LINE, where LINE is the number of lines -;; from the head of the article. -(defun gnus-article-set-window-start (&optional line) - (set-window-start - (gnus-get-buffer-window gnus-article-buffer t) - (save-excursion - (set-buffer gnus-article-buffer) - (goto-char (point-min)) - (if (not line) - (point-min) - (gnus-message 6 "Moved to bookmark") - (search-forward "\n\n" nil t) - (forward-line line) - (point))))) - -(defun gnus-article-prepare (article &optional all-headers header) - "Prepare ARTICLE in article mode buffer. -ARTICLE should either be an article number or a Message-ID. -If ARTICLE is an id, HEADER should be the article headers. -If ALL-HEADERS is non-nil, no headers are hidden." - (save-excursion - ;; Make sure we start in a summary buffer. - (unless (eq major-mode 'gnus-summary-mode) - (set-buffer gnus-summary-buffer)) - (setq gnus-summary-buffer (current-buffer)) - (let* ((gnus-article (if header (mail-header-number header) article)) - (summary-buffer (current-buffer)) - (gnus-tmp-internal-hook gnus-article-internal-prepare-hook) - (group gnus-newsgroup-name) - result) - (save-excursion - (gnus-article-setup-buffer) - (set-buffer gnus-article-buffer) - ;; Deactivate active regions. - (when (and (boundp 'transient-mark-mode) - transient-mark-mode) - (setq mark-active nil)) - (if (not (setq result (let ((inhibit-read-only t)) - (gnus-request-article-this-buffer - article group)))) - ;; There is no such article. - (save-excursion - (when (and (numberp article) - (not (memq article gnus-newsgroup-sparse))) - (setq gnus-article-current - (cons gnus-newsgroup-name article)) - (set-buffer gnus-summary-buffer) - (setq gnus-current-article article) - (if (and (memq article gnus-newsgroup-undownloaded) - (not (gnus-online (gnus-find-method-for-group - gnus-newsgroup-name)))) - (progn - (gnus-summary-set-agent-mark article) - (message "Message marked for downloading")) - (gnus-summary-mark-article article gnus-canceled-mark) - (unless (memq article gnus-newsgroup-sparse) - (gnus-error 1 "No such article (may have expired or been canceled)"))))) - (if (or (eq result 'pseudo) - (eq result 'nneething)) - (progn - (save-excursion - (set-buffer summary-buffer) - (push article gnus-newsgroup-history) - (setq gnus-last-article gnus-current-article - gnus-current-article 0 - gnus-current-headers nil - gnus-article-current nil) - (if (eq result 'nneething) - (gnus-configure-windows 'summary) - (gnus-configure-windows 'article)) - (gnus-set-global-variables)) - (let ((gnus-article-mime-handle-alist-1 - gnus-article-mime-handle-alist)) - (gnus-set-mode-line 'article))) - ;; The result from the `request' was an actual article - - ;; or at least some text that is now displayed in the - ;; article buffer. - (when (and (numberp article) - (not (eq article gnus-current-article))) - ;; Seems like a new article has been selected. - ;; `gnus-current-article' must be an article number. - (save-excursion - (set-buffer summary-buffer) - (push article gnus-newsgroup-history) - (setq gnus-last-article gnus-current-article - gnus-current-article article - gnus-current-headers - (gnus-summary-article-header gnus-current-article) - gnus-article-current - (cons gnus-newsgroup-name gnus-current-article)) - (unless (vectorp gnus-current-headers) - (setq gnus-current-headers nil)) - (gnus-summary-goto-subject gnus-current-article) - (when (gnus-summary-show-thread) - ;; If the summary buffer really was folded, the - ;; previous goto may not actually have gone to - ;; the right article, but the thread root instead. - ;; So we go again. - (gnus-summary-goto-subject gnus-current-article)) - (gnus-run-hooks 'gnus-mark-article-hook) - (gnus-set-mode-line 'summary) - (when (gnus-visual-p 'article-highlight 'highlight) - (gnus-run-hooks 'gnus-visual-mark-article-hook)) - ;; Set the global newsgroup variables here. - (gnus-set-global-variables) - (setq gnus-have-all-headers - (or all-headers gnus-show-all-headers)))) - (save-excursion - (gnus-configure-windows 'article)) - (when (or (numberp article) - (stringp article)) - (gnus-article-prepare-display) - ;; Do page break. - (goto-char (point-min)) - (when gnus-break-pages - (gnus-narrow-to-page))) - (let ((gnus-article-mime-handle-alist-1 - gnus-article-mime-handle-alist)) - (gnus-set-mode-line 'article)) - (article-goto-body) - (unless (bobp) - (forward-line -1)) - (set-window-point (get-buffer-window (current-buffer)) (point)) - (gnus-configure-windows 'article) - t)))))) - -;;;###autoload -(defun gnus-article-prepare-display () - "Make the current buffer look like a nice article." - ;; Hooks for getting information from the article. - ;; This hook must be called before being narrowed. - (let ((gnus-article-buffer (current-buffer)) - buffer-read-only - (inhibit-read-only t)) - (unless (eq major-mode 'gnus-article-mode) - (gnus-article-mode)) - (setq buffer-read-only nil - gnus-article-wash-types nil - gnus-article-image-alist nil) - (gnus-run-hooks 'gnus-tmp-internal-hook) - (when gnus-display-mime-function - (funcall gnus-display-mime-function)) - (gnus-run-hooks 'gnus-article-prepare-hook))) - -;;; -;;; Gnus MIME viewing functions -;;; - -(defvar gnus-mime-button-line-format "%{%([%p. %d%T]%)%}%e\n" - "Format of the MIME buttons. - -Valid specifiers include: -%t The MIME type -%T MIME type, along with additional info -%n The `name' parameter -%d The description, if any -%l The length of the encoded part -%p The part identifier number -%e Dots if the part isn't displayed - -General format specifiers can also be used. See Info node -`(gnus)Formatting Variables'.") - -(defvar gnus-mime-button-line-format-alist - '((?t gnus-tmp-type ?s) - (?T gnus-tmp-type-long ?s) - (?n gnus-tmp-name ?s) - (?d gnus-tmp-description ?s) - (?p gnus-tmp-id ?s) - (?l gnus-tmp-length ?d) - (?e gnus-tmp-dots ?s))) - -(defvar gnus-mime-button-commands - '((gnus-article-press-button "\r" "Toggle Display") - (gnus-mime-view-part "v" "View Interactively...") - (gnus-mime-view-part-as-type "t" "View As Type...") - (gnus-mime-view-part-as-charset "C" "View As charset...") - (gnus-mime-save-part "o" "Save...") - (gnus-mime-save-part-and-strip "\C-o" "Save and Strip") - (gnus-mime-delete-part "d" "Delete part") - (gnus-mime-copy-part "c" "View As Text, In Other Buffer") - (gnus-mime-inline-part "i" "View As Text, In This Buffer") - (gnus-mime-view-part-internally "E" "View Internally") - (gnus-mime-view-part-externally "e" "View Externally") - (gnus-mime-print-part "p" "Print") - (gnus-mime-pipe-part "|" "Pipe To Command...") - (gnus-mime-action-on-part "." "Take action on the part..."))) - -(defun gnus-article-mime-part-status () - (if gnus-article-mime-handle-alist-1 - (if (eq 1 (length gnus-article-mime-handle-alist-1)) - " (1 part)" - (format " (%d parts)" (length gnus-article-mime-handle-alist-1))) - "")) - -(defvar gnus-mime-button-map - (let ((map (make-sparse-keymap))) - (unless (>= (string-to-number emacs-version) 21) - ;; XEmacs doesn't care. - (set-keymap-parent map gnus-article-mode-map)) - (define-key map gnus-mouse-2 'gnus-article-push-button) - (define-key map gnus-down-mouse-3 'gnus-mime-button-menu) - (dolist (c gnus-mime-button-commands) - (define-key map (cadr c) (car c))) - map)) - -(easy-menu-define - gnus-mime-button-menu gnus-mime-button-map "MIME button menu." - `("MIME Part" - ,@(mapcar (lambda (c) - (vector (caddr c) (car c) :enable t)) - gnus-mime-button-commands))) - -(eval-when-compile - (define-compiler-macro popup-menu (&whole form - menu &optional position prefix) - (if (and (fboundp 'popup-menu) - (not (memq 'popup-menu (assoc "lmenu" load-history)))) - form - ;; Gnus is probably running under Emacs 20. - `(let* ((menu (cdr ,menu)) - (response (x-popup-menu - t (list (car menu) - (cons "" (mapcar (lambda (c) - (cons (caddr c) (car c))) - (cdr menu))))))) - (if response - (call-interactively (nth 3 (assq response menu)))))))) - -(defun gnus-mime-button-menu (event prefix) - "Construct a context-sensitive menu of MIME commands." - (interactive "e\nP") - (save-window-excursion - (let ((pos (event-start event))) - (select-window (posn-window pos)) - (goto-char (posn-point pos)) - (gnus-article-check-buffer) - (popup-menu gnus-mime-button-menu nil prefix)))) - -(defun gnus-mime-view-all-parts (&optional handles) - "View all the MIME parts." - (interactive) - (save-current-buffer - (set-buffer gnus-article-buffer) - (let ((handles (or handles gnus-article-mime-handles)) - (mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets - (with-current-buffer gnus-summary-buffer - gnus-newsgroup-ignored-charsets))) - (when handles - (mm-remove-parts handles) - (goto-char (point-min)) - (or (search-forward "\n\n") (goto-char (point-max))) - (let ((inhibit-read-only t)) - (delete-region (point) (point-max)) - (mm-display-parts handles)))))) - -(defun gnus-mime-save-part-and-strip () - "Save the MIME part under point then replace it with an external body." - (interactive) - (gnus-article-check-buffer) - (when (gnus-group-read-only-p) - (error "The current group does not support deleting of parts")) - (when (mm-complicated-handles gnus-article-mime-handles) - (error "\ -The current article has a complicated MIME structure, giving up...")) - (when (gnus-yes-or-no-p "\ -Deleting parts may malfunction or destroy the article; continue? ") - (let* ((data (get-text-property (point) 'gnus-data)) - file param - (handles gnus-article-mime-handles)) - (setq file (and data (mm-save-part data))) - (when file - (with-current-buffer (mm-handle-buffer data) - (erase-buffer) - (insert "Content-Type: " (mm-handle-media-type data)) - (mml-insert-parameter-string (cdr (mm-handle-type data)) - '(charset)) - ;; Add a filename for the sake of saving the part again. - (mml-insert-parameter - (mail-header-encode-parameter "name" (file-name-nondirectory file))) - (insert "\n") - (insert "Content-ID: " (message-make-message-id) "\n") - (insert "Content-Transfer-Encoding: binary\n") - (insert "\n")) - (setcdr data - (cdr (mm-make-handle nil - `("message/external-body" - (access-type . "LOCAL-FILE") - (name . ,file))))) - (set-buffer gnus-summary-buffer) - (gnus-article-edit-article - `(lambda () - (erase-buffer) - (let ((mail-parse-charset (or gnus-article-charset - ',gnus-newsgroup-charset)) - (mail-parse-ignored-charsets - (or gnus-article-ignored-charsets - ',gnus-newsgroup-ignored-charsets)) - (mbl mml-buffer-list)) - (setq mml-buffer-list nil) - (insert-buffer-substring gnus-original-article-buffer) - (mime-to-mml ',handles) - (setq gnus-article-mime-handles nil) - (let ((mbl1 mml-buffer-list)) - (setq mml-buffer-list mbl) - (set (make-local-variable 'mml-buffer-list) mbl1)) - (gnus-make-local-hook 'kill-buffer-hook) - (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))) - `(lambda (no-highlight) - (let ((mail-parse-charset (or gnus-article-charset - ',gnus-newsgroup-charset)) - (message-options message-options) - (message-options-set-recipient) - (mail-parse-ignored-charsets - (or gnus-article-ignored-charsets - ',gnus-newsgroup-ignored-charsets))) - (mml-to-mime) - (mml-destroy-buffers) - (remove-hook 'kill-buffer-hook - 'mml-destroy-buffers t) - (kill-local-variable 'mml-buffer-list)) - (gnus-summary-edit-article-done - ,(or (mail-header-references gnus-current-headers) "") - ,(gnus-group-read-only-p) - ,gnus-summary-buffer no-highlight))))))) - -(defun gnus-mime-delete-part () - "Delete the MIME part under point. -Replace it with some information about the removed part." - (interactive) - (gnus-article-check-buffer) - (when (gnus-group-read-only-p) - (error "The current group does not support deleting of parts")) - (when (mm-complicated-handles gnus-article-mime-handles) - (error "\ -The current article has a complicated MIME structure, giving up...")) - (when (gnus-yes-or-no-p "\ -Deleting parts may malfunction or destroy the article; continue? ") - (let* ((data (get-text-property (point) 'gnus-data)) - (handles gnus-article-mime-handles) - (none "(none)") - (description - (mail-decode-encoded-word-string (or (mm-handle-description data) - none))) - (filename - (or (mail-content-type-get (mm-handle-disposition data) 'filename) - none)) - (type (mm-handle-media-type data))) - (unless data - (error "No MIME part under point")) - (with-current-buffer (mm-handle-buffer data) - (let ((bsize (format "%s" (buffer-size)))) - (erase-buffer) - (insert - (concat - ",----\n" - "| The following attachment has been deleted:\n" - "|\n" - "| Type: " type "\n" - "| Filename: " filename "\n" - "| Size (encoded): " bsize " Byte\n" - "| Description: " description "\n" - "`----\n")) - (setcdr data - (cdr (mm-make-handle - nil `("text/plain") nil nil - (list "attachment") - (format "Deleted attachment (%s bytes)" bsize)))))) - (set-buffer gnus-summary-buffer) - ;; FIXME: maybe some of the following code (borrowed from - ;; `gnus-mime-save-part-and-strip') isn't necessary? - (gnus-article-edit-article - `(lambda () - (erase-buffer) - (let ((mail-parse-charset (or gnus-article-charset - ',gnus-newsgroup-charset)) - (mail-parse-ignored-charsets - (or gnus-article-ignored-charsets - ',gnus-newsgroup-ignored-charsets)) - (mbl mml-buffer-list)) - (setq mml-buffer-list nil) - (insert-buffer-substring gnus-original-article-buffer) - (mime-to-mml ',handles) - (setq gnus-article-mime-handles nil) - (let ((mbl1 mml-buffer-list)) - (setq mml-buffer-list mbl) - (set (make-local-variable 'mml-buffer-list) mbl1)) - (gnus-make-local-hook 'kill-buffer-hook) - (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))) - `(lambda (no-highlight) - (let ((mail-parse-charset (or gnus-article-charset - ',gnus-newsgroup-charset)) - (message-options message-options) - (message-options-set-recipient) - (mail-parse-ignored-charsets - (or gnus-article-ignored-charsets - ',gnus-newsgroup-ignored-charsets))) - (mml-to-mime) - (mml-destroy-buffers) - (remove-hook 'kill-buffer-hook - 'mml-destroy-buffers t) - (kill-local-variable 'mml-buffer-list)) - (gnus-summary-edit-article-done - ,(or (mail-header-references gnus-current-headers) "") - ,(gnus-group-read-only-p) - ,gnus-summary-buffer no-highlight)))) - ;; Not in `gnus-mime-save-part-and-strip': - (gnus-article-edit-done) - (gnus-summary-expand-window) - (gnus-summary-show-article))) - -(defun gnus-mime-save-part () - "Save the MIME part under point." - (interactive) - (gnus-article-check-buffer) - (let ((data (get-text-property (point) 'gnus-data))) - (when data - (mm-save-part data)))) - -(defun gnus-mime-pipe-part () - "Pipe the MIME part under point to a process." - (interactive) - (gnus-article-check-buffer) - (let ((data (get-text-property (point) 'gnus-data))) - (when data - (mm-pipe-part data)))) - -(defun gnus-mime-view-part () - "Interactively choose a viewing method for the MIME part under point." - (interactive) - (gnus-article-check-buffer) - (let ((data (get-text-property (point) 'gnus-data))) - (when data - (setq gnus-article-mime-handles - (mm-merge-handles - gnus-article-mime-handles (setq data (copy-sequence data)))) - (mm-interactively-view-part data)))) - -(defun gnus-mime-view-part-as-type-internal () - (gnus-article-check-buffer) - (let* ((handle (get-text-property (point) 'gnus-data)) - (name (or - ;; Content-Type: foo/bar; name=... - (mail-content-type-get (mm-handle-type handle) 'name) - ;; Content-Disposition: attachment; filename=... - (cdr (assq 'filename (cdr (mm-handle-disposition handle)))))) - (def-type (and name (mm-default-file-encoding name)))) - (and def-type (cons def-type 0)))) - -(defun gnus-mime-view-part-as-type (&optional mime-type pred) - "Choose a MIME media type, and view the part as such. -If non-nil, PRED is a predicate to use during completion to limit the -available media-types." - (interactive) - (unless mime-type - (setq mime-type - (let ((default (gnus-mime-view-part-as-type-internal))) - (completing-read - (format "View as MIME type (default %s): " - (car default)) - (mapcar #'list (mailcap-mime-types)) - pred nil nil nil - (car default))))) - (gnus-article-check-buffer) - (let ((handle (get-text-property (point) 'gnus-data))) - (when handle - (when (equal (mm-handle-media-type handle) "message/external-body") - (unless (mm-handle-cache handle) - (mm-extern-cache-contents handle)) - (setq handle (mm-handle-cache handle))) - (setq handle - (mm-make-handle (mm-handle-buffer handle) - (cons mime-type (cdr (mm-handle-type handle))) - (mm-handle-encoding handle) - (mm-handle-undisplayer handle) - (mm-handle-disposition handle) - (mm-handle-description handle) - nil - (mm-handle-id handle))) - (setq gnus-article-mime-handles - (mm-merge-handles gnus-article-mime-handles handle)) - (gnus-mm-display-part handle)))) - -(eval-when-compile - (require 'jka-compr)) - -;; jka-compr.el uses a "sh -c" to direct stderr to err-file, but these days -;; emacs can do that itself. -;; -(defun gnus-mime-jka-compr-maybe-uncompress () - "Uncompress the current buffer if `auto-compression-mode' is enabled. -The uncompress method used is derived from `buffer-file-name'." - (when (and (fboundp 'jka-compr-installed-p) - (jka-compr-installed-p)) - (let ((info (jka-compr-get-compression-info buffer-file-name))) - (when info - (let ((basename (file-name-nondirectory buffer-file-name)) - (args (jka-compr-info-uncompress-args info)) - (prog (jka-compr-info-uncompress-program info)) - (message (jka-compr-info-uncompress-message info)) - (err-file (jka-compr-make-temp-name))) - (if message - (message "%s %s..." message basename)) - (unwind-protect - (unless (memq (apply 'call-process-region - (point-min) (point-max) - prog - t (list t err-file) nil - args) - jka-compr-acceptable-retval-list) - (jka-compr-error prog args basename message err-file)) - (jka-compr-delete-temp-file err-file))))))) - -(defun gnus-mime-copy-part (&optional handle) - "Put the MIME part under point into a new buffer. -If `auto-compression-mode' is enabled, compressed files like .gz and .bz2 -are decompressed." - (interactive) - (gnus-article-check-buffer) - (let* ((handle (or handle (get-text-property (point) 'gnus-data))) - (contents (and handle (mm-get-part handle))) - (base (and handle - (file-name-nondirectory - (or - (mail-content-type-get (mm-handle-type handle) 'name) - (mail-content-type-get (mm-handle-disposition handle) - 'filename) - "*decoded*")))) - (buffer (and base (generate-new-buffer base)))) - (when contents - (switch-to-buffer buffer) - (insert contents) - ;; We do it this way to make `normal-mode' set the appropriate mode. - (unwind-protect - (progn - (setq buffer-file-name (expand-file-name base)) - (gnus-mime-jka-compr-maybe-uncompress) - (normal-mode)) - (setq buffer-file-name nil)) - (goto-char (point-min))))) - -(defun gnus-mime-print-part (&optional handle filename) - "Print the MIME part under point." - (interactive (list nil (ps-print-preprint current-prefix-arg))) - (gnus-article-check-buffer) - (let* ((handle (or handle (get-text-property (point) 'gnus-data))) - (contents (and handle (mm-get-part handle))) - (file (mm-make-temp-file (expand-file-name "mm." mm-tmp-directory))) - (printer (mailcap-mime-info (mm-handle-media-type handle) "print"))) - (when contents - (if printer - (unwind-protect - (progn - (mm-save-part-to-file handle file) - (call-process shell-file-name nil - (generate-new-buffer " *mm*") - nil - shell-command-switch - (mm-mailcap-command - printer file (mm-handle-type handle)))) - (delete-file file)) - (with-temp-buffer - (insert contents) - (gnus-print-buffer)) - (ps-despool filename))))) - -(defun gnus-mime-inline-part (&optional handle arg) - "Insert the MIME part under point into the current buffer." - (interactive (list nil current-prefix-arg)) - (gnus-article-check-buffer) - (let* ((handle (or handle (get-text-property (point) 'gnus-data))) - contents charset - (b (point)) - (inhibit-read-only t)) - (when handle - (if (and (not arg) (mm-handle-undisplayer handle)) - (mm-remove-part handle) - (setq contents (mm-get-part handle)) - (cond - ((not arg) - (setq charset (or (mail-content-type-get - (mm-handle-type handle) 'charset) - gnus-newsgroup-charset))) - ((numberp arg) - (if (mm-handle-undisplayer handle) - (mm-remove-part handle)) - (setq charset - (or (cdr (assq arg - gnus-summary-show-article-charset-alist)) - (mm-read-coding-system "Charset: ")))) - (t - (if (mm-handle-undisplayer handle) - (mm-remove-part handle)))) - (forward-line 2) - (mm-insert-inline - handle - (if (and charset - (setq charset (mm-charset-to-coding-system - charset)) - (not (eq charset 'ascii))) - (mm-decode-coding-string contents charset) - (mm-string-to-multibyte contents))) - (goto-char b))))) - -(defun gnus-mime-strip-charset-parameters (handle) - "Strip charset parameters from HANDLE." - (if (stringp (car handle)) - (mapc #'gnus-mime-strip-charset-parameters (cdr handle)) - (let* ((type (mm-handle-type (if (equal (mm-handle-media-type handle) - "message/external-body") - (progn - (unless (mm-handle-cache handle) - (mm-extern-cache-contents handle)) - (mm-handle-cache handle)) - handle))) - (charset (assq 'charset (cdr type)))) - (when charset - (delq charset type))))) - -(defun gnus-mime-view-part-as-charset (&optional handle arg) - "Insert the MIME part under point into the current buffer using the -specified charset." - (interactive (list nil current-prefix-arg)) - (gnus-article-check-buffer) - (let ((handle (or handle (get-text-property (point) 'gnus-data))) - (fun (get-text-property (point) 'gnus-callback)) - (gnus-newsgroup-ignored-charsets 'gnus-all) - gnus-newsgroup-charset form preferred parts) - (when handle - (if (mm-handle-undisplayer handle) - (mm-remove-part handle)) - (when fun - (setq gnus-newsgroup-charset - (or (cdr (assq arg gnus-summary-show-article-charset-alist)) - (mm-read-coding-system "Charset: "))) - (gnus-mime-strip-charset-parameters handle) - (when (and (consp (setq form (cdr-safe fun))) - (setq form (ignore-errors - (assq 'gnus-mime-display-alternative form))) - (setq preferred (caddr form)) - (progn - (when (eq (car preferred) 'quote) - (setq preferred (cadr preferred))) - (not (equal preferred - (get-text-property (point) 'gnus-data)))) - (setq parts (get-text-property (point) 'gnus-part)) - (setq parts (cdr (assq parts - gnus-article-mime-handle-alist))) - (equal (mm-handle-media-type parts) "multipart/alternative") - (setq parts (reverse (cdr parts)))) - (setcar (cddr form) - (list 'quote (or (cadr (member preferred parts)) - (car parts))))) - (funcall fun handle))))) - -(defun gnus-mime-view-part-externally (&optional handle) - "View the MIME part under point with an external viewer." - (interactive) - (gnus-article-check-buffer) - (let* ((handle (or handle (get-text-property (point) 'gnus-data))) - (mm-user-display-methods nil) - (mm-inlined-types nil) - (mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets - (with-current-buffer gnus-summary-buffer - gnus-newsgroup-ignored-charsets)) - (type (mm-handle-media-type handle)) - (method (mailcap-mime-info type)) - (mm-enable-external t)) - (if (not (stringp method)) - (gnus-mime-view-part-as-type - nil (lambda (types) (stringp (mailcap-mime-info (car types))))) - (when handle - (if (mm-handle-undisplayer handle) - (mm-remove-part handle) - (mm-display-part handle)))))) - -(defun gnus-mime-view-part-internally (&optional handle) - "View the MIME part under point with an internal viewer. -If no internal viewer is available, use an external viewer." - (interactive) - (gnus-article-check-buffer) - (let* ((handle (or handle (get-text-property (point) 'gnus-data))) - (mm-inlined-types '(".*")) - (mm-inline-large-images t) - (mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets - (with-current-buffer gnus-summary-buffer - gnus-newsgroup-ignored-charsets)) - (inhibit-read-only t)) - (if (not (mm-inlinable-p handle)) - (gnus-mime-view-part-as-type - nil (lambda (types) (mm-inlinable-p handle (car types)))) - (when handle - (if (mm-handle-undisplayer handle) - (mm-remove-part handle) - (mm-display-part handle)))))) - -(defun gnus-mime-action-on-part (&optional action) - "Do something with the MIME attachment at \(point\)." - (interactive - (list (completing-read "Action: " gnus-mime-action-alist nil t))) - (gnus-article-check-buffer) - (let ((action-pair (assoc action gnus-mime-action-alist))) - (if action-pair - (funcall (cdr action-pair))))) - -(defun gnus-article-part-wrapper (n function) - (let ((window (get-buffer-window gnus-article-buffer 'visible)) - frame) - (when window - ;; It is necessary to select the article window so that - ;; `gnus-article-goto-part' may really move the point. - (setq frame (selected-frame)) - (gnus-select-frame-set-input-focus (window-frame window)) - (unwind-protect - (save-window-excursion - (select-window window) - (when (> n (length gnus-article-mime-handle-alist)) - (error "No such part")) - (gnus-article-goto-part n) - (let ((handle (cdr (assq n gnus-article-mime-handle-alist)))) - (funcall function handle))) - (gnus-select-frame-set-input-focus frame))))) - -(defun gnus-article-pipe-part (n) - "Pipe MIME part N, which is the numerical prefix." - (interactive "p") - (gnus-article-part-wrapper n 'mm-pipe-part)) - -(defun gnus-article-save-part (n) - "Save MIME part N, which is the numerical prefix." - (interactive "p") - (gnus-article-part-wrapper n 'mm-save-part)) - -(defun gnus-article-interactively-view-part (n) - "View MIME part N interactively, which is the numerical prefix." - (interactive "p") - (gnus-article-part-wrapper n 'mm-interactively-view-part)) - -(defun gnus-article-copy-part (n) - "Copy MIME part N, which is the numerical prefix." - (interactive "p") - (gnus-article-part-wrapper n 'gnus-mime-copy-part)) - -(defun gnus-article-view-part-as-charset (n) - "View MIME part N using a specified charset. -N is the numerical prefix." - (interactive "p") - (gnus-article-part-wrapper n 'gnus-mime-view-part-as-charset)) - -(defun gnus-article-view-part-externally (n) - "View MIME part N externally, which is the numerical prefix." - (interactive "p") - (gnus-article-part-wrapper n 'gnus-mime-view-part-externally)) - -(defun gnus-article-inline-part (n) - "Inline MIME part N, which is the numerical prefix." - (interactive "p") - (gnus-article-part-wrapper n 'gnus-mime-inline-part)) - -(defun gnus-article-mime-match-handle-first (condition) - (if condition - (let ((alist gnus-article-mime-handle-alist) ihandle n) - (while (setq ihandle (pop alist)) - (if (and (cond - ((functionp condition) - (funcall condition (cdr ihandle))) - ((eq condition 'undisplayed) - (not (or (mm-handle-undisplayer (cdr ihandle)) - (equal (mm-handle-media-type (cdr ihandle)) - "multipart/alternative")))) - ((eq condition 'undisplayed-alternative) - (not (mm-handle-undisplayer (cdr ihandle)))) - (t t)) - (gnus-article-goto-part (car ihandle)) - (or (not n) (< (car ihandle) n))) - (setq n (car ihandle)))) - (or n 1)) - 1)) - -(defun gnus-article-view-part (&optional n) - "View MIME part N, which is the numerical prefix." - (interactive "P") - (save-current-buffer - (set-buffer gnus-article-buffer) - (or (numberp n) (setq n (gnus-article-mime-match-handle-first - gnus-article-mime-match-handle-function))) - (when (> n (length gnus-article-mime-handle-alist)) - (error "No such part")) - (let ((handle (cdr (assq n gnus-article-mime-handle-alist)))) - (when (gnus-article-goto-part n) - (if (equal (car handle) "multipart/alternative") - (gnus-article-press-button) - (when (eq (gnus-mm-display-part handle) 'internal) - (gnus-set-window-start))))))) - -(defsubst gnus-article-mime-total-parts () - (if (bufferp (car gnus-article-mime-handles)) - 1 ;; single part - (1- (length gnus-article-mime-handles)))) - -(defun gnus-mm-display-part (handle) - "Display HANDLE and fix MIME button." - (let ((id (get-text-property (point) 'gnus-part)) - (point (point)) - (inhibit-read-only t)) - (forward-line 1) - (prog1 - (let ((window (selected-window)) - (mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets - (if (gnus-buffer-live-p gnus-summary-buffer) - (save-excursion - (set-buffer gnus-summary-buffer) - gnus-newsgroup-ignored-charsets) - nil))) - (save-excursion - (unwind-protect - (let ((win (gnus-get-buffer-window (current-buffer) t)) - (beg (point))) - (when win - (select-window win)) - (goto-char point) - (forward-line) - (if (mm-handle-displayed-p handle) - ;; This will remove the part. - (mm-display-part handle) - (save-restriction - (narrow-to-region (point) - (if (eobp) (point) (1+ (point)))) - (mm-display-part handle) - ;; We narrow to the part itself and - ;; then call the treatment functions. - (goto-char (point-min)) - (forward-line 1) - (narrow-to-region (point) (point-max)) - (gnus-treat-article - nil id - (gnus-article-mime-total-parts) - (mm-handle-media-type handle))))) - (if (window-live-p window) - (select-window window))))) - (goto-char point) - (gnus-delete-line) - (gnus-insert-mime-button - handle id (list (mm-handle-displayed-p handle))) - (goto-char point)))) - -(defun gnus-article-goto-part (n) - "Go to MIME part N." - (gnus-goto-char (text-property-any (point-min) (point-max) 'gnus-part n))) - -(defun gnus-insert-mime-button (handle gnus-tmp-id &optional displayed) - (let ((gnus-tmp-name - (or (mail-content-type-get (mm-handle-type handle) 'name) - (mail-content-type-get (mm-handle-disposition handle) 'filename) - (mail-content-type-get (mm-handle-type handle) 'url) - "")) - (gnus-tmp-type (mm-handle-media-type handle)) - (gnus-tmp-description - (mail-decode-encoded-word-string (or (mm-handle-description handle) - ""))) - (gnus-tmp-dots - (if (if displayed (car displayed) - (mm-handle-displayed-p handle)) - "" "...")) - (gnus-tmp-length (with-current-buffer (mm-handle-buffer handle) - (buffer-size))) - gnus-tmp-type-long b e) - (when (string-match ".*/" gnus-tmp-name) - (setq gnus-tmp-name (replace-match "" t t gnus-tmp-name))) - (setq gnus-tmp-type-long (concat gnus-tmp-type - (and (not (equal gnus-tmp-name "")) - (concat "; " gnus-tmp-name)))) - (unless (equal gnus-tmp-description "") - (setq gnus-tmp-type-long (concat " --- " gnus-tmp-type-long))) - (unless (bolp) - (insert "\n")) - (setq b (point)) - (gnus-eval-format - gnus-mime-button-line-format gnus-mime-button-line-format-alist - `(,@(gnus-local-map-property gnus-mime-button-map) - gnus-callback gnus-mm-display-part - gnus-part ,gnus-tmp-id - article-type annotation - gnus-data ,handle)) - (setq e (if (bolp) - ;; Exclude a newline. - (1- (point)) - (point))) - (widget-convert-button - 'link b e - :mime-handle handle - :action 'gnus-widget-press-button - :button-keymap gnus-mime-button-map - :help-echo - (lambda (widget/window &optional overlay pos) - ;; Needed to properly clear the message due to a bug in - ;; wid-edit (XEmacs only). - (if (boundp 'help-echo-owns-message) - (setq help-echo-owns-message t)) - (format - "%S: %s the MIME part; %S: more options" - (aref gnus-mouse-2 0) - ;; XEmacs will get a single widget arg; Emacs 21 will get - ;; window, overlay, position. - (if (mm-handle-displayed-p - (if overlay - (with-current-buffer (gnus-overlay-buffer overlay) - (widget-get (widget-at (gnus-overlay-start overlay)) - :mime-handle)) - (widget-get widget/window :mime-handle))) - "hide" "show") - (aref gnus-down-mouse-3 0)))))) - -(defun gnus-widget-press-button (elems el) - (goto-char (widget-get elems :from)) - (gnus-article-press-button)) - -(defvar gnus-displaying-mime nil) - -(defun gnus-display-mime (&optional ihandles) - "Display the MIME parts." - (save-excursion - (save-selected-window - (let ((window (get-buffer-window gnus-article-buffer)) - (point (point))) - (when window - (select-window window) - ;; We have to do this since selecting the window - ;; may change the point. So we set the window point. - (set-window-point window point))) - (let ((handles ihandles) - (inhibit-read-only t) - handle) - (cond (handles) - ((setq handles (mm-dissect-buffer nil gnus-article-loose-mime)) - (when gnus-article-emulate-mime - (mm-uu-dissect-text-parts handles))) - (gnus-article-emulate-mime - (setq handles (mm-uu-dissect)))) - (when (and (not ihandles) - (not gnus-displaying-mime)) - ;; Top-level call; we clean up. - (when gnus-article-mime-handles - (mm-destroy-parts gnus-article-mime-handles) - (setq gnus-article-mime-handle-alist nil));; A trick. - (setq gnus-article-mime-handles handles) - ;; We allow users to glean info from the handles. - (when gnus-article-mime-part-function - (gnus-mime-part-function handles))) - (if (and handles - (or (not (stringp (car handles))) - (cdr handles))) - (progn - (when (and (not ihandles) - (not gnus-displaying-mime)) - ;; Clean up for mime parts. - (article-goto-body) - (delete-region (point) (point-max))) - (let ((gnus-displaying-mime t)) - (gnus-mime-display-part handles))) - (save-restriction - (article-goto-body) - (narrow-to-region (point) (point-max)) - (gnus-treat-article nil 1 1) - (widen))) - (unless ihandles - ;; Highlight the headers. - (save-excursion - (save-restriction - (article-goto-body) - (narrow-to-region (point-min) (point)) - (gnus-article-save-original-date - (gnus-treat-article 'head))))))) - ;; Cope with broken MIME messages. - (goto-char (point-max)) - (unless (bolp) - (insert "\n")))) - -(defcustom gnus-mime-display-multipart-as-mixed nil - "Display \"multipart\" parts as \"multipart/mixed\". - -If t, it overrides nil values of -`gnus-mime-display-multipart-alternative-as-mixed' and -`gnus-mime-display-multipart-related-as-mixed'." - :group 'gnus-article-mime - :type 'boolean) - -(defcustom gnus-mime-display-multipart-alternative-as-mixed nil - "Display \"multipart/alternative\" parts as \"multipart/mixed\"." - :version "22.1" - :group 'gnus-article-mime - :type 'boolean) - -(defcustom gnus-mime-display-multipart-related-as-mixed nil - "Display \"multipart/related\" parts as \"multipart/mixed\". - -If displaying \"text/html\" is discouraged \(see -`mm-discouraged-alternatives'\) images or other material inside a -\"multipart/related\" part might be overlooked when this variable is nil." - :version "22.1" - :group 'gnus-article-mime - :type 'boolean) - -(defun gnus-mime-display-part (handle) - (cond - ;; Maybe a broken MIME message. - ((null handle)) - ;; Single part. - ((not (stringp (car handle))) - (gnus-mime-display-single handle)) - ;; User-defined multipart - ((cdr (assoc (car handle) gnus-mime-multipart-functions)) - (funcall (cdr (assoc (car handle) gnus-mime-multipart-functions)) - handle)) - ;; multipart/alternative - ((and (equal (car handle) "multipart/alternative") - (not (or gnus-mime-display-multipart-as-mixed - gnus-mime-display-multipart-alternative-as-mixed))) - (let ((id (1+ (length gnus-article-mime-handle-alist)))) - (push (cons id handle) gnus-article-mime-handle-alist) - (gnus-mime-display-alternative (cdr handle) nil nil id))) - ;; multipart/related - ((and (equal (car handle) "multipart/related") - (not (or gnus-mime-display-multipart-as-mixed - gnus-mime-display-multipart-related-as-mixed))) - ;;;!!!We should find the start part, but we just default - ;;;!!!to the first part. - ;;(gnus-mime-display-part (cadr handle)) - ;;;!!! Most multipart/related is an HTML message plus images. - ;;;!!! Unfortunately we are unable to let W3 display those - ;;;!!! included images, so we just display it as a mixed multipart. - ;;(gnus-mime-display-mixed (cdr handle)) - ;;;!!! No, w3 can display everything just fine. - (gnus-mime-display-part (cadr handle))) - ((equal (car handle) "multipart/signed") - (gnus-add-wash-type 'signed) - (gnus-mime-display-security handle)) - ((equal (car handle) "multipart/encrypted") - (gnus-add-wash-type 'encrypted) - (gnus-mime-display-security handle)) - ;; Other multiparts are handled like multipart/mixed. - (t - (gnus-mime-display-mixed (cdr handle))))) - -(defun gnus-mime-part-function (handles) - (if (stringp (car handles)) - (mapcar 'gnus-mime-part-function (cdr handles)) - (funcall gnus-article-mime-part-function handles))) - -(defun gnus-mime-display-mixed (handles) - (mapcar 'gnus-mime-display-part handles)) - -(defun gnus-mime-display-single (handle) - (let ((type (mm-handle-media-type handle)) - (ignored gnus-ignored-mime-types) - (not-attachment t) - (move nil) - display text) - (catch 'ignored - (progn - (while ignored - (when (string-match (pop ignored) type) - (throw 'ignored nil))) - (if (and (setq not-attachment - (and (not (mm-inline-override-p handle)) - (or (not (mm-handle-disposition handle)) - (equal (car (mm-handle-disposition handle)) - "inline") - (mm-attachment-override-p handle)))) - (mm-automatic-display-p handle) - (or (and - (mm-inlinable-p handle) - (mm-inlined-p handle)) - (mm-automatic-external-display-p type))) - (setq display t) - (when (equal (mm-handle-media-supertype handle) "text") - (setq text t))) - (let ((id (1+ (length gnus-article-mime-handle-alist))) - beg) - (push (cons id handle) gnus-article-mime-handle-alist) - (when (and display - (equal (mm-handle-media-supertype handle) "message")) - (insert-char - ?\n - (cond ((not (bolp)) 2) - ((or (bobp) (eq (char-before (1- (point))) ?\n)) 0) - (t 1)))) - (when (or (not display) - (not (gnus-unbuttonized-mime-type-p type))) - (gnus-insert-mime-button - handle id (list (or display (and not-attachment text)))) - (gnus-article-insert-newline) - ;; Remember modify the number of forward lines. - (setq move t)) - (setq beg (point)) - (cond - (display - (when move - (forward-line -1) - (setq beg (point))) - (let ((mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets - (save-excursion (condition-case () - (set-buffer gnus-summary-buffer) - (error)) - gnus-newsgroup-ignored-charsets))) - (mm-display-part handle t)) - (goto-char (point-max))) - ((and text not-attachment) - (when move - (forward-line -1) - (setq beg (point))) - (gnus-article-insert-newline) - (mm-insert-inline - handle - (let ((charset (mail-content-type-get (mm-handle-type handle) - 'charset))) - (cond ((not charset) - (mm-string-as-multibyte (mm-get-part handle))) - ((eq charset 'gnus-decoded) - (with-current-buffer (mm-handle-buffer handle) - (buffer-string))) - (t - (mm-decode-string (mm-get-part handle) charset))))) - (goto-char (point-max)))) - ;; Do highlighting. - (save-excursion - (save-restriction - (narrow-to-region beg (point)) - (gnus-treat-article - nil id - (gnus-article-mime-total-parts) - (mm-handle-media-type handle))))))))) - -(defun gnus-unbuttonized-mime-type-p (type) - "Say whether TYPE is to be unbuttonized." - (unless gnus-inhibit-mime-unbuttonizing - (when (catch 'found - (let ((types gnus-unbuttonized-mime-types)) - (while types - (when (string-match (pop types) type) - (throw 'found t))))) - (not (catch 'found - (let ((types gnus-buttonized-mime-types)) - (while types - (when (string-match (pop types) type) - (throw 'found t))))))))) - -(defun gnus-article-insert-newline () - "Insert a newline, but mark it as undeletable." - (gnus-put-text-property - (point) (progn (insert "\n") (point)) 'gnus-undeletable t)) - -(defun gnus-mime-display-alternative (handles &optional preferred ibegend id) - (let* ((preferred (or preferred (mm-preferred-alternative handles))) - (ihandles handles) - (point (point)) - handle (inhibit-read-only t) from props begend not-pref) - (save-window-excursion - (save-restriction - (when ibegend - (narrow-to-region (car ibegend) - (or (cdr ibegend) - (progn - (goto-char (car ibegend)) - (forward-line 2) - (point)))) - (delete-region (point-min) (point-max)) - (mm-remove-parts handles)) - (setq begend (list (point-marker))) - ;; Do the toggle. - (unless (setq not-pref (cadr (member preferred ihandles))) - (setq not-pref (car ihandles))) - (when (or ibegend - (not preferred) - (not (gnus-unbuttonized-mime-type-p - "multipart/alternative"))) - (gnus-add-text-properties - (setq from (point)) - (progn - (insert (format "%d. " id)) - (point)) - `(gnus-callback - (lambda (handles) - (unless ,(not ibegend) - (setq gnus-article-mime-handle-alist - ',gnus-article-mime-handle-alist)) - (gnus-mime-display-alternative - ',ihandles ',not-pref ',begend ,id)) - ,@(gnus-local-map-property gnus-mime-button-map) - ,gnus-mouse-face-prop ,gnus-article-mouse-face - face ,gnus-article-button-face - gnus-part ,id - article-type multipart)) - (widget-convert-button 'link from (point) - :action 'gnus-widget-press-button - :button-keymap gnus-widget-button-keymap) - ;; Do the handles - (while (setq handle (pop handles)) - (gnus-add-text-properties - (setq from (point)) - (progn - (insert (format "(%c) %-18s" - (if (equal handle preferred) ?* ? ) - (mm-handle-media-type handle))) - (point)) - `(gnus-callback - (lambda (handles) - (unless ,(not ibegend) - (setq gnus-article-mime-handle-alist - ',gnus-article-mime-handle-alist)) - (gnus-mime-display-alternative - ',ihandles ',handle ',begend ,id)) - ,@(gnus-local-map-property gnus-mime-button-map) - ,gnus-mouse-face-prop ,gnus-article-mouse-face - face ,gnus-article-button-face - gnus-part ,id - gnus-data ,handle)) - (widget-convert-button 'link from (point) - :action 'gnus-widget-press-button - :button-keymap gnus-widget-button-keymap) - (insert " ")) - (insert "\n\n")) - (when preferred - (if (stringp (car preferred)) - (gnus-display-mime preferred) - (let ((mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets - (save-excursion (set-buffer gnus-summary-buffer) - gnus-newsgroup-ignored-charsets))) - (mm-display-part preferred) - ;; Do highlighting. - (save-excursion - (save-restriction - (narrow-to-region (car begend) (point-max)) - (gnus-treat-article - nil (length gnus-article-mime-handle-alist) - (gnus-article-mime-total-parts) - (mm-handle-media-type handle)))))) - (goto-char (point-max)) - (setcdr begend (point-marker))))) - (when ibegend - (goto-char point)))) - -(defconst gnus-article-wash-status-strings - (let ((alist '((cite "c" "Possible hidden citation text" - " " "All citation text visible") - (headers "h" "Hidden headers" - " " "All headers visible.") - (pgp "p" "Encrypted or signed message status hidden" - " " "No hidden encryption nor digital signature status") - (signature "s" "Signature has been hidden" - " " "Signature is visible") - (overstrike "o" "Overstrike (^H) characters applied" - " " "No overstrike characters applied") - (emphasis "e" "/*_Emphasis_*/ characters applied" - " " "No /*_emphasis_*/ characters applied"))) - result) - (dolist (entry alist result) - (let ((key (nth 0 entry)) - (on (copy-sequence (nth 1 entry))) - (on-help (nth 2 entry)) - (off (copy-sequence (nth 3 entry))) - (off-help (nth 4 entry))) - (put-text-property 0 1 'help-echo on-help on) - (put-text-property 0 1 'help-echo off-help off) - (push (list key on off) result)))) - "Alist of strings describing wash status in the mode line. -Each entry has the form (KEY ON OF), where the KEY is a symbol -representing the particular washing function, ON is the string to use -in the article mode line when the washing function is active, and OFF -is the string to use when it is inactive.") - -(defun gnus-article-wash-status-entry (key value) - (let ((entry (assoc key gnus-article-wash-status-strings))) - (if value (nth 1 entry) (nth 2 entry)))) - -(defun gnus-article-wash-status () - "Return a string which display status of article washing." - (save-excursion - (set-buffer gnus-article-buffer) - (let ((cite (memq 'cite gnus-article-wash-types)) - (headers (memq 'headers gnus-article-wash-types)) - (boring (memq 'boring-headers gnus-article-wash-types)) - (pgp (memq 'pgp gnus-article-wash-types)) - (pem (memq 'pem gnus-article-wash-types)) - (signed (memq 'signed gnus-article-wash-types)) - (encrypted (memq 'encrypted gnus-article-wash-types)) - (signature (memq 'signature gnus-article-wash-types)) - (overstrike (memq 'overstrike gnus-article-wash-types)) - (emphasis (memq 'emphasis gnus-article-wash-types))) - (concat - (gnus-article-wash-status-entry 'cite cite) - (gnus-article-wash-status-entry 'headers (or headers boring)) - (gnus-article-wash-status-entry 'pgp (or pgp pem signed encrypted)) - (gnus-article-wash-status-entry 'signature signature) - (gnus-article-wash-status-entry 'overstrike overstrike) - (gnus-article-wash-status-entry 'emphasis emphasis))))) - -(defun gnus-add-wash-type (type) - "Add a washing of TYPE to the current status." - (add-to-list 'gnus-article-wash-types type)) - -(defun gnus-delete-wash-type (type) - "Add a washing of TYPE to the current status." - (setq gnus-article-wash-types (delq type gnus-article-wash-types))) - -(defun gnus-add-image (category image) - "Add IMAGE of CATEGORY to the list of displayed images." - (let ((entry (assq category gnus-article-image-alist))) - (unless entry - (setq entry (list category)) - (push entry gnus-article-image-alist)) - (nconc entry (list image)))) - -(defun gnus-delete-images (category) - "Delete all images in CATEGORY." - (let ((entry (assq category gnus-article-image-alist))) - (dolist (image (cdr entry)) - (gnus-remove-image image category)) - (setq gnus-article-image-alist (delq entry gnus-article-image-alist)) - (gnus-delete-wash-type category))) - -(defalias 'gnus-article-hide-headers-if-wanted 'gnus-article-maybe-hide-headers) - -(defun gnus-article-maybe-hide-headers () - "Hide unwanted headers if `gnus-have-all-headers' is nil. -Provided for backwards compatibility." - (when (and (or (not (gnus-buffer-live-p gnus-summary-buffer)) - (not (save-excursion (set-buffer gnus-summary-buffer) - gnus-have-all-headers))) - (not gnus-inhibit-hiding)) - (gnus-article-hide-headers))) - -;;; Article savers. - -(defun gnus-output-to-file (file-name) - "Append the current article to a file named FILE-NAME. -If `gnus-article-save-coding-system' is non-nil, it is used to encode -text and used as the value of the coding cookie which is added to the -top of a file. Otherwise, this function saves a raw article without -the coding cookie." - (let* ((artbuf (current-buffer)) - (file-name-coding-system nnmail-pathname-coding-system) - (coding gnus-article-save-coding-system) - (coding-system-for-read (if coding - nil ;; Rely on the coding cookie. - mm-text-coding-system)) - (coding-system-for-write (or coding - mm-text-coding-system-for-write - mm-text-coding-system)) - (exists (file-exists-p file-name))) - (with-temp-buffer - (when exists - (insert-file-contents file-name) - (goto-char (point-min)) - ;; Remove the existing coding cookie. - (when (looking-at "X-Gnus-Coding-System: .+\n\n") - (delete-region (match-beginning 0) (match-end 0)))) - (goto-char (point-max)) - (insert-buffer-substring artbuf) - ;; Append newline at end of the buffer as separator, and then - ;; save it to file. - (goto-char (point-max)) - (insert "\n") - (when coding - ;; If the coding system is not suitable to encode the text, - ;; ask a user for a proper one. - (when (fboundp 'select-safe-coding-system) - (setq coding (coding-system-base - (save-window-excursion - (select-safe-coding-system (point-min) (point-max) - coding)))) - (setq coding-system-for-write - (or (cdr (assq coding '((mule-utf-8 . utf-8)))) - coding))) - (goto-char (point-min)) - ;; Add the coding cookie. - (insert (format "X-Gnus-Coding-System: -*- coding: %s; -*-\n\n" - coding-system-for-write))) - (if exists - (progn - (write-region (point-min) (point-max) file-name nil 'no-message) - (message "Appended to %s" file-name)) - (write-region (point-min) (point-max) file-name)))) - t) - -(defun gnus-narrow-to-page (&optional arg) - "Narrow the article buffer to a page. -If given a numerical ARG, move forward ARG pages." - (interactive "P") - (setq arg (if arg (prefix-numeric-value arg) 0)) - (with-current-buffer gnus-article-buffer - (widen) - ;; Remove any old next/prev buttons. - (when (gnus-visual-p 'page-marker) - (let ((inhibit-read-only t)) - (gnus-remove-text-with-property 'gnus-prev) - (gnus-remove-text-with-property 'gnus-next))) - (let (st nd pt) - (when (save-excursion - (cond ((< arg 0) - (if (re-search-backward page-delimiter nil 'move (abs arg)) - (prog1 - (setq nd (match-beginning 0) - pt nd) - (when (re-search-backward page-delimiter nil t) - (setq st (match-end 0)))) - (when (re-search-forward page-delimiter nil t) - (setq nd (match-beginning 0) - pt (point-min))))) - ((> arg 0) - (if (re-search-forward page-delimiter nil 'move arg) - (prog1 - (setq st (match-end 0) - pt st) - (when (re-search-forward page-delimiter nil t) - (setq nd (match-beginning 0)))) - (when (re-search-backward page-delimiter nil t) - (setq st (match-end 0) - pt (point-max))))) - (t - (when (re-search-backward page-delimiter nil t) - (goto-char (setq st (match-end 0)))) - (when (re-search-forward page-delimiter nil t) - (setq nd (match-beginning 0))) - (or st nd)))) - (setq gnus-page-broken t) - (when pt (goto-char pt)) - (narrow-to-region (or st (point-min)) (or nd (point-max))) - (when (gnus-visual-p 'page-marker) - (save-excursion - (when nd - (goto-char nd) - (gnus-insert-next-page-button)) - (when st - (goto-char st) - (gnus-insert-prev-page-button)))))))) - -;; Article mode commands - -(defun gnus-article-goto-next-page () - "Show the next page of the article." - (interactive) - (when (gnus-article-next-page) - (goto-char (point-min)) - (gnus-article-read-summary-keys nil (gnus-character-to-event ?n)))) - - -(defun gnus-article-goto-prev-page () - "Show the previous page of the article." - (interactive) - (if (save-restriction (widen) (bobp)) ;; Real beginning-of-buffer? - (gnus-article-read-summary-keys nil (gnus-character-to-event ?p)) - (gnus-article-prev-page nil))) - -;; This is cleaner but currently breaks `gnus-pick-mode': -;; -;; (defun gnus-article-goto-next-page () -;; "Show the next page of the article." -;; (interactive) -;; (gnus-eval-in-buffer-window gnus-summary-buffer -;; (gnus-summary-next-page))) -;; -;; (defun gnus-article-goto-prev-page () -;; "Show the next page of the article." -;; (interactive) -;; (gnus-eval-in-buffer-window gnus-summary-buffer -;; (gnus-summary-prev-page))) - -(defun gnus-article-next-page (&optional lines) - "Show the next page of the current article. -If end of article, return non-nil. Otherwise return nil. -Argument LINES specifies lines to be scrolled up." - (interactive "p") - (move-to-window-line -1) - (if (save-excursion - (end-of-line) - (and (pos-visible-in-window-p) ;Not continuation line. - (>= (1+ (point)) (point-max)))) ;Allow for trailing newline. - ;; Nothing in this page. - (if (or (not gnus-page-broken) - (save-excursion - (save-restriction - (widen) - (forward-line) - (eobp)))) ;Real end-of-buffer? - (progn - (when gnus-article-over-scroll - (gnus-article-next-page-1 lines)) - t) ;Nothing more. - (gnus-narrow-to-page 1) ;Go to next page. - nil) - ;; More in this page. - (gnus-article-next-page-1 lines) - nil)) - -(defmacro gnus-article-beginning-of-window () - "Move point to the beginning of the window. -In Emacs, the point is placed at the line number which `scroll-margin' -specifies." - (if (featurep 'xemacs) - '(move-to-window-line 0) - '(move-to-window-line - (min (max 0 scroll-margin) - (max 1 (- (window-height) - (if mode-line-format 1 0) - (if (and (boundp 'header-line-format) - (symbol-value 'header-line-format)) - 1 0))))))) - -(defun gnus-article-next-page-1 (lines) - (when (and (not (featurep 'xemacs)) - (numberp lines) - (> lines 0) - (numberp (symbol-value 'scroll-margin)) - (> (symbol-value 'scroll-margin) 0)) - ;; Protect against the bug that Emacs 21.x hangs up when scrolling up for - ;; too many number of lines if `scroll-margin' is set as two or greater. - (setq lines (min lines - (max 0 (- (count-lines (window-start) (point-max)) - (symbol-value 'scroll-margin)))))) - (condition-case () - (let ((scroll-in-place nil)) - (scroll-up lines)) - (end-of-buffer - ;; Long lines may cause an end-of-buffer error. - (goto-char (point-max)))) - (gnus-article-beginning-of-window)) - -(defun gnus-article-prev-page (&optional lines) - "Show previous page of current article. -Argument LINES specifies lines to be scrolled down." - (interactive "p") - (move-to-window-line 0) - (if (and gnus-page-broken - (bobp) - (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer? - (progn - (gnus-narrow-to-page -1) ;Go to previous page. - (goto-char (point-max)) - (recenter -1)) - (prog1 - (condition-case () - (let ((scroll-in-place nil)) - (scroll-down lines)) - (beginning-of-buffer - (goto-char (point-min)))) - (gnus-article-beginning-of-window)))) - -(defun gnus-article-only-boring-p () - "Decide whether there is only boring text remaining in the article. -Something \"interesting\" is a word of at least two letters that does -not have a face in `gnus-article-boring-faces'." - (when (and gnus-article-skip-boring - (boundp 'gnus-article-boring-faces) - (symbol-value 'gnus-article-boring-faces)) - (save-excursion - (let ((inhibit-point-motion-hooks t)) - (catch 'only-boring - (while (re-search-forward "\\b\\w\\w" nil t) - (forward-char -1) - (when (not (gnus-intersection - (gnus-faces-at (point)) - (symbol-value 'gnus-article-boring-faces))) - (throw 'only-boring nil))) - (throw 'only-boring t)))))) - -(defun gnus-article-refer-article () - "Read article specified by message-id around point." - (interactive) - (save-excursion - (re-search-backward "[ \t]\\|^" (gnus-point-at-bol) t) - (re-search-forward "]+" (gnus-point-at-eol) t) - (let ((msg-id (concat "<" (match-string 0) ">"))) - (set-buffer gnus-summary-buffer) - (gnus-summary-refer-article msg-id)) - (error "No references around point")))) - -(defun gnus-article-show-summary () - "Reconfigure windows to show summary buffer." - (interactive) - (if (not (gnus-buffer-live-p gnus-summary-buffer)) - (error "There is no summary buffer for this article buffer") - (gnus-article-set-globals) - (gnus-configure-windows 'article) - (gnus-summary-goto-subject gnus-current-article) - (gnus-summary-position-point))) - -(defun gnus-article-describe-briefly () - "Describe article mode commands briefly." - (interactive) - (gnus-message 6 (substitute-command-keys "\\\\[gnus-article-goto-next-page]:Next page \\[gnus-article-goto-prev-page]:Prev page \\[gnus-article-show-summary]:Show summary \\[gnus-info-find-node]:Run Info \\[gnus-article-describe-briefly]:This help"))) - -(defun gnus-article-summary-command () - "Execute the last keystroke in the summary buffer." - (interactive) - (let ((obuf (current-buffer)) - (owin (current-window-configuration)) - func) - (switch-to-buffer gnus-article-current-summary 'norecord) - (setq func (lookup-key (current-local-map) (this-command-keys))) - (call-interactively func) - (set-buffer obuf) - (set-window-configuration owin) - (set-window-point (get-buffer-window (current-buffer)) (point)))) - -(defun gnus-article-summary-command-nosave () - "Execute the last keystroke in the summary buffer." - (interactive) - (let (func) - (pop-to-buffer gnus-article-current-summary) - (setq func (lookup-key (current-local-map) (this-command-keys))) - (call-interactively func))) - -(defun gnus-article-check-buffer () - "Beep if not in an article buffer." - (unless (equal major-mode 'gnus-article-mode) - (error "Command invoked outside of a Gnus article buffer"))) - -(defun gnus-article-read-summary-keys (&optional arg key not-restore-window) - "Read a summary buffer key sequence and execute it from the article buffer." - (interactive "P") - (gnus-article-check-buffer) - (let ((nosaves - '("q" "Q" "c" "r" "\C-c\C-f" "m" "a" "f" - "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP" - "=" "^" "\M-^" "|")) - (nosave-but-article - '("A\r")) - (nosave-in-article - '("\C-d")) - (up-to-top - '("n" "Gn" "p" "Gp")) - keys new-sum-point) - (save-excursion - (set-buffer gnus-article-current-summary) - (let (gnus-pick-mode) - (push (or key last-command-event) unread-command-events) - (setq keys (if (featurep 'xemacs) - (events-to-keys (read-key-sequence nil)) - (read-key-sequence nil))))) - - (message "") - - (if (or (member keys nosaves) - (member keys nosave-but-article) - (member keys nosave-in-article)) - (let (func) - (save-window-excursion - (pop-to-buffer gnus-article-current-summary) - ;; We disable the pick minor mode commands. - (let (gnus-pick-mode) - (setq func (lookup-key (current-local-map) keys)))) - (if (or (not func) - (numberp func)) - (ding) - (unless (member keys nosave-in-article) - (set-buffer gnus-article-current-summary)) - (call-interactively func) - (setq new-sum-point (point))) - (when (member keys nosave-but-article) - (pop-to-buffer gnus-article-buffer))) - ;; These commands should restore window configuration. - (let ((obuf (current-buffer)) - (owin (current-window-configuration)) - (opoint (point)) - win func in-buffer selected new-sum-start new-sum-hscroll) - (cond (not-restore-window - (pop-to-buffer gnus-article-current-summary)) - ((setq win (get-buffer-window gnus-article-current-summary)) - (select-window win)) - (t - (switch-to-buffer gnus-article-current-summary 'norecord))) - (setq in-buffer (current-buffer)) - ;; We disable the pick minor mode commands. - (if (and (setq func (let (gnus-pick-mode) - (lookup-key (current-local-map) keys))) - (functionp func)) - (progn - (call-interactively func) - (when (eq win (selected-window)) - (setq new-sum-point (point) - new-sum-start (window-start win) - new-sum-hscroll (window-hscroll win))) - (when (eq in-buffer (current-buffer)) - (setq selected (gnus-summary-select-article)) - (set-buffer obuf) - (unless not-restore-window - (set-window-configuration owin)) - (when (eq selected 'old) - (article-goto-body) - (set-window-start (get-buffer-window (current-buffer)) - 1) - (set-window-point (get-buffer-window (current-buffer)) - (point))) - (when (and (not not-restore-window) - new-sum-point) - (set-window-point win new-sum-point) - (set-window-start win new-sum-start) - (set-window-hscroll win new-sum-hscroll)))) - (set-window-configuration owin) - (ding)))))) - -(defun gnus-article-describe-key (key) - "Display documentation of the function invoked by KEY. KEY is a string." - (interactive "kDescribe key: ") - (gnus-article-check-buffer) - (if (eq (key-binding key) 'gnus-article-read-summary-keys) - (save-excursion - (set-buffer gnus-article-current-summary) - (let (gnus-pick-mode) - (if (featurep 'xemacs) - (progn - (push (elt key 0) unread-command-events) - (setq key (events-to-keys - (read-key-sequence "Describe key: ")))) - (setq unread-command-events - (mapcar - (lambda (x) (if (>= x 128) (list 'meta (- x 128)) x)) - (string-to-list key))) - (setq key (read-key-sequence "Describe key: ")))) - (describe-key key)) - (describe-key key))) - -(defun gnus-article-describe-key-briefly (key &optional insert) - "Display documentation of the function invoked by KEY. KEY is a string." - (interactive "kDescribe key: \nP") - (gnus-article-check-buffer) - (if (eq (key-binding key) 'gnus-article-read-summary-keys) - (save-excursion - (set-buffer gnus-article-current-summary) - (let (gnus-pick-mode) - (if (featurep 'xemacs) - (progn - (push (elt key 0) unread-command-events) - (setq key (events-to-keys - (read-key-sequence "Describe key: ")))) - (setq unread-command-events - (mapcar - (lambda (x) (if (>= x 128) (list 'meta (- x 128)) x)) - (string-to-list key))) - (setq key (read-key-sequence "Describe key: ")))) - (describe-key-briefly key insert)) - (describe-key-briefly key insert))) - -(defun gnus-article-reply-with-original (&optional wide) - "Start composing a reply mail to the current message. -The text in the region will be yanked. If the region isn't active, -the entire article will be yanked." - (interactive "P") - (let ((article (cdr gnus-article-current)) - contents) - (if (not (gnus-mark-active-p)) - (with-current-buffer gnus-summary-buffer - (gnus-summary-reply (list (list article)) wide)) - (setq contents (buffer-substring (point) (mark t))) - ;; Deactivate active regions. - (when (and (boundp 'transient-mark-mode) - transient-mark-mode) - (setq mark-active nil)) - (with-current-buffer gnus-summary-buffer - (gnus-summary-reply - (list (list article contents)) wide))))) - -(defun gnus-article-followup-with-original () - "Compose a followup to the current article. -The text in the region will be yanked. If the region isn't active, -the entire article will be yanked." - (interactive) - (let ((article (cdr gnus-article-current)) - contents) - (if (not (gnus-mark-active-p)) - (with-current-buffer gnus-summary-buffer - (gnus-summary-followup (list (list article)))) - (setq contents (buffer-substring (point) (mark t))) - ;; Deactivate active regions. - (when (and (boundp 'transient-mark-mode) - transient-mark-mode) - (setq mark-active nil)) - (with-current-buffer gnus-summary-buffer - (gnus-summary-followup - (list (list article contents))))))) - -(defun gnus-article-hide (&optional arg force) - "Hide all the gruft in the current article. -This means that signatures, cited text and (some) headers will be -hidden. -If given a prefix, show the hidden text instead." - (interactive (append (gnus-article-hidden-arg) (list 'force))) - (gnus-article-hide-headers arg) - (gnus-article-hide-list-identifiers arg) - (gnus-article-hide-citation-maybe arg force) - (gnus-article-hide-signature arg)) - -(defun gnus-article-maybe-highlight () - "Do some article highlighting if article highlighting is requested." - (when (gnus-visual-p 'article-highlight 'highlight) - (gnus-article-highlight-some))) - -(defun gnus-check-group-server () - ;; Make sure the connection to the server is alive. - (unless (gnus-server-opened - (gnus-find-method-for-group gnus-newsgroup-name)) - (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name)) - (gnus-request-group gnus-newsgroup-name t))) - -(eval-when-compile - (autoload 'nneething-get-file-name "nneething")) - -(defun gnus-request-article-this-buffer (article group) - "Get an article and insert it into this buffer." - (let (do-update-line sparse-header) - (prog1 - (save-excursion - (erase-buffer) - (gnus-kill-all-overlays) - (setq group (or group gnus-newsgroup-name)) - - ;; Using `gnus-request-article' directly will insert the article into - ;; `nntp-server-buffer' - so we'll save some time by not having to - ;; copy it from the server buffer into the article buffer. - - ;; We only request an article by message-id when we do not have the - ;; headers for it, so we'll have to get those. - (when (stringp article) - (gnus-read-header article)) - - ;; If the article number is negative, that means that this article - ;; doesn't belong in this newsgroup (possibly), so we find its - ;; message-id and request it by id instead of number. - (when (and (numberp article) - gnus-summary-buffer - (get-buffer gnus-summary-buffer) - (gnus-buffer-exists-p gnus-summary-buffer)) - (save-excursion - (set-buffer gnus-summary-buffer) - (let ((header (gnus-summary-article-header article))) - (when (< article 0) - (cond - ((memq article gnus-newsgroup-sparse) - ;; This is a sparse gap article. - (setq do-update-line article) - (setq article (mail-header-id header)) - (setq sparse-header (gnus-read-header article)) - (setq gnus-newsgroup-sparse - (delq article gnus-newsgroup-sparse))) - ((vectorp header) - ;; It's a real article. - (setq article (mail-header-id header))) - (t - ;; It is an extracted pseudo-article. - (setq article 'pseudo) - (gnus-request-pseudo-article header)))) - - (let ((method (gnus-find-method-for-group - gnus-newsgroup-name))) - (when (and (eq (car method) 'nneething) - (vectorp header)) - (let ((dir (nneething-get-file-name - (mail-header-id header)))) - (when (and (stringp dir) - (file-directory-p dir)) - (setq article 'nneething) - (gnus-group-enter-directory dir)))))))) - - (cond - ;; Refuse to select canceled articles. - ((and (numberp article) - gnus-summary-buffer - (get-buffer gnus-summary-buffer) - (gnus-buffer-exists-p gnus-summary-buffer) - (eq (cdr (save-excursion - (set-buffer gnus-summary-buffer) - (assq article gnus-newsgroup-reads))) - gnus-canceled-mark)) - nil) - ;; We first check `gnus-original-article-buffer'. - ((and (get-buffer gnus-original-article-buffer) - (numberp article) - (save-excursion - (set-buffer gnus-original-article-buffer) - (and (equal (car gnus-original-article) group) - (eq (cdr gnus-original-article) article)))) - (insert-buffer-substring gnus-original-article-buffer) - 'article) - ;; Check the backlog. - ((and gnus-keep-backlog - (gnus-backlog-request-article group article (current-buffer))) - 'article) - ;; Check asynchronous pre-fetch. - ((gnus-async-request-fetched-article group article (current-buffer)) - (gnus-async-prefetch-next group article gnus-summary-buffer) - (when (and (numberp article) gnus-keep-backlog) - (gnus-backlog-enter-article group article (current-buffer))) - 'article) - ;; Check the cache. - ((and gnus-use-cache - (numberp article) - (gnus-cache-request-article article group)) - 'article) - ;; Check the agent cache. - ((gnus-agent-request-article article group) - 'article) - ;; Get the article and put into the article buffer. - ((or (stringp article) - (numberp article)) - (let ((gnus-override-method gnus-override-method) - (methods (and (stringp article) - gnus-refer-article-method)) - (backend (car (gnus-find-method-for-group - gnus-newsgroup-name))) - result - (inhibit-read-only t)) - (if (or (not (listp methods)) - (and (symbolp (car methods)) - (assq (car methods) nnoo-definition-alist))) - (setq methods (list methods))) - (when (and (null gnus-override-method) - methods) - (setq gnus-override-method (pop methods))) - (while (not result) - (when (eq gnus-override-method 'current) - (setq gnus-override-method - (with-current-buffer gnus-summary-buffer - gnus-current-select-method))) - (erase-buffer) - (gnus-kill-all-overlays) - (let ((gnus-newsgroup-name group)) - (gnus-check-group-server)) - (cond - ((gnus-request-article article group (current-buffer)) - (when (numberp article) - (gnus-async-prefetch-next group article - gnus-summary-buffer) - (when gnus-keep-backlog - (gnus-backlog-enter-article - group article (current-buffer)))) - (setq result 'article)) - (methods - (setq gnus-override-method (pop methods))) - ((not (string-match "^400 " - (nnheader-get-report backend))) - ;; If we get 400 server disconnect, reconnect and - ;; retry; otherwise, assume the article has expired. - (setq result 'done)))) - (and (eq result 'article) 'article))) - ;; It was a pseudo. - (t article))) - - ;; Associate this article with the current summary buffer. - (setq gnus-article-current-summary gnus-summary-buffer) - - ;; Take the article from the original article buffer - ;; and place it in the buffer it's supposed to be in. - (when (and (get-buffer gnus-article-buffer) - (equal (buffer-name (current-buffer)) - (buffer-name (get-buffer gnus-article-buffer)))) - (save-excursion - (if (get-buffer gnus-original-article-buffer) - (set-buffer gnus-original-article-buffer) - (set-buffer (gnus-get-buffer-create gnus-original-article-buffer)) - (buffer-disable-undo) - (setq major-mode 'gnus-original-article-mode) - (setq buffer-read-only t)) - (let ((inhibit-read-only t)) - (erase-buffer) - (insert-buffer-substring gnus-article-buffer)) - (setq gnus-original-article (cons group article))) - - ;; Decode charsets. - (run-hooks 'gnus-article-decode-hook) - ;; Mark article as decoded or not. - (setq gnus-article-decoded-p gnus-article-decode-hook)) - - ;; Update sparse articles. - (when (and do-update-line - (or (numberp article) - (stringp article))) - (let ((buf (current-buffer))) - (set-buffer gnus-summary-buffer) - (gnus-summary-update-article do-update-line sparse-header) - (gnus-summary-goto-subject do-update-line nil t) - (set-window-point (gnus-get-buffer-window (current-buffer) t) - (point)) - (set-buffer buf)))))) - -;;; -;;; Article editing -;;; - -(defcustom gnus-article-edit-mode-hook nil - "Hook run in article edit mode buffers." - :group 'gnus-article-various - :type 'hook) - -(defvar gnus-article-edit-done-function nil) - -(defvar gnus-article-edit-mode-map nil) -(defvar gnus-article-edit-mode nil) - -;; Should we be using derived.el for this? -(unless gnus-article-edit-mode-map - (setq gnus-article-edit-mode-map (make-keymap)) - (set-keymap-parent gnus-article-edit-mode-map text-mode-map) - - (gnus-define-keys gnus-article-edit-mode-map - "\C-c?" describe-mode - "\C-c\C-c" gnus-article-edit-done - "\C-c\C-k" gnus-article-edit-exit - "\C-c\C-f\C-t" message-goto-to - "\C-c\C-f\C-o" message-goto-from - "\C-c\C-f\C-b" message-goto-bcc - ;;"\C-c\C-f\C-w" message-goto-fcc - "\C-c\C-f\C-c" message-goto-cc - "\C-c\C-f\C-s" message-goto-subject - "\C-c\C-f\C-r" message-goto-reply-to - "\C-c\C-f\C-n" message-goto-newsgroups - "\C-c\C-f\C-d" message-goto-distribution - "\C-c\C-f\C-f" message-goto-followup-to - "\C-c\C-f\C-m" message-goto-mail-followup-to - "\C-c\C-f\C-k" message-goto-keywords - "\C-c\C-f\C-u" message-goto-summary - "\C-c\C-f\C-i" message-insert-or-toggle-importance - "\C-c\C-f\C-a" message-generate-unsubscribed-mail-followup-to - "\C-c\C-b" message-goto-body - "\C-c\C-i" message-goto-signature - - "\C-c\C-t" message-insert-to - "\C-c\C-n" message-insert-newsgroups - "\C-c\C-o" message-sort-headers - "\C-c\C-e" message-elide-region - "\C-c\C-v" message-delete-not-region - "\C-c\C-z" message-kill-to-signature - "\M-\r" message-newline-and-reformat - "\C-c\C-a" mml-attach-file - "\C-a" message-beginning-of-line - "\t" message-tab - "\M-;" comment-region) - - (gnus-define-keys (gnus-article-edit-wash-map - "\C-c\C-w" gnus-article-edit-mode-map) - "f" gnus-article-edit-full-stops)) - -(easy-menu-define - gnus-article-edit-mode-field-menu gnus-article-edit-mode-map "" - '("Field" - ["Fetch To" message-insert-to t] - ["Fetch Newsgroups" message-insert-newsgroups t] - "----" - ["To" message-goto-to t] - ["From" message-goto-from t] - ["Subject" message-goto-subject t] - ["Cc" message-goto-cc t] - ["Reply-To" message-goto-reply-to t] - ["Summary" message-goto-summary t] - ["Keywords" message-goto-keywords t] - ["Newsgroups" message-goto-newsgroups t] - ["Followup-To" message-goto-followup-to t] - ["Mail-Followup-To" message-goto-mail-followup-to t] - ["Distribution" message-goto-distribution t] - ["Body" message-goto-body t] - ["Signature" message-goto-signature t])) - -(define-derived-mode gnus-article-edit-mode message-mode "Article Edit" - "Major mode for editing articles. -This is an extended text-mode. - -\\{gnus-article-edit-mode-map}" - (make-local-variable 'gnus-article-edit-done-function) - (make-local-variable 'gnus-prev-winconf) - (set (make-local-variable 'font-lock-defaults) - '(message-font-lock-keywords t)) - (set (make-local-variable 'mail-header-separator) "") - (set (make-local-variable 'gnus-article-edit-mode) t) - (easy-menu-add message-mode-field-menu message-mode-map) - (mml-mode) - (setq buffer-read-only nil) - (buffer-enable-undo) - (widen)) - -(defun gnus-article-edit (&optional force) - "Edit the current article. -This will have permanent effect only in mail groups. -If FORCE is non-nil, allow editing of articles even in read-only -groups." - (interactive "P") - (when (and (not force) - (gnus-group-read-only-p)) - (error "The current newsgroup does not support article editing")) - (gnus-article-date-original) - (gnus-article-edit-article - 'ignore - `(lambda (no-highlight) - 'ignore - (gnus-summary-edit-article-done - ,(or (mail-header-references gnus-current-headers) "") - ,(gnus-group-read-only-p) ,gnus-summary-buffer no-highlight)))) - -(defun gnus-article-edit-article (start-func exit-func) - "Start editing the contents of the current article buffer." - (let ((winconf (current-window-configuration))) - (set-buffer gnus-article-buffer) - (let ((message-auto-save-directory - ;; Don't associate the article buffer with a draft file. - nil)) - (gnus-article-edit-mode)) - (funcall start-func) - (set-buffer-modified-p nil) - (gnus-configure-windows 'edit-article) - (setq gnus-article-edit-done-function exit-func) - (setq gnus-prev-winconf winconf) - (gnus-message 6 "C-c C-c to end edits"))) - -(defun gnus-article-edit-done (&optional arg) - "Update the article edits and exit." - (interactive "P") - (let ((func gnus-article-edit-done-function) - (buf (current-buffer)) - (start (window-start)) - (p (point)) - (winconf gnus-prev-winconf)) - (widen) ;; Widen it in case that users narrowed the buffer. - (funcall func arg) - (set-buffer buf) - ;; The cache and backlog have to be flushed somewhat. - (when gnus-keep-backlog - (gnus-backlog-remove-article - (car gnus-article-current) (cdr gnus-article-current))) - ;; Flush original article as well. - (save-excursion - (when (get-buffer gnus-original-article-buffer) - (set-buffer gnus-original-article-buffer) - (setq gnus-original-article nil))) - (when gnus-use-cache - (gnus-cache-update-article - (car gnus-article-current) (cdr gnus-article-current))) - ;; We remove all text props from the article buffer. - (kill-all-local-variables) - (gnus-set-text-properties (point-min) (point-max) nil) - (gnus-article-mode) - (set-window-configuration winconf) - (set-buffer buf) - (set-window-start (get-buffer-window buf) start) - (set-window-point (get-buffer-window buf) (point))) - (gnus-summary-show-article)) - -(defun gnus-article-edit-exit () - "Exit the article editing without updating." - (interactive) - (when (or (not (buffer-modified-p)) - (yes-or-no-p "Article modified; kill anyway? ")) - (let ((curbuf (current-buffer)) - (p (point)) - (window-start (window-start))) - (erase-buffer) - (if (gnus-buffer-live-p gnus-original-article-buffer) - (insert-buffer-substring gnus-original-article-buffer)) - (let ((winconf gnus-prev-winconf)) - (kill-all-local-variables) - (gnus-article-mode) - (set-window-configuration winconf) - ;; Tippy-toe some to make sure that point remains where it was. - (save-current-buffer - (set-buffer curbuf) - (set-window-start (get-buffer-window (current-buffer)) window-start) - (goto-char p)))) - (gnus-summary-show-article))) - -(defun gnus-article-edit-full-stops () - "Interactively repair spacing at end of sentences." - (interactive) - (save-excursion - (goto-char (point-min)) - (search-forward-regexp "^$" nil t) - (let ((case-fold-search nil)) - (query-replace-regexp "\\([.!?][])}]* \\)\\([[({A-Z]\\)" "\\1 \\2")))) - -;;; -;;; Article highlights -;;; - -;; Written by Per Abrahamsen . - -;;; Internal Variables: - -(defcustom gnus-button-url-regexp - (if (string-match "[[:digit:]]" "1") ;; support POSIX? - "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|nntp\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-z0-9_.]+:[0-9]*\\)?[-a-z0-9_=!?#$@~%&*+\\/:;.,[:word:]]+[-a-z0-9_=#$@~%&*+\\/[:word:]]\\)" - "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|nntp\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-z0-9_.]+:[0-9]*\\)?\\([-a-z0-9_=!?#$@~%&*+\\/:;.,]\\|\\w\\)+\\([-a-z0-9_=#$@~%&*+\\/]\\|\\w\\)\\)") - "Regular expression that matches URLs." - :group 'gnus-article-buttons - :type 'regexp) - -(defcustom gnus-button-valid-fqdn-regexp - message-valid-fqdn-regexp - "Regular expression that matches a valid FQDN." - :version "22.1" - :group 'gnus-article-buttons - :type 'regexp) - -;; Regexp suggested by Felix Wiemann in <87oeuomcz9.fsf@news2.ososo.de> -(defcustom gnus-button-valid-localpart-regexp - "[a-z0-9$%(*-=?[_][^<>\")!;:,{}\n\t @]*" - "Regular expression that matches a localpart of mail addresses or MIDs." - :version "22.1" - :group 'gnus-article-buttons - :type 'regexp) - -(defcustom gnus-button-man-handler 'manual-entry - "Function to use for displaying man pages. -The function must take at least one argument with a string naming the -man page." - :version "22.1" - :type '(choice (function-item :tag "Man" manual-entry) - (function-item :tag "Woman" woman) - (function :tag "Other")) - :group 'gnus-article-buttons) - -(defcustom gnus-ctan-url "http://tug.ctan.org/tex-archive/" - "Top directory of a CTAN \(Comprehensive TeX Archive Network\) archive. -If the default site is too slow, try to find a CTAN mirror, see -. See also -the variable `gnus-button-handle-ctan'." - :version "22.1" - :group 'gnus-article-buttons - :link '(custom-manual "(gnus)Group Parameters") - :type '(choice (const "http://www.tex.ac.uk/tex-archive/") - (const "http://tug.ctan.org/tex-archive/") - (const "http://www.dante.de/CTAN/") - (string :tag "Other"))) - -(defcustom gnus-button-ctan-handler 'browse-url - "Function to use for displaying CTAN links. -The function must take one argument, the string naming the URL." - :version "22.1" - :type '(choice (function-item :tag "Browse Url" browse-url) - (function :tag "Other")) - :group 'gnus-article-buttons) - -(defcustom gnus-button-handle-ctan-bogus-regexp "^/?tex-archive/\\|^/" - "Bogus strings removed from CTAN URLs." - :version "22.1" - :group 'gnus-article-buttons - :type '(choice (const "^/?tex-archive/\\|/") - (regexp :tag "Other"))) - -(defcustom gnus-button-ctan-directory-regexp - (regexp-opt - (list "archive-tools" "biblio" "bibliography" "digests" "documentation" - "dviware" "fonts" "graphics" "help" "indexing" "info" "language" - "languages" "macros" "nonfree" "obsolete" "support" "systems" - "tds" "tools" "usergrps" "web") t) - "Regular expression for ctan directories. -It should match all directories in the top level of `gnus-ctan-url'." - :version "22.1" - :group 'gnus-article-buttons - :type 'regexp) - -(defcustom gnus-button-mid-or-mail-regexp - (concat "\\b\\(?\\)\\b") - "Regular expression that matches a message ID or a mail address." - :version "22.1" - :group 'gnus-article-buttons - :type 'regexp) - -(defcustom gnus-button-prefer-mid-or-mail 'gnus-button-mid-or-mail-heuristic - "What to do when the button on a string as \"foo123@bar.invalid\" is pushed. -Strings like this can be either a message ID or a mail address. If it is one -of the symbols `mid' or `mail', Gnus will always assume that the string is a -message ID or a mail address, respectively. If this variable is set to the -symbol `ask', always query the user what do do. If it is a function, this -function will be called with the string as its only argument. The function -must return `mid', `mail', `invalid' or `ask'." - :version "22.1" - :group 'gnus-article-buttons - :type '(choice (function-item :tag "Heuristic function" - gnus-button-mid-or-mail-heuristic) - (const ask) - (const mid) - (const mail))) - -(defcustom gnus-button-mid-or-mail-heuristic-alist - '((-10.0 . ".+\\$.+@") - (-10.0 . "#") - (-10.0 . "\\*") - (-5.0 . "\\+[^+]*\\+.*@") ;; # two plus signs - (-5.0 . "@[Nn][Ee][Ww][Ss]") ;; /\@news/i - (-5.0 . "@.*[Dd][Ii][Aa][Ll][Uu][Pp]") ;; /\@.*dialup/i; - (-1.0 . "^[^a-z]+@") - ;; - (-5.0 . "\\.[0-9][0-9]+.*@") ;; "\.[0-9]{2,}.*\@" - (-5.0 . "[a-z].*[A-Z].*[a-z].*[A-Z].*@") ;; "([a-z].*[A-Z].*){2,}\@" - (-3.0 . "[A-Z][A-Z][a-z][a-z].*@") - (-5.0 . "\\...?.?@") ;; (-5.0 . "\..{1,3}\@") - ;; - (-2.0 . "^[0-9]") - (-1.0 . "^[0-9][0-9]") - ;; - ;; -3.0 /^[0-9][0-9a-fA-F]{2,2}/; - (-3.0 . "^[0-9][0-9a-fA-F][0-9a-fA-F][^0-9a-fA-F]") - ;; -5.0 /^[0-9][0-9a-fA-F]{3,3}/; - (-5.0 . "^[0-9][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][^0-9a-fA-F]") - ;; - (-3.0 . "[0-9][0-9][0-9][0-9][0-9][^0-9].*@") ;; "[0-9]{5,}.*\@" - (-3.0 . "[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][^0-9].*@") - ;; "[0-9]{8,}.*\@" - (-3.0 - . "[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9].*@") - ;; "[0-9]{12,}.*\@" - ;; compensation for TDMA dated mail addresses: - (25.0 . "-dated-[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]+.*@") - ;; - (-20.0 . "\\.fsf@") ;; Gnus - (-20.0 . "^slrn") - (-20.0 . "^Pine") - (-20.0 . "_-_") ;; Subject change in thread - ;; - (-20.0 . "\\.ln@") ;; leafnode - (-30.0 . "@ID-[0-9]+\\.[a-zA-Z]+\\.dfncis\\.de") - (-30.0 . "@4[Aa][Xx]\\.com") ;; Forte Agent - ;; - ;; (5.0 . "") ;; $local_part_len <= 7 - (10.0 . "^[^0-9]+@") - (3.0 . "^[^0-9]+[0-9][0-9]?[0-9]?@") - ;; ^[^0-9]+[0-9]{1,3}\@ digits only at end of local part - (3.0 . "\@stud") - ;; - (2.0 . "[a-z][a-z][._-][A-Z][a-z].*@") - ;; - (0.5 . "^[A-Z][a-z]") - (0.5 . "^[A-Z][a-z][a-z]") - (1.5 . "^[A-Z][a-z][A-Z][a-z][^a-z]") ;; ^[A-Z][a-z]{3,3} - (2.0 . "^[A-Z][a-z][A-Z][a-z][a-z][^a-z]")) ;; ^[A-Z][a-z]{4,4} - "An alist of \(RATE . REGEXP\) pairs for `gnus-button-mid-or-mail-heuristic'. - -A negative RATE indicates a message IDs, whereas a positive indicates a mail -address. The REGEXP is processed with `case-fold-search' set to nil." - :version "22.1" - :group 'gnus-article-buttons - :type '(repeat (cons (number :tag "Rate") - (regexp :tag "Regexp")))) - -(defun gnus-button-mid-or-mail-heuristic (mid-or-mail) - "Guess whether MID-OR-MAIL is a message ID or a mail address. -Returns `mid' if MID-OR-MAIL is a message IDs, `mail' if it's a mail -address, `ask' if unsure and `invalid' if the string is invalid." - (let ((case-fold-search nil) - (list gnus-button-mid-or-mail-heuristic-alist) - (result 0) rate regexp lpartlen elem) - (setq lpartlen - (length (gnus-replace-in-string mid-or-mail "^\\(.*\\)@.*$" "\\1"))) - (gnus-message 8 "`%s', length of local part=`%s'." mid-or-mail lpartlen) - ;; Certain special cases... - (when (string-match - (concat - "^0[0-9]+-[0-9][0-9][0-9][0-9]@t-online\\.de$\\|" - "^[0-9]+\\.[0-9]+@compuserve\\|" - "@public\\.gmane\\.org") - mid-or-mail) - (gnus-message 8 "`%s' is a known mail address." mid-or-mail) - (setq result 'mail)) - (when (string-match "@.*@\\| " mid-or-mail) - (gnus-message 8 "`%s' is invalid." mid-or-mail) - (setq result 'invalid)) - ;; Nothing more to do, if result is not a number here... - (when (numberp result) - (while list - (setq elem (car list) - rate (car elem) - regexp (cdr elem) - list (cdr list)) - (when (string-match regexp mid-or-mail) - (setq result (+ result rate)) - (gnus-message - 9 "`%s' matched `%s', rate `%s', result `%s'." - mid-or-mail regexp rate result))) - (when (<= lpartlen 7) - (setq result (+ result 5.0)) - (gnus-message 9 "`%s' matched (<= lpartlen 7), result `%s'." - mid-or-mail result)) - (when (>= lpartlen 12) - (gnus-message 9 "`%s' matched (>= lpartlen 12)" mid-or-mail) - (cond - ((string-match "[0-9][^0-9]+[0-9].*@" mid-or-mail) - ;; Long local part should contain realname if e-mail address, - ;; too many digits: message-id. - ;; $score -= 5.0 + 0.1 * $local_part_len; - (setq rate (* -1.0 (+ 5.0 (* 0.1 lpartlen)))) - (setq result (+ result rate)) - (gnus-message - 9 "Many digits in `%s', rate `%s', result `%s'." - mid-or-mail rate result)) - ((string-match "[^aeiouy][^aeiouy][^aeiouy][^aeiouy]+.*\@" - mid-or-mail) - ;; Too few vowels [^aeiouy]{4,}.*\@ - (setq result (+ result -5.0)) - (gnus-message - 9 "Few vowels in `%s', rate `%s', result `%s'." - mid-or-mail -5.0 result)) - (t - (setq result (+ result 5.0)) - (gnus-message - 9 "`%s', rate `%s', result `%s'." mid-or-mail 5.0 result))))) - (gnus-message 8 "`%s': Final rate is `%s'." mid-or-mail result) - ;; Maybe we should make this a customizable alist: (condition . 'result) - (cond - ((symbolp result) result) - ;; Now convert number into proper results: - ((< result -10.0) 'mid) - ((> result 10.0) 'mail) - (t 'ask)))) - -(defun gnus-button-handle-mid-or-mail (mid-or-mail) - (let* ((pref gnus-button-prefer-mid-or-mail) guessed - (url-mid (concat "news" ":" mid-or-mail)) - (url-mailto (concat "mailto" ":" mid-or-mail))) - (gnus-message 9 "mid-or-mail=%s" mid-or-mail) - (when (fboundp pref) - (setq guessed - ;; get rid of surrounding angles... - (funcall pref - (gnus-replace-in-string mid-or-mail "^<\\|>$" ""))) - (if (or (eq 'mid guessed) (eq 'mail guessed)) - (setq pref guessed) - (setq pref 'ask))) - (if (eq pref 'ask) - (save-window-excursion - (if (y-or-n-p (concat "Is <" mid-or-mail "> a mail address? ")) - (setq pref 'mail) - (setq pref 'mid)))) - (cond ((eq pref 'mid) - (gnus-message 8 "calling `gnus-button-handle-news' %s" url-mid) - (gnus-button-handle-news url-mid)) - ((eq pref 'mail) - (gnus-message 8 "calling `gnus-url-mailto' %s" url-mailto) - (gnus-url-mailto url-mailto)) - (t (gnus-message 3 "Invalid string."))))) - -(defun gnus-button-handle-custom (url) - "Follow a Custom URL." - (customize-apropos (gnus-url-unhex-string url))) - -(defvar gnus-button-handle-describe-prefix "^\\(C-h\\|?\\)") - -;; FIXME: Maybe we should merge some of the functions that do quite similar -;; stuff? - -(defun gnus-button-handle-describe-function (url) - "Call `describe-function' when pushing the corresponding URL button." - (describe-function - (intern - (gnus-replace-in-string url gnus-button-handle-describe-prefix "")))) - -(defun gnus-button-handle-describe-variable (url) - "Call `describe-variable' when pushing the corresponding URL button." - (describe-variable - (intern - (gnus-replace-in-string url gnus-button-handle-describe-prefix "")))) - -(defun gnus-button-handle-symbol (url) -"Display help on variable or function. -Calls `describe-variable' or `describe-function'." - (let ((sym (intern url))) - (cond - ((fboundp sym) (describe-function sym)) - ((boundp sym) (describe-variable sym)) - (t (gnus-message 3 "`%s' is not a known function of variable." url))))) - -(defun gnus-button-handle-describe-key (url) - "Call `describe-key' when pushing the corresponding URL button." - (let* ((key-string - (gnus-replace-in-string url gnus-button-handle-describe-prefix "")) - (keys (ignore-errors (eval `(kbd ,key-string))))) - (if keys - (describe-key keys) - (gnus-message 3 "Invalid key sequence in button: %s" key-string)))) - -(defun gnus-button-handle-apropos (url) - "Call `apropos' when pushing the corresponding URL button." - (apropos (gnus-replace-in-string url gnus-button-handle-describe-prefix ""))) - -(defun gnus-button-handle-apropos-command (url) - "Call `apropos' when pushing the corresponding URL button." - (apropos-command - (gnus-replace-in-string url gnus-button-handle-describe-prefix ""))) - -(defun gnus-button-handle-apropos-variable (url) - "Call `apropos' when pushing the corresponding URL button." - (funcall - (if (fboundp 'apropos-variable) 'apropos-variable 'apropos) - (gnus-replace-in-string url gnus-button-handle-describe-prefix ""))) - -(defun gnus-button-handle-apropos-documentation (url) - "Call `apropos' when pushing the corresponding URL button." - (funcall - (if (fboundp 'apropos-documentation) 'apropos-documentation 'apropos) - (gnus-replace-in-string url gnus-button-handle-describe-prefix ""))) - -(defun gnus-button-handle-library (url) - "Call `locate-library' when pushing the corresponding URL button." - (gnus-message 9 "url=`%s'" url) - (let* ((lib (locate-library url)) - (file (gnus-replace-in-string (or lib "") "\.elc" ".el"))) - (if (not lib) - (gnus-message 1 "Cannot locale library `%s'." url) - (find-file-read-only file)))) - -(defun gnus-button-handle-ctan (url) - "Call `browse-url' when pushing a CTAN URL button." - (funcall - gnus-button-ctan-handler - (concat - gnus-ctan-url - (gnus-replace-in-string url gnus-button-handle-ctan-bogus-regexp "")))) - -(defcustom gnus-button-tex-level 5 - "*Integer that says how many TeX-related buttons Gnus will show. -The higher the number, the more buttons will appear and the more false -positives are possible. Note that you can set this variable local to -specific groups. Setting it higher in TeX groups is probably a good idea. -See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on -how to set variables in specific groups." - :version "22.1" - :group 'gnus-article-buttons - :link '(custom-manual "(gnus)Group Parameters") - :type 'integer) - -(defcustom gnus-button-man-level 5 - "*Integer that says how many man-related buttons Gnus will show. -The higher the number, the more buttons will appear and the more false -positives are possible. Note that you can set this variable local to -specific groups. Setting it higher in Unix groups is probably a good idea. -See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on -how to set variables in specific groups." - :version "22.1" - :group 'gnus-article-buttons - :link '(custom-manual "(gnus)Group Parameters") - :type 'integer) - -(defcustom gnus-button-emacs-level 5 - "*Integer that says how many emacs-related buttons Gnus will show. -The higher the number, the more buttons will appear and the more false -positives are possible. Note that you can set this variable local to -specific groups. Setting it higher in Emacs or Gnus related groups is -probably a good idea. See Info node `(gnus)Group Parameters' and the variable -`gnus-parameters' on how to set variables in specific groups." - :version "22.1" - :group 'gnus-article-buttons - :link '(custom-manual "(gnus)Group Parameters") - :type 'integer) - -(defcustom gnus-button-message-level 5 - "*Integer that says how many buttons for news or mail messages will appear. -The higher the number, the more buttons will appear and the more false -positives are possible." - ;; mail addresses, MIDs, URLs for news, ... - :version "22.1" - :group 'gnus-article-buttons - :type 'integer) - -(defcustom gnus-button-browse-level 5 - "*Integer that says how many buttons for browsing will appear. -The higher the number, the more buttons will appear and the more false -positives are possible." - ;; stuff handled by `browse-url' or `gnus-button-embedded-url' - :version "22.1" - :group 'gnus-article-buttons - :type 'integer) - -(defcustom gnus-button-alist - '(("<\\(url:[>\n\t ]*?\\)?\\(nntp\\|news\\):[>\n\t ]*\\([^>\n\t ]*@[^>\n\t ]*\\)>" - 0 (>= gnus-button-message-level 0) gnus-button-handle-news 3) - ((concat "\\b\\(nntp\\|news\\):\\(" - gnus-button-valid-localpart-regexp "@[a-z0-9.-]+[a-z]\\)") - 0 t gnus-button-handle-news 2) - ("\\(\\b<\\(url:[>\n\t ]*\\)?\\(nntp\\|news\\):[>\n\t ]*\\(//\\)?\\([^>\n\t ]*\\)>\\)" - 1 (>= gnus-button-message-level 0) gnus-button-fetch-group 5) - ("\\b\\(nntp\\|news\\):\\(//\\)?\\([^'\">\n\t ]+\\)" - 0 (>= gnus-button-message-level 0) gnus-button-fetch-group 3) - ;; RFC 2392 (Don't allow `/' in domain part --> CID) - ("\\bmid:\\(//\\)?\\([^'\">\n\t ]+@[^'\">\n\t /]+\\)" - 0 (>= gnus-button-message-level 0) gnus-button-message-id 2) - ("\\bin\\( +article\\| +message\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" - 2 (>= gnus-button-message-level 0) gnus-button-message-id 3) - ("\\( \n\t]+\\)>" - 0 (>= gnus-button-message-level 0) gnus-url-mailto 2) - ;; RFC 2368 (The mailto URL scheme) - ("\\bmailto:\\([-a-z.@_+0-9%=?&/]+\\)" - 0 (>= gnus-button-message-level 0) gnus-url-mailto 1) - ("\\bmailto:\\([^ \n\t]+\\)" - 0 (>= gnus-button-message-level 0) gnus-url-mailto 1) - ;; CTAN - ((concat "\\bCTAN:[ \t\n]?[^>)!;:,'\n\t ]*\\(" - gnus-button-ctan-directory-regexp - "[^][>)!;:,'\n\t ]+\\)") - 0 (>= gnus-button-tex-level 1) gnus-button-handle-ctan 1) - ((concat "\\btex-archive/\\(" - gnus-button-ctan-directory-regexp - "/[-_.a-z0-9/]+[-_./a-z0-9]+[/a-z0-9]\\)") - 1 (>= gnus-button-tex-level 6) gnus-button-handle-ctan 1) - ((concat - "\\b\\(" - gnus-button-ctan-directory-regexp - "/[-_.a-z0-9]+/[-_./a-z0-9]+[/a-z0-9]\\)") - 1 (>= gnus-button-tex-level 8) gnus-button-handle-ctan 1) - ;; This is info (home-grown style) - ("\\binfo://\\([^'\">\n\t ]+\\)" - 0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url 1) - ;; Info GNOME style - ("\\binfo:\\([^('\n\t\r \"><][^'\n\t\r \"><]*\\)" - 0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url-gnome 1) - ;; Info KDE style - ("<\\(info:\\(([^)]+)[^>\n\r]*\\)\\)>" - 1 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url-kde 2) - ("\\((Info-goto-node\\|(info\\)[ \t\n]*\\(\"[^\"]*\"\\))" 0 - (>= gnus-button-emacs-level 1) gnus-button-handle-info-url 2) - ("\\b\\(C-h\\|?\\)[ \t\n]+i[ \t\n]+d?[ \t\n]?m[ \t\n]+\\([^ ]+ ?[^ ]+\\)[ \t\n]+RET" - ;; Info links like `C-h i d m CC Mode RET' - 0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-keystrokes 2) - ;; This is custom - ("\\bcustom:\\(//\\)?\\([^'\">\n\t ]+\\)" - 0 (>= gnus-button-emacs-level 5) gnus-button-handle-custom 2) - ("M-x[ \t\n]customize-[^ ]+[ \t\n]RET[ \t\n]\\([^ ]+\\)[ \t\n]RET" 0 - (>= gnus-button-emacs-level 1) gnus-button-handle-custom 1) - ;; Emacs help commands - ("M-x[ \t\n]+apropos[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" - ;; regexp doesn't match arguments containing ` '. - 0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos 1) - ("M-x[ \t\n]+apropos-command[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" - 0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-command 1) - ("M-x[ \t\n]+apropos-variable[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" - 0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-variable 1) - ("M-x[ \t\n]+apropos-documentation[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" - 0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-documentation 1) - ;; The following entries may lead to many false positives so don't enable - ;; them by default (use a high button level). - ("/\\([a-z][-a-z0-9]+\\.el\\)\\>[^.?]" - ;; Exclude [.?] for URLs in gmane.emacs.cvs - 1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1) - ("`\\([a-z][-a-z0-9]+\\.el\\)'" - 1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1) - ("`\\([a-z][a-z0-9]+-[a-z]+-[-a-z]+\\|\\(gnus\\|message\\)-[-a-z]+\\)'" - 0 (>= gnus-button-emacs-level 8) gnus-button-handle-symbol 1) - ("`\\([a-z][a-z0-9]+-[a-z]+\\)'" - 0 (>= gnus-button-emacs-level 9) gnus-button-handle-symbol 1) - ("(setq[ \t\n]+\\([a-z][a-z0-9]+-[-a-z0-9]+\\)[ \t\n]+.+)" - 1 (>= gnus-button-emacs-level 7) gnus-button-handle-describe-variable 1) - ("\\bM-x[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" - 1 (>= gnus-button-emacs-level 7) gnus-button-handle-describe-function 1) - ("\\b\\(C-h\\|?\\)[ \t\n]+f[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" - 0 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-function 2) - ("\\b\\(C-h\\|?\\)[ \t\n]+v[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" - 0 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-variable 2) - ("`\\(\\(C-h\\|?\\)[ \t\n]+k[ \t\n]+\\([^']+\\)\\)'" - ;; Unlike the other regexps we really have to require quoting - ;; here to determine where it ends. - 1 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-key 3) - ;; This is how URLs _should_ be embedded in text (RFC 1738, RFC 2396)... - ("]*\\)>" - 1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1) - ;; RFC 2396 (2.4.3., delims) ... - ("\"URL: *\\([^\"]*\\)\"" - 1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1) - ;; RFC 2396 (2.4.3., delims) ... - ("\"URL: *\\([^\"]*\\)\"" - 1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1) - ;; Raw URLs. - (gnus-button-url-regexp - 0 (>= gnus-button-browse-level 0) browse-url 0) - ;; man pages - ("\\b\\([a-z][a-z]+([1-9])\\)\\W" - 0 (and (>= gnus-button-man-level 1) (< gnus-button-man-level 3)) - gnus-button-handle-man 1) - ;; more man pages: resolv.conf(5), iso_8859-1(7), xterm(1x) - ("\\b\\([a-z][-_.a-z0-9]+([1-9])\\)\\W" - 0 (and (>= gnus-button-man-level 3) (< gnus-button-man-level 5)) - gnus-button-handle-man 1) - ;; even more: Apache::PerlRun(3pm), PDL::IO::FastRaw(3pm), - ;; SoWWWAnchor(3iv), XSelectInput(3X11), X(1), X(7) - ("\\b\\(\\(?:[a-z][-+_.:a-z0-9]+([1-9][X1a-z]*)\\)\\|\\b\\(?:X([1-9])\\)\\)\\W" - 0 (>= gnus-button-man-level 5) gnus-button-handle-man 1) - ;; MID or mail: To avoid too many false positives we don't try to catch - ;; all kind of allowed MIDs or mail addresses. Domain part must contain - ;; at least one dot. TLD must contain two or three chars or be a know TLD - ;; (info|name|...). Put this entry near the _end_ of `gnus-button-alist' - ;; so that non-ambiguous entries (see above) match first. - (gnus-button-mid-or-mail-regexp - 0 (>= gnus-button-message-level 5) gnus-button-handle-mid-or-mail 1)) - "*Alist of regexps matching buttons in article bodies. - -Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where -REGEXP: is the string (case insensitive) matching text around the button (can -also be Lisp expression evaluating to a string), -BUTTON: is the number of the regexp grouping actually matching the button, -FORM: is a Lisp expression which must eval to true for the button to -be added, -CALLBACK: is the function to call when the user push this button, and each -PAR: is a number of a regexp grouping whose text will be passed to CALLBACK. - -CALLBACK can also be a variable, in that case the value of that -variable it the real callback function." - :group 'gnus-article-buttons - :type '(repeat (list (choice regexp variable sexp) - (integer :tag "Button") - (sexp :tag "Form") - (function :tag "Callback") - (repeat :tag "Par" - :inline t - (integer :tag "Regexp group"))))) -(put 'gnus-button-alist 'risky-local-variable t) - -(defcustom gnus-header-button-alist - '(("^\\(References\\|Message-I[Dd]\\|^In-Reply-To\\):" "<[^<>]+>" - 0 (>= gnus-button-message-level 0) gnus-button-message-id 0) - ("^\\(From\\|Reply-To\\):" ": *\\(.+\\)$" - 1 (>= gnus-button-message-level 0) gnus-button-reply 1) - ("^\\(Cc\\|To\\):" "[^ \t\n<>,()\"]+@[^ \t\n<>,()\"]+" - 0 (>= gnus-button-message-level 0) gnus-msg-mail 0) - ("^X-[Uu][Rr][Ll]:" gnus-button-url-regexp - 0 (>= gnus-button-browse-level 0) browse-url 0) - ("^Subject:" gnus-button-url-regexp - 0 (>= gnus-button-browse-level 0) browse-url 0) - ("^[^:]+:" gnus-button-url-regexp - 0 (>= gnus-button-browse-level 0) browse-url 0) - ("^[^:]+:" "\\bmailto:\\([-a-z.@_+0-9%=?&/]+\\)" - 0 (>= gnus-button-message-level 0) gnus-url-mailto 1) - ("^[^:]+:" "\\(<\\(url: \\)?\\(nntp\\|news\\):\\([^>\n ]*\\)>\\)" - 1 (>= gnus-button-message-level 0) gnus-button-message-id 4)) - "*Alist of headers and regexps to match buttons in article heads. - -This alist is very similar to `gnus-button-alist', except that each -alist has an additional HEADER element first in each entry: - -\(HEADER REGEXP BUTTON FORM CALLBACK PAR) - -HEADER is a regexp to match a header. For a fuller explanation, see -`gnus-button-alist'." - :group 'gnus-article-buttons - :group 'gnus-article-headers - :type '(repeat (list (regexp :tag "Header") - (choice regexp variable) - (integer :tag "Button") - (sexp :tag "Form") - (function :tag "Callback") - (repeat :tag "Par" - :inline t - (integer :tag "Regexp group"))))) -(put 'gnus-header-button-alist 'risky-local-variable t) - -;;; Commands: - -(defun gnus-article-push-button (event) - "Check text under the mouse pointer for a callback function. -If the text under the mouse pointer has a `gnus-callback' property, -call it with the value of the `gnus-data' text property." - (interactive "e") - (set-buffer (window-buffer (posn-window (event-start event)))) - (let* ((pos (posn-point (event-start event))) - (data (get-text-property pos 'gnus-data)) - (fun (get-text-property pos 'gnus-callback))) - (goto-char pos) - (when fun - (funcall fun data)))) - -(defun gnus-article-press-button () - "Check text at point for a callback function. -If the text at point has a `gnus-callback' property, -call it with the value of the `gnus-data' text property." - (interactive) - (let ((data (get-text-property (point) 'gnus-data)) - (fun (get-text-property (point) 'gnus-callback))) - (when fun - (funcall fun data)))) - -(defun gnus-article-highlight (&optional force) - "Highlight current article. -This function calls `gnus-article-highlight-headers', -`gnus-article-highlight-citation', -`gnus-article-highlight-signature', and `gnus-article-add-buttons' to -do the highlighting. See the documentation for those functions." - (interactive (list 'force)) - (gnus-article-highlight-headers) - (gnus-article-highlight-citation force) - (gnus-article-highlight-signature) - (gnus-article-add-buttons force) - (gnus-article-add-buttons-to-head)) - -(defun gnus-article-highlight-some (&optional force) - "Highlight current article. -This function calls `gnus-article-highlight-headers', -`gnus-article-highlight-signature', and `gnus-article-add-buttons' to -do the highlighting. See the documentation for those functions." - (interactive (list 'force)) - (gnus-article-highlight-headers) - (gnus-article-highlight-signature) - (gnus-article-add-buttons)) - -(defun gnus-article-highlight-headers () - "Highlight article headers as specified by `gnus-header-face-alist'." - (interactive) - (save-excursion - (set-buffer gnus-article-buffer) - (save-restriction - (let ((alist gnus-header-face-alist) - (inhibit-read-only t) - (case-fold-search t) - (inhibit-point-motion-hooks t) - entry regexp header-face field-face from hpoints fpoints) - (article-narrow-to-head) - (while (setq entry (pop alist)) - (goto-char (point-min)) - (setq regexp (concat "^\\(" - (if (string-equal "" (nth 0 entry)) - "[^\t ]" - (nth 0 entry)) - "\\)") - header-face (nth 1 entry) - field-face (nth 2 entry)) - (while (and (re-search-forward regexp nil t) - (not (eobp))) - (beginning-of-line) - (setq from (point)) - (unless (search-forward ":" nil t) - (forward-char 1)) - (when (and header-face - (not (memq (point) hpoints))) - (push (point) hpoints) - (gnus-put-text-property from (point) 'face header-face)) - (when (and field-face - (not (memq (setq from (point)) fpoints))) - (push from fpoints) - (if (re-search-forward "^[^ \t]" nil t) - (forward-char -2) - (goto-char (point-max))) - (gnus-put-text-property from (point) 'face field-face)))))))) - -(defun gnus-article-highlight-signature () - "Highlight the signature in an article. -It does this by highlighting everything after -`gnus-signature-separator' using the face `gnus-signature'." - (interactive) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((inhibit-read-only t) - (inhibit-point-motion-hooks t)) - (save-restriction - (when (and gnus-signature-face - (gnus-article-narrow-to-signature)) - (gnus-overlay-put (gnus-make-overlay (point-min) (point-max)) - 'face gnus-signature-face) - (widen) - (gnus-article-search-signature) - (let ((start (match-beginning 0)) - (end (set-marker (make-marker) (1+ (match-end 0))))) - (gnus-article-add-button start (1- end) 'gnus-signature-toggle - end))))))) - -(defun gnus-button-in-region-p (b e prop) - "Say whether PROP exists in the region." - (text-property-not-all b e prop nil)) - -(defun gnus-article-add-buttons (&optional force) - "Find external references in the article and make buttons of them. -\"External references\" are things like Message-IDs and URLs, as -specified by `gnus-button-alist'." - (interactive (list 'force)) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((inhibit-read-only t) - (inhibit-point-motion-hooks t) - (case-fold-search t) - (alist gnus-button-alist) - beg entry regexp) - ;; Remove all old markers. - (let (marker entry new-list) - (while (setq marker (pop gnus-button-marker-list)) - (if (or (< marker (point-min)) (>= marker (point-max))) - (push marker new-list) - (goto-char marker) - (when (setq entry (gnus-button-entry)) - (put-text-property (match-beginning (nth 1 entry)) - (match-end (nth 1 entry)) - 'gnus-callback nil)) - (set-marker marker nil))) - (setq gnus-button-marker-list new-list)) - ;; We skip the headers. - (article-goto-body) - (setq beg (point)) - (while (setq entry (pop alist)) - (setq regexp (eval (car entry))) - (goto-char beg) - (while (re-search-forward regexp nil t) - (let* ((start (and entry (match-beginning (nth 1 entry)))) - (end (and entry (match-end (nth 1 entry)))) - (from (match-beginning 0))) - (when (and (or (eq t (nth 2 entry)) - (eval (nth 2 entry))) - (not (gnus-button-in-region-p - start end 'gnus-callback))) - ;; That optional form returned non-nil, so we add the - ;; button. - (gnus-article-add-button - start end 'gnus-button-push - (car (push (set-marker (make-marker) from) - gnus-button-marker-list)))))))))) - -;; Add buttons to the head of an article. -(defun gnus-article-add-buttons-to-head () - "Add buttons to the head of the article." - (interactive) - (save-excursion - (set-buffer gnus-article-buffer) - (save-restriction - (let ((inhibit-read-only t) - (inhibit-point-motion-hooks t) - (case-fold-search t) - (alist gnus-header-button-alist) - entry beg end) - (article-narrow-to-head) - (while alist - ;; Each alist entry. - (setq entry (car alist) - alist (cdr alist)) - (goto-char (point-min)) - (while (re-search-forward (car entry) nil t) - ;; Each header matching the entry. - (setq beg (match-beginning 0)) - (setq end (or (and (re-search-forward "^[^ \t]" nil t) - (match-beginning 0)) - (point-max))) - (goto-char beg) - (while (re-search-forward (eval (nth 1 entry)) end t) - ;; Each match within a header. - (let* ((entry (cdr entry)) - (start (match-beginning (nth 1 entry))) - (end (match-end (nth 1 entry))) - (form (nth 2 entry))) - (goto-char (match-end 0)) - (when (eval form) - (gnus-article-add-button - start end (nth 3 entry) - (buffer-substring (match-beginning (nth 4 entry)) - (match-end (nth 4 entry))))))) - (goto-char end))))))) - -;;; External functions: - -(defun gnus-article-add-button (from to fun &optional data) - "Create a button between FROM and TO with callback FUN and data DATA." - (when gnus-article-button-face - (gnus-overlay-put (gnus-make-overlay from to) - 'face gnus-article-button-face)) - (gnus-add-text-properties - from to - (nconc (and gnus-article-mouse-face - (list gnus-mouse-face-prop gnus-article-mouse-face)) - (list 'gnus-callback fun) - (and data (list 'gnus-data data)))) - (widget-convert-button 'link from to :action 'gnus-widget-press-button - :button-keymap gnus-widget-button-keymap)) - -;;; Internal functions: - -(defun gnus-article-set-globals () - (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-set-global-variables))) - -(defun gnus-signature-toggle (end) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((inhibit-read-only t) - (inhibit-point-motion-hooks t)) - (if (text-property-any end (point-max) 'article-type 'signature) - (progn - (gnus-delete-wash-type 'signature) - (gnus-remove-text-properties-when - 'article-type 'signature end (point-max) - (cons 'article-type (cons 'signature - gnus-hidden-properties)))) - (gnus-add-wash-type 'signature) - (gnus-add-text-properties-when - 'article-type nil end (point-max) - (cons 'article-type (cons 'signature - gnus-hidden-properties))))) - (let ((gnus-article-mime-handle-alist-1 gnus-article-mime-handle-alist)) - (gnus-set-mode-line 'article)))) - -(defun gnus-button-entry () - ;; Return the first entry in `gnus-button-alist' matching this place. - (let ((alist gnus-button-alist) - (entry nil)) - (while alist - (setq entry (pop alist)) - (if (looking-at (eval (car entry))) - (setq alist nil) - (setq entry nil))) - entry)) - -(defun gnus-button-push (marker) - ;; Push button starting at MARKER. - (save-excursion - (goto-char marker) - (let* ((entry (gnus-button-entry)) - (inhibit-point-motion-hooks t) - (fun (nth 3 entry)) - (args (mapcar (lambda (group) - (let ((string (match-string group))) - (gnus-set-text-properties - 0 (length string) nil string) - string)) - (nthcdr 4 entry)))) - (cond - ((fboundp fun) - (apply fun args)) - ((and (boundp fun) - (fboundp (symbol-value fun))) - (apply (symbol-value fun) args)) - (t - (gnus-message 1 "You must define `%S' to use this button" - (cons fun args))))))) - -(defun gnus-parse-news-url (url) - (let (scheme server port group message-id articles) - (with-temp-buffer - (insert url) - (goto-char (point-min)) - (when (looking-at "\\([A-Za-z]+\\):") - (setq scheme (match-string 1)) - (goto-char (match-end 0))) - (when (looking-at "//\\([^:/]+\\)\\(:?\\)\\([0-9]+\\)?/") - (setq server (match-string 1)) - (setq port (if (stringp (match-string 3)) - (string-to-number (match-string 3)) - (match-string 3))) - (goto-char (match-end 0))) - - (cond - ((looking-at "\\(.*@.*\\)") - (setq message-id (match-string 1))) - ((looking-at "\\([^/]+\\)/\\([-0-9]+\\)") - (setq group (match-string 1) - articles (split-string (match-string 2) "-"))) - ((looking-at "\\([^/]+\\)/?") - (setq group (match-string 1))) - (t - (error "Unknown news URL syntax")))) - (list scheme server port group message-id articles))) - -(defun gnus-button-handle-news (url) - "Fetch a news URL." - (destructuring-bind (scheme server port group message-id articles) - (gnus-parse-news-url url) - (cond - (message-id - (save-excursion - (set-buffer gnus-summary-buffer) - (if server - (let ((gnus-refer-article-method - (nconc (list (list 'nntp server)) - gnus-refer-article-method)) - (nntp-port-number (or port "nntp"))) - (gnus-message 7 "Fetching %s with %s" - message-id gnus-refer-article-method) - (gnus-summary-refer-article message-id)) - (gnus-summary-refer-article message-id)))) - (group - (gnus-button-fetch-group url))))) - -(defun gnus-button-handle-man (url) - "Fetch a man page." - (gnus-message 9 "`%s' `%s'" gnus-button-man-handler url) - (when (eq gnus-button-man-handler 'woman) - (setq url (gnus-replace-in-string url "([1-9][X1a-z]*).*\\'" ""))) - (gnus-message 9 "`%s' `%s'" gnus-button-man-handler url) - (funcall gnus-button-man-handler url)) - -(defun gnus-button-handle-info-url (url) - "Fetch an info URL." - (setq url (mm-subst-char-in-string ?+ ?\ url)) - (cond - ((string-match "^\\([^:/]+\\)?/\\(.*\\)" url) - (gnus-info-find-node - (concat "(" (or (gnus-url-unhex-string (match-string 1 url)) - "Gnus") - ")" (gnus-url-unhex-string (match-string 2 url))))) - ((string-match "([^)\"]+)[^\"]+" url) - (setq url - (gnus-replace-in-string - (gnus-replace-in-string url "[\n\t ]+" " ") "\"" "")) - (gnus-info-find-node url)) - (t (error "Can't parse %s" url)))) - -(defun gnus-button-handle-info-url-gnome (url) - "Fetch GNOME style info URL." - (setq url (mm-subst-char-in-string ?_ ?\ url)) - (if (string-match "\\([^#]+\\)#?\\(.*\\)" url) - (gnus-info-find-node - (concat "(" - (gnus-url-unhex-string - (match-string 1 url)) - ")" - (or (gnus-url-unhex-string - (match-string 2 url)) - "Top"))) - (error "Can't parse %s" url))) - -(defun gnus-button-handle-info-url-kde (url) - "Fetch KDE style info URL." - (gnus-info-find-node (gnus-url-unhex-string url))) - -(defun gnus-button-handle-info-keystrokes (url) - "Call `info' when pushing the corresponding URL button." - ;; For links like `C-h i d m gnus RET', `C-h i d m CC Mode RET'. - (info) - (Info-directory) - (Info-menu url)) - -(defun gnus-button-message-id (message-id) - "Fetch MESSAGE-ID." - (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-summary-refer-article message-id))) - -(defun gnus-button-fetch-group (address) - "Fetch GROUP specified by ADDRESS." - (if (not (string-match "[:/]" address)) - ;; This is just a simple group url. - (gnus-group-read-ephemeral-group address gnus-select-method) - (if (not - (string-match - "^\\([^:/]+\\)\\(:\\([^/]+\\)\\)?/\\([^/]+\\)\\(/\\([0-9]+\\)\\)?" - address)) - (error "Can't parse %s" address) - (gnus-group-read-ephemeral-group - (match-string 4 address) - `(nntp ,(match-string 1 address) - (nntp-address ,(match-string 1 address)) - (nntp-port-number ,(if (match-end 3) - (match-string 3 address) - "nntp"))) - nil nil nil - (and (match-end 6) (list (string-to-number (match-string 6 address)))))))) - -(defun gnus-url-parse-query-string (query &optional downcase) - (let (retval pairs cur key val) - (setq pairs (split-string query "&")) - (while pairs - (setq cur (car pairs) - pairs (cdr pairs)) - (if (not (string-match "=" cur)) - nil ; Grace - (setq key (gnus-url-unhex-string (substring cur 0 (match-beginning 0))) - val (gnus-url-unhex-string (substring cur (match-end 0) nil) t)) - (if downcase - (setq key (downcase key))) - (setq cur (assoc key retval)) - (if cur - (setcdr cur (cons val (cdr cur))) - (setq retval (cons (list key val) retval))))) - retval)) - -(defun gnus-url-mailto (url) - ;; Send mail to someone - (when (string-match "mailto:/*\\(.*\\)" url) - (setq url (substring url (match-beginning 1) nil))) - (let (to args subject func) - (setq args (gnus-url-parse-query-string - (if (string-match "^\\?" url) - (substring url 1) - (if (string-match "^\\([^?]+\\)\\?\\(.*\\)" url) - (concat "to=" (match-string 1 url) "&" - (match-string 2 url)) - (concat "to=" url))) - t) - subject (cdr-safe (assoc "subject" args))) - (gnus-msg-mail) - (while args - (setq func (intern-soft (concat "message-goto-" (downcase (caar args))))) - (if (fboundp func) - (funcall func) - (message-position-on-field (caar args))) - (insert (gnus-replace-in-string - (mapconcat 'identity (reverse (cdar args)) ", ") - "\r\n" "\n" t)) - (setq args (cdr args))) - (if subject - (message-goto-body) - (message-goto-subject)))) - -(defun gnus-button-embedded-url (address) - "Activate ADDRESS with `browse-url'." - (browse-url (gnus-strip-whitespace address))) - -;;; Next/prev buttons in the article buffer. - -(defvar gnus-next-page-line-format "%{%(Next page...%)%}\n") -(defvar gnus-prev-page-line-format "%{%(Previous page...%)%}\n") - -(defvar gnus-prev-page-map - (let ((map (make-sparse-keymap))) - (unless (>= emacs-major-version 21) - ;; XEmacs doesn't care. - (set-keymap-parent map gnus-article-mode-map)) - (define-key map gnus-mouse-2 'gnus-button-prev-page) - (define-key map "\r" 'gnus-button-prev-page) - map)) - -(defvar gnus-next-page-map - (let ((map (make-sparse-keymap))) - (unless (>= emacs-major-version 21) - ;; XEmacs doesn't care. - (set-keymap-parent map gnus-article-mode-map)) - (define-key map gnus-mouse-2 'gnus-button-next-page) - (define-key map "\r" 'gnus-button-next-page) - map)) - -(defun gnus-insert-prev-page-button () - (let ((b (point)) - (inhibit-read-only t)) - (gnus-eval-format - gnus-prev-page-line-format nil - `(,@(gnus-local-map-property gnus-prev-page-map) - gnus-prev t - gnus-callback gnus-article-button-prev-page - article-type annotation)) - (widget-convert-button - 'link b (if (bolp) - ;; Exclude a newline. - (1- (point)) - (point)) - :action 'gnus-button-prev-page - :button-keymap gnus-prev-page-map))) - -(defun gnus-button-next-page (&optional args more-args) - "Go to the next page." - (interactive) - (let ((win (selected-window))) - (select-window (gnus-get-buffer-window gnus-article-buffer t)) - (gnus-article-next-page) - (select-window win))) - -(defun gnus-button-prev-page (&optional args more-args) - "Go to the prev page." - (interactive) - (let ((win (selected-window))) - (select-window (gnus-get-buffer-window gnus-article-buffer t)) - (gnus-article-prev-page) - (select-window win))) - -(defun gnus-insert-next-page-button () - (let ((b (point)) - (inhibit-read-only t)) - (gnus-eval-format gnus-next-page-line-format nil - `(,@(gnus-local-map-property gnus-next-page-map) - gnus-next t - gnus-callback gnus-article-button-next-page - article-type annotation)) - (widget-convert-button - 'link b (if (bolp) - ;; Exclude a newline. - (1- (point)) - (point)) - :action 'gnus-button-next-page - :button-keymap gnus-next-page-map))) - -(defun gnus-article-button-next-page (arg) - "Go to the next page." - (interactive "P") - (let ((win (selected-window))) - (select-window (gnus-get-buffer-window gnus-article-buffer t)) - (gnus-article-next-page) - (select-window win))) - -(defun gnus-article-button-prev-page (arg) - "Go to the prev page." - (interactive "P") - (let ((win (selected-window))) - (select-window (gnus-get-buffer-window gnus-article-buffer t)) - (gnus-article-prev-page) - (select-window win))) - -(defvar gnus-decode-header-methods - '(mail-decode-encoded-word-region) - "List of methods used to decode headers. - -This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item -is FUNCTION, FUNCTION will be applied to all newsgroups. If item is a -\(REGEXP . FUNCTION), FUNCTION will be only apply to the newsgroups -whose names match REGEXP. - -For example: -\((\"chinese\" . gnus-decode-encoded-word-region-by-guess) - mail-decode-encoded-word-region - (\"chinese\" . rfc1843-decode-region)) -") - -(defvar gnus-decode-header-methods-cache nil) - -(defun gnus-multi-decode-header (start end) - "Apply the functions from `gnus-encoded-word-methods' that match." - (unless (and gnus-decode-header-methods-cache - (eq gnus-newsgroup-name - (car gnus-decode-header-methods-cache))) - (setq gnus-decode-header-methods-cache (list gnus-newsgroup-name)) - (mapcar (lambda (x) - (if (symbolp x) - (nconc gnus-decode-header-methods-cache (list x)) - (if (and gnus-newsgroup-name - (string-match (car x) gnus-newsgroup-name)) - (nconc gnus-decode-header-methods-cache - (list (cdr x)))))) - gnus-decode-header-methods)) - (let ((xlist gnus-decode-header-methods-cache)) - (pop xlist) - (save-restriction - (narrow-to-region start end) - (while xlist - (funcall (pop xlist) (point-min) (point-max)))))) - -;;; -;;; Treatment top-level handling. -;;; - -(defun gnus-treat-article (condition &optional part-number total-parts type) - (let ((length (- (point-max) (point-min))) - (alist gnus-treatment-function-alist) - (article-goto-body-goes-to-point-min-p t) - (treated-type - (or (not type) - (catch 'found - (let ((list gnus-article-treat-types)) - (while list - (when (string-match (pop list) type) - (throw 'found t))))))) - (highlightp (gnus-visual-p 'article-highlight 'highlight)) - val elem) - (gnus-run-hooks 'gnus-part-display-hook) - (dolist (elem alist) - (setq val - (save-excursion - (when (gnus-buffer-live-p gnus-summary-buffer) - (set-buffer gnus-summary-buffer)) - (symbol-value (car elem)))) - (when (and (or (consp val) - treated-type) - (gnus-treat-predicate val) - (or (not (get (car elem) 'highlight)) - highlightp)) - (save-restriction - (funcall (cadr elem))))))) - -;; Dynamic variables. -(eval-when-compile - (defvar part-number) - (defvar total-parts) - (defvar type) - (defvar condition) - (defvar length)) - -(defun gnus-treat-predicate (val) - (cond - ((null val) - nil) - (condition - (eq condition val)) - ((and (listp val) - (stringp (car val))) - (apply 'gnus-or (mapcar `(lambda (s) - (string-match s ,(or gnus-newsgroup-name ""))) - val))) - ((listp val) - (let ((pred (pop val))) - (cond - ((eq pred 'or) - (apply 'gnus-or (mapcar 'gnus-treat-predicate val))) - ((eq pred 'and) - (apply 'gnus-and (mapcar 'gnus-treat-predicate val))) - ((eq pred 'not) - (not (gnus-treat-predicate (car val)))) - ((eq pred 'typep) - (equal (car val) type)) - (t - (error "%S is not a valid predicate" pred))))) - ((eq val t) - t) - ((eq val 'head) - nil) - ((eq val 'last) - (eq part-number total-parts)) - ((numberp val) - (< length val)) - (t - (error "%S is not a valid value" val)))) - -(defun gnus-article-encrypt-body (protocol &optional n) - "Encrypt the article body." - (interactive - (list - (or gnus-article-encrypt-protocol - (completing-read "Encrypt protocol: " - gnus-article-encrypt-protocol-alist - nil t)) - current-prefix-arg)) - (let ((func (cdr (assoc protocol gnus-article-encrypt-protocol-alist)))) - (unless func - (error "Can't find the encrypt protocol %s" protocol)) - (if (member gnus-newsgroup-name '("nndraft:delayed" - "nndraft:drafts" - "nndraft:queue")) - (error "Can't encrypt the article in group %s" - gnus-newsgroup-name)) - (gnus-summary-iterate n - (save-excursion - (set-buffer gnus-summary-buffer) - (let ((mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets) - (summary-buffer gnus-summary-buffer) - references point) - (gnus-set-global-variables) - (when (gnus-group-read-only-p) - (error "The current newsgroup does not support article encrypt")) - (gnus-summary-show-article t) - (setq references - (or (mail-header-references gnus-current-headers) "")) - (set-buffer gnus-article-buffer) - (let* ((inhibit-read-only t) - (headers - (mapcar (lambda (field) - (and (save-restriction - (message-narrow-to-head) - (goto-char (point-min)) - (search-forward field nil t)) - (prog2 - (message-narrow-to-field) - (buffer-string) - (delete-region (point-min) (point-max)) - (widen)))) - '("Content-Type:" "Content-Transfer-Encoding:" - "Content-Disposition:")))) - (message-narrow-to-head) - (message-remove-header "MIME-Version") - (goto-char (point-max)) - (setq point (point)) - (insert (apply 'concat headers)) - (widen) - (narrow-to-region point (point-max)) - (let ((message-options message-options)) - (message-options-set 'message-sender user-mail-address) - (message-options-set 'message-recipients user-mail-address) - (message-options-set 'message-sign-encrypt 'not) - (funcall func)) - (goto-char (point-min)) - (insert "MIME-Version: 1.0\n") - (widen) - (gnus-summary-edit-article-done - references nil summary-buffer t)) - (when gnus-keep-backlog - (gnus-backlog-remove-article - (car gnus-article-current) (cdr gnus-article-current))) - (save-excursion - (when (get-buffer gnus-original-article-buffer) - (set-buffer gnus-original-article-buffer) - (setq gnus-original-article nil))) - (when gnus-use-cache - (gnus-cache-update-article - (car gnus-article-current) (cdr gnus-article-current)))))))) - -(defvar gnus-mime-security-button-line-format "%{%([[%t:%i]%D]%)%}\n" - "The following specs can be used: -%t The security MIME type -%i Additional info -%d Details -%D Details if button is pressed") - -(defvar gnus-mime-security-button-end-line-format "%{%([[End of %t]%D]%)%}\n" - "The following specs can be used: -%t The security MIME type -%i Additional info -%d Details -%D Details if button is pressed") - -(defvar gnus-mime-security-button-line-format-alist - '((?t gnus-tmp-type ?s) - (?i gnus-tmp-info ?s) - (?d gnus-tmp-details ?s) - (?D gnus-tmp-pressed-details ?s))) - -(defvar gnus-mime-security-button-map - (let ((map (make-sparse-keymap))) - (unless (>= (string-to-number emacs-version) 21) - (set-keymap-parent map gnus-article-mode-map)) - (define-key map gnus-mouse-2 'gnus-article-push-button) - (define-key map "\r" 'gnus-article-press-button) - map)) - -(defvar gnus-mime-security-details-buffer nil) - -(defvar gnus-mime-security-button-pressed nil) - -(defvar gnus-mime-security-show-details-inline t - "If non-nil, show details in the article buffer.") - -(defun gnus-mime-security-verify-or-decrypt (handle) - (mm-remove-parts (cdr handle)) - (let ((region (mm-handle-multipart-ctl-parameter handle 'gnus-region)) - point (inhibit-read-only t)) - (if region - (goto-char (car region))) - (save-restriction - (narrow-to-region (point) (point)) - (with-current-buffer (mm-handle-multipart-original-buffer handle) - (let* ((mm-verify-option 'known) - (mm-decrypt-option 'known) - (nparts (mm-possibly-verify-or-decrypt (cdr handle) handle))) - (unless (eq nparts (cdr handle)) - (mm-destroy-parts (cdr handle)) - (setcdr handle nparts)))) - (setq point (point)) - (gnus-mime-display-security handle) - (goto-char (point-max))) - (when region - (delete-region (point) (cdr region)) - (set-marker (car region) nil) - (set-marker (cdr region) nil)) - (goto-char point))) - -(defun gnus-mime-security-show-details (handle) - (let ((details (mm-handle-multipart-ctl-parameter handle 'gnus-details))) - (if (not details) - (gnus-message 5 "No details.") - (if gnus-mime-security-show-details-inline - (let ((gnus-mime-security-button-pressed - (not (get-text-property (point) 'gnus-mime-details))) - (gnus-mime-security-button-line-format - (get-text-property (point) 'gnus-line-format)) - (inhibit-read-only t)) - (forward-char -1) - (while (eq (get-text-property (point) 'gnus-line-format) - gnus-mime-security-button-line-format) - (forward-char -1)) - (forward-char) - (save-restriction - (narrow-to-region (point) (point)) - (gnus-insert-mime-security-button handle)) - (delete-region (point) - (or (text-property-not-all - (point) (point-max) - 'gnus-line-format - gnus-mime-security-button-line-format) - (point-max)))) - ;; Not inlined. - (if (gnus-buffer-live-p gnus-mime-security-details-buffer) - (with-current-buffer gnus-mime-security-details-buffer - (erase-buffer) - t) - (setq gnus-mime-security-details-buffer - (gnus-get-buffer-create "*MIME Security Details*"))) - (with-current-buffer gnus-mime-security-details-buffer - (insert details) - (goto-char (point-min))) - (pop-to-buffer gnus-mime-security-details-buffer))))) - -(defun gnus-mime-security-press-button (handle) - (save-excursion - (if (mm-handle-multipart-ctl-parameter handle 'gnus-info) - (gnus-mime-security-show-details handle) - (gnus-mime-security-verify-or-decrypt handle)))) - -(defun gnus-insert-mime-security-button (handle &optional displayed) - (let* ((protocol (mm-handle-multipart-ctl-parameter handle 'protocol)) - (gnus-tmp-type - (concat - (or (nth 2 (assoc protocol mm-verify-function-alist)) - (nth 2 (assoc protocol mm-decrypt-function-alist)) - "Unknown") - (if (equal (car handle) "multipart/signed") - " Signed" " Encrypted") - " Part")) - (gnus-tmp-info - (or (mm-handle-multipart-ctl-parameter handle 'gnus-info) - "Undecided")) - (gnus-tmp-details - (mm-handle-multipart-ctl-parameter handle 'gnus-details)) - gnus-tmp-pressed-details - b e) - (setq gnus-tmp-details - (if gnus-tmp-details - (concat "\n" gnus-tmp-details) - "")) - (setq gnus-tmp-pressed-details - (if gnus-mime-security-button-pressed gnus-tmp-details "")) - (unless (bolp) - (insert "\n")) - (setq b (point)) - (gnus-eval-format - gnus-mime-security-button-line-format - gnus-mime-security-button-line-format-alist - `(,@(gnus-local-map-property gnus-mime-security-button-map) - gnus-callback gnus-mime-security-press-button - gnus-line-format ,gnus-mime-security-button-line-format - gnus-mime-details ,gnus-mime-security-button-pressed - article-type annotation - gnus-data ,handle)) - (setq e (if (bolp) - ;; Exclude a newline. - (1- (point)) - (point))) - (widget-convert-button - 'link b e - :mime-handle handle - :action 'gnus-widget-press-button - :button-keymap gnus-mime-security-button-map - :help-echo - (lambda (widget/window &optional overlay pos) - ;; Needed to properly clear the message due to a bug in - ;; wid-edit (XEmacs only). - (when (boundp 'help-echo-owns-message) - (setq help-echo-owns-message t)) - (format - "%S: show detail" - (aref gnus-mouse-2 0)))))) - -(defun gnus-mime-display-security (handle) - (save-restriction - (narrow-to-region (point) (point)) - (unless (gnus-unbuttonized-mime-type-p (car handle)) - (gnus-insert-mime-security-button handle)) - (gnus-mime-display-mixed (cdr handle)) - (unless (bolp) - (insert "\n")) - (unless (gnus-unbuttonized-mime-type-p (car handle)) - (let ((gnus-mime-security-button-line-format - gnus-mime-security-button-end-line-format)) - (gnus-insert-mime-security-button handle))) - (mm-set-handle-multipart-parameter - handle 'gnus-region - (cons (set-marker (make-marker) (point-min)) - (set-marker (make-marker) (point-max)))))) - -(gnus-ems-redefine) - -(provide 'gnus-art) - -(run-hooks 'gnus-art-load-hook) - -;;; arch-tag: 2654516f-6279-48f9-a83b-05c1fa450c33 -;;; gnus-art.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-async.el b/xemacs-packages/gnus/lisp/gnus-async.el deleted file mode 100644 index bec27864..00000000 --- a/xemacs-packages/gnus/lisp/gnus-async.el +++ /dev/null @@ -1,383 +0,0 @@ -;;; gnus-async.el --- asynchronous support for Gnus - -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) -(require 'gnus-sum) -(require 'nntp) - -(eval-when-compile - (when (featurep 'xemacs) - (require 'timer-funcs))) - -(defgroup gnus-asynchronous nil - "Support for asynchronous operations." - :group 'gnus) - -(defcustom gnus-use-article-prefetch 30 - "*If non-nil, prefetch articles in groups that allow this. -If a number, prefetch only that many articles forward; -if t, prefetch as many articles as possible." - :group 'gnus-asynchronous - :type '(choice (const :tag "off" nil) - (const :tag "all" t) - (integer :tag "some" 0))) - -(defcustom gnus-asynchronous nil - "*If nil, inhibit all Gnus asynchronicity. -If non-nil, let the other asynch variables be heeded." - :group 'gnus-asynchronous - :type 'boolean) - -(defcustom gnus-prefetched-article-deletion-strategy '(read exit) - "List of symbols that say when to remove articles from the prefetch buffer. -Possible values in this list are `read', which means that -articles are removed as they are read, and `exit', which means -that all articles belonging to a group are removed on exit -from that group." - :group 'gnus-asynchronous - :type '(set (const read) (const exit))) - -(defcustom gnus-use-header-prefetch nil - "*If non-nil, prefetch the headers to the next group." - :group 'gnus-asynchronous - :type 'boolean) - -(defcustom gnus-async-prefetch-article-p 'gnus-async-unread-p - "Function called to say whether an article should be prefetched or not. -The function is called with one parameter -- the article data. -It should return non-nil if the article is to be prefetched." - :group 'gnus-asynchronous - :type 'function) - -;;; Internal variables. - -(defvar gnus-async-prefetch-article-buffer " *Async Prefetch Article*") -(defvar gnus-async-article-alist nil) -(defvar gnus-async-article-semaphore '(nil)) -(defvar gnus-async-fetch-list nil) -(defvar gnus-async-hashtb nil) -(defvar gnus-async-current-prefetch-group nil) -(defvar gnus-async-current-prefetch-article nil) -(defvar gnus-async-timer nil) - -(defvar gnus-async-prefetch-headers-buffer " *Async Prefetch Headers*") -(defvar gnus-async-header-prefetched nil) - -;;; Utility functions. - -(defun gnus-group-asynchronous-p (group) - "Say whether GROUP is fetched from a server that supports asynchronicity." - (gnus-asynchronous-p (gnus-find-method-for-group group))) - -;;; Somewhat bogus semaphores. - -(defun gnus-async-get-semaphore (semaphore) - "Wait until SEMAPHORE is released." - (while (/= (length (nconc (symbol-value semaphore) (list nil))) 2) - (sleep-for 1))) - -(defun gnus-async-release-semaphore (semaphore) - "Release SEMAPHORE." - (setcdr (symbol-value semaphore) nil)) - -(defmacro gnus-async-with-semaphore (&rest forms) - `(unwind-protect - (progn - (gnus-async-get-semaphore 'gnus-async-article-semaphore) - ,@forms) - (gnus-async-release-semaphore 'gnus-async-article-semaphore))) - -(put 'gnus-async-with-semaphore 'lisp-indent-function 0) -(put 'gnus-async-with-semaphore 'edebug-form-spec '(body)) - -;;; -;;; Article prefetch -;;; - -(gnus-add-shutdown 'gnus-async-close 'gnus) -(defun gnus-async-close () - (gnus-kill-buffer gnus-async-prefetch-article-buffer) - (gnus-kill-buffer gnus-async-prefetch-headers-buffer) - (setq gnus-async-hashtb nil - gnus-async-article-alist nil - gnus-async-header-prefetched nil)) - -(defun gnus-async-set-buffer () - (nnheader-set-temp-buffer gnus-async-prefetch-article-buffer t) - (unless gnus-async-hashtb - (setq gnus-async-hashtb (gnus-make-hashtable 1023)))) - -(defun gnus-async-halt-prefetch () - "Stop prefetching." - (setq gnus-async-fetch-list nil)) - -(defun gnus-async-prefetch-next (group article summary) - "Possibly prefetch several articles starting with the article after ARTICLE." - (when (and (gnus-buffer-live-p summary) - gnus-asynchronous - (gnus-group-asynchronous-p group)) - (save-excursion - (set-buffer gnus-summary-buffer) - (let ((next (caadr (gnus-data-find-list article)))) - (when next - (if (not (fboundp 'run-with-idle-timer)) - ;; This is either an older Emacs or XEmacs, so we - ;; do this, which leads to slightly slower article - ;; buffer display. - (gnus-async-prefetch-article group next summary) - (when gnus-async-timer - (ignore-errors - (nnheader-cancel-timer 'gnus-async-timer))) - (setq gnus-async-timer - (run-with-idle-timer - 0.1 nil 'gnus-async-prefetch-article - group next summary)))))))) - -(defun gnus-async-prefetch-article (group article summary &optional next) - "Possibly prefetch several articles starting with ARTICLE." - (if (not (gnus-buffer-live-p summary)) - (gnus-async-with-semaphore - (setq gnus-async-fetch-list nil)) - (when (and gnus-asynchronous - (gnus-alive-p)) - (when next - (gnus-async-with-semaphore - (pop gnus-async-fetch-list))) - (let ((do-fetch next) - (do-message t)) ;(eq major-mode 'gnus-summary-mode))) - (when (and (gnus-group-asynchronous-p group) - (gnus-buffer-live-p summary) - (or (not next) - gnus-async-fetch-list)) - (gnus-async-with-semaphore - (unless next - (setq do-fetch (not gnus-async-fetch-list)) - ;; Nix out any outstanding requests. - (setq gnus-async-fetch-list nil) - ;; Fill in the new list. - (let ((n gnus-use-article-prefetch) - (data (gnus-data-find-list article)) - d) - (while (and (setq d (pop data)) - (if (numberp n) - (natnump (decf n)) - n)) - (unless (or (gnus-async-prefetched-article-entry - group (setq article (gnus-data-number d))) - (not (natnump article)) - (not (funcall gnus-async-prefetch-article-p d))) - ;; Not already fetched -- so we add it to the list. - (push article gnus-async-fetch-list))) - (setq gnus-async-fetch-list - (nreverse gnus-async-fetch-list)))) - - (when do-fetch - (setq article (car gnus-async-fetch-list)))) - - (when (and do-fetch article) - ;; We want to fetch some more articles. - (save-excursion - (set-buffer summary) - (let (mark) - (gnus-async-set-buffer) - (goto-char (point-max)) - (setq mark (point-marker)) - (let ((nnheader-callback-function - (gnus-make-async-article-function - group article mark summary next)) - (nntp-server-buffer - (get-buffer gnus-async-prefetch-article-buffer))) - (when do-message - (gnus-message 9 "Prefetching article %d in group %s" - article group)) - (setq gnus-async-current-prefetch-group group) - (setq gnus-async-current-prefetch-article article) - (gnus-request-article article group)))))))))) - -(defun gnus-make-async-article-function (group article mark summary next) - "Return a callback function." - `(lambda (arg) - (gnus-async-article-callback arg ,group ,article ,mark ,summary ,next))) - -(defun gnus-async-article-callback (arg group article mark summary next) - "Function called when an async article is done being fetched." - (save-excursion - (setq gnus-async-current-prefetch-article nil) - (when arg - (gnus-async-set-buffer) - (gnus-async-with-semaphore - (setq - gnus-async-article-alist - (cons (list (intern (format "%s-%d" group article) - gnus-async-hashtb) - mark (set-marker (make-marker) (point-max)) - group article) - gnus-async-article-alist)))) - (if (not (gnus-buffer-live-p summary)) - (gnus-async-with-semaphore - (setq gnus-async-fetch-list nil)) - (gnus-async-prefetch-article group next summary t)))) - -(defun gnus-async-unread-p (data) - "Return non-nil if DATA represents an unread article." - (gnus-data-unread-p data)) - -(defun gnus-async-request-fetched-article (group article buffer) - "See whether we have ARTICLE from GROUP and put it in BUFFER." - (when (numberp article) - (when (and (equal group gnus-async-current-prefetch-group) - (eq article gnus-async-current-prefetch-article)) - (gnus-async-wait-for-article article)) - (let ((entry (gnus-async-prefetched-article-entry group article))) - (when entry - (save-excursion - (gnus-async-set-buffer) - (copy-to-buffer buffer (cadr entry) (caddr entry)) - ;; Remove the read article from the prefetch buffer. - (when (memq 'read gnus-prefetched-article-deletion-strategy) - (gnus-async-delete-prefetched-entry entry)) - t))))) - -(defun gnus-async-wait-for-article (article) - "Wait until ARTICLE is no longer the currently-being-fetched article." - (save-excursion - (gnus-async-set-buffer) - (let ((proc (nntp-find-connection (current-buffer))) - (nntp-server-buffer (current-buffer)) - (nntp-have-messaged nil) - (tries 0)) - (condition-case nil - ;; FIXME: we could stop waiting after some - ;; timeout, but this is the wrong place to do it. - ;; rather than checking time-spent-waiting, we - ;; should check time-since-last-output, which - ;; needs to be done in nntp.el. - (while (eq article gnus-async-current-prefetch-article) - (incf tries) - (when (nntp-accept-process-output proc) - (setq tries 0)) - (when (and (not nntp-have-messaged) - (= tries 3)) - (gnus-message 5 "Waiting for async article...") - (setq nntp-have-messaged t))) - (quit - ;; if the user interrupted on a slow/hung connection, - ;; do something friendly. - (when (> tries 3) - (setq gnus-async-current-prefetch-article nil)) - (signal 'quit nil))) - (when nntp-have-messaged - (gnus-message 5 ""))))) - -(defun gnus-async-delete-prefetched-entry (entry) - "Delete ENTRY from buffer and alist." - (ignore-errors - (delete-region (cadr entry) (caddr entry)) - (set-marker (cadr entry) nil) - (set-marker (caddr entry) nil)) - (gnus-async-with-semaphore - (setq gnus-async-article-alist - (delq entry gnus-async-article-alist)))) - -(defun gnus-async-prefetch-remove-group (group) - "Remove all articles belonging to GROUP from the prefetch buffer." - (when (and (gnus-group-asynchronous-p group) - (memq 'exit gnus-prefetched-article-deletion-strategy)) - (let ((alist gnus-async-article-alist)) - (save-excursion - (gnus-async-set-buffer) - (while alist - (when (equal group (nth 3 (car alist))) - (gnus-async-delete-prefetched-entry (car alist))) - (pop alist)))))) - -(defun gnus-async-prefetched-article-entry (group article) - "Return the entry for ARTICLE in GROUP if it has been prefetched." - (let ((entry (save-excursion - (gnus-async-set-buffer) - (assq (intern (format "%s-%d" group article) - gnus-async-hashtb) - gnus-async-article-alist)))) - ;; Perhaps something has emptied the buffer? - (if (and entry - (= (cadr entry) (caddr entry))) - (progn - (ignore-errors - (set-marker (cadr entry) nil) - (set-marker (caddr entry) nil)) - (setq gnus-async-article-alist - (delq entry gnus-async-article-alist)) - nil) - entry))) - -;;; -;;; Header prefetch -;;; - -(defun gnus-async-prefetch-headers (group) - "Prefetch the headers for group GROUP." - (save-excursion - (let (unread) - (when (and gnus-use-header-prefetch - gnus-asynchronous - (gnus-group-asynchronous-p group) - (listp gnus-async-header-prefetched) - (setq unread (gnus-list-of-unread-articles group))) - ;; Mark that a fetch is in progress. - (setq gnus-async-header-prefetched t) - (nnheader-set-temp-buffer gnus-async-prefetch-headers-buffer t) - (erase-buffer) - (let ((nntp-server-buffer (current-buffer)) - (nnheader-callback-function - `(lambda (arg) - (setq gnus-async-header-prefetched - ,(cons group unread))))) - (gnus-retrieve-headers unread group gnus-fetch-old-headers)))))) - -(defun gnus-async-retrieve-fetched-headers (articles group) - "See whether we have prefetched headers." - (when (and gnus-use-header-prefetch - (gnus-group-asynchronous-p group) - (listp gnus-async-header-prefetched) - (equal group (car gnus-async-header-prefetched)) - (equal articles (cdr gnus-async-header-prefetched))) - (save-excursion - (nnheader-set-temp-buffer gnus-async-prefetch-headers-buffer t) - (nntp-decode-text) - (copy-to-buffer nntp-server-buffer (point-min) (point-max)) - (erase-buffer) - (setq gnus-async-header-prefetched nil) - t))) - -(provide 'gnus-async) - -;;; arch-tag: fee61de5-3ea2-4de6-8578-2f90ce89391d -;;; gnus-async.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-audio.el b/xemacs-packages/gnus/lisp/gnus-audio.el deleted file mode 100644 index 95c7d8d3..00000000 --- a/xemacs-packages/gnus/lisp/gnus-audio.el +++ /dev/null @@ -1,152 +0,0 @@ -;;; gnus-audio.el --- Sound effects for Gnus - -;; Copyright (C) 1996, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Steven L. Baur -;; Keywords: news, mail, multimedia - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; This file provides access to sound effects in Gnus. -;; This file is partially stripped to support earcons.el. - -;;; Code: - -(require 'nnheader) - -(defgroup gnus-audio nil - "Playing sound in Gnus." - :version "21.1" - :group 'gnus-visual - :group 'multimedia) - -(defvar gnus-audio-inline-sound - (or (if (fboundp 'device-sound-enabled-p) - (device-sound-enabled-p)) ; XEmacs - (fboundp 'play-sound)) ; Emacs 21 - "Non-nil means try to play sounds without using an external program.") - -(defcustom gnus-audio-directory (nnheader-find-etc-directory "sounds") - "The directory containing the Sound Files." - :type '(choice directory (const nil)) - :group 'gnus-audio) - -(defcustom gnus-audio-au-player (executable-find "play") - "Executable program for playing sun AU format sound files." - :group 'gnus-audio - :type '(choice file (const nil))) - -(defcustom gnus-audio-wav-player (executable-find "play") - "Executable program for playing WAV files." - :group 'gnus-audio - :type '(choice file (const nil))) - -;;; The following isn't implemented yet. Wait for Millennium Gnus. -;;(defvar gnus-audio-effects-enabled t -;; "When t, Gnus will use sound effects.") -;;(defvar gnus-audio-enable-hooks nil -;; "Functions run when enabling sound effects.") -;;(defvar gnus-audio-disable-hooks nil -;; "Functions run when disabling sound effects.") -;;(defvar gnus-audio-theme-song nil -;; "Theme song for Gnus.") -;;(defvar gnus-audio-enter-group nil -;; "Sound effect played when selecting a group.") -;;(defvar gnus-audio-exit-group nil -;; "Sound effect played when exiting a group.") -;;(defvar gnus-audio-score-group nil -;; "Sound effect played when scoring a group.") -;;(defvar gnus-audio-busy-sound nil -;; "Sound effect played when going into a ... sequence.") - - -;;;###autoload -;;(defun gnus-audio-enable-sound () -;; "Enable Sound Effects for Gnus." -;; (interactive) -;; (setq gnus-audio-effects-enabled t) -;; (gnus-run-hooks gnus-audio-enable-hooks)) - -;;;###autoload - ;(defun gnus-audio-disable-sound () -;; "Disable Sound Effects for Gnus." -;; (interactive) -;; (setq gnus-audio-effects-enabled nil) -;; (gnus-run-hooks gnus-audio-disable-hooks)) - -;;;###autoload -(defun gnus-audio-play (file) - "Play a sound FILE through the speaker." - (interactive "fSound file name: ") - (let ((sound-file (if (file-exists-p file) - file - (expand-file-name file gnus-audio-directory)))) - (when (file-exists-p sound-file) - (cond ((and gnus-audio-inline-sound - (condition-case nil - ;; Even if we have audio, we may fail with the - ;; wrong sort of sound file. - (progn (play-sound-file sound-file) - t) - (error nil)))) - ;; If we don't have built-in sound, or playing it failed, - ;; try with external program. - ((equal "wav" (file-name-extension sound-file)) - (call-process gnus-audio-wav-player - sound-file - 0 - nil - sound-file)) - ((equal "au" (file-name-extension sound-file)) - (call-process gnus-audio-au-player - sound-file - 0 - nil - sound-file)))))) - - -;;; The following isn't implemented yet, wait for Red Gnus -;;(defun gnus-audio-startrek-sounds () -;; "Enable sounds from Star Trek the original series." -;; (interactive) -;; (setq gnus-audio-busy-sound "working.au") -;; (setq gnus-audio-enter-group "bulkhead_door.au") -;; (setq gnus-audio-exit-group "bulkhead_door.au") -;; (setq gnus-audio-score-group "ST_laser.au") -;; (setq gnus-audio-theme-song "startrek.au") -;; (add-hook 'gnus-select-group-hook 'gnus-audio-startrek-select-group) -;; (add-hook 'gnus-exit-group-hook 'gnus-audio-startrek-exit-group)) -;;;*** - -(defvar gnus-startup-jingle "Tuxedomoon.Jingle4.au" - "Name of the Gnus startup jingle file.") - -(defun gnus-play-jingle () - "Play the Gnus startup jingle, unless that's inhibited." - (interactive) - (gnus-audio-play gnus-startup-jingle)) - -(provide 'gnus-audio) - -(run-hooks 'gnus-audio-load-hook) - -;;; arch-tag: 6f129e78-3416-4fc9-973f-6cf5ac8d654b -;;; gnus-audio.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-bcklg.el b/xemacs-packages/gnus/lisp/gnus-bcklg.el deleted file mode 100644 index 2b39cbef..00000000 --- a/xemacs-packages/gnus/lisp/gnus-bcklg.el +++ /dev/null @@ -1,165 +0,0 @@ -;;; gnus-bcklg.el --- backlog functions for Gnus - -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) - -;;; -;;; Buffering of read articles. -;;; - -(defvar gnus-backlog-buffer " *Gnus Backlog*") -(defvar gnus-backlog-articles nil) -(defvar gnus-backlog-hashtb nil) - -(defun gnus-backlog-buffer () - "Return the backlog buffer." - (or (get-buffer gnus-backlog-buffer) - (save-excursion - (set-buffer (gnus-get-buffer-create gnus-backlog-buffer)) - (buffer-disable-undo) - (setq buffer-read-only t) - (get-buffer gnus-backlog-buffer)))) - -(defun gnus-backlog-setup () - "Initialize backlog variables." - (unless gnus-backlog-hashtb - (setq gnus-backlog-hashtb (gnus-make-hashtable 1024)))) - -(gnus-add-shutdown 'gnus-backlog-shutdown 'gnus) - -(defun gnus-backlog-shutdown () - "Clear all backlog variables and buffers." - (interactive) - (when (get-buffer gnus-backlog-buffer) - (gnus-kill-buffer gnus-backlog-buffer)) - (setq gnus-backlog-hashtb nil - gnus-backlog-articles nil)) - -(defun gnus-backlog-enter-article (group number buffer) - (when (and (numberp number) - (not (string-match "^nnvirtual" group))) - (gnus-backlog-setup) - (let ((ident (intern (concat group ":" (int-to-string number)) - gnus-backlog-hashtb)) - b) - (if (memq ident gnus-backlog-articles) - () ; It's already kept. - ;; Remove the oldest article, if necessary. - (and (numberp gnus-keep-backlog) - (>= (length gnus-backlog-articles) gnus-keep-backlog) - (gnus-backlog-remove-oldest-article)) - (push ident gnus-backlog-articles) - ;; Insert the new article. - (save-excursion - (set-buffer (gnus-backlog-buffer)) - (let (buffer-read-only) - (goto-char (point-max)) - (unless (bolp) - (insert "\n")) - (setq b (point)) - (insert-buffer-substring buffer) - ;; Tag the beginning of the article with the ident. - (if (> (point-max) b) - (gnus-put-text-property b (1+ b) 'gnus-backlog ident) - (gnus-error 3 "Article %d is blank" number)))))))) - -(defun gnus-backlog-remove-oldest-article () - (save-excursion - (set-buffer (gnus-backlog-buffer)) - (goto-char (point-min)) - (if (zerop (buffer-size)) - () ; The buffer is empty. - (let ((ident (get-text-property (point) 'gnus-backlog)) - buffer-read-only) - ;; Remove the ident from the list of articles. - (when ident - (setq gnus-backlog-articles (delq ident gnus-backlog-articles))) - ;; Delete the article itself. - (delete-region - (point) (next-single-property-change - (1+ (point)) 'gnus-backlog nil (point-max))))))) - -(defun gnus-backlog-remove-article (group number) - "Remove article NUMBER in GROUP from the backlog." - (when (numberp number) - (gnus-backlog-setup) - (let ((ident (intern (concat group ":" (int-to-string number)) - gnus-backlog-hashtb)) - beg end) - (when (memq ident gnus-backlog-articles) - ;; It was in the backlog. - (save-excursion - (set-buffer (gnus-backlog-buffer)) - (let (buffer-read-only) - (when (setq beg (text-property-any - (point-min) (point-max) 'gnus-backlog - ident)) - ;; Find the end (i. e., the beginning of the next article). - (setq end - (next-single-property-change - (1+ beg) 'gnus-backlog (current-buffer) (point-max))) - (delete-region beg end) - ;; Return success. - t)) - (setq gnus-backlog-articles (delq ident gnus-backlog-articles))))))) - -(defun gnus-backlog-request-article (group number &optional buffer) - (when (and (numberp number) - (not (string-match "^nnvirtual" group))) - (gnus-backlog-setup) - (let ((ident (intern (concat group ":" (int-to-string number)) - gnus-backlog-hashtb)) - beg end) - (when (memq ident gnus-backlog-articles) - ;; It was in the backlog. - (save-excursion - (set-buffer (gnus-backlog-buffer)) - (if (not (setq beg (text-property-any - (point-min) (point-max) 'gnus-backlog - ident))) - ;; It wasn't in the backlog after all. - (ignore - (setq gnus-backlog-articles (delq ident gnus-backlog-articles))) - ;; Find the end (i. e., the beginning of the next article). - (setq end - (next-single-property-change - (1+ beg) 'gnus-backlog (current-buffer) (point-max))))) - (save-excursion - (and buffer (set-buffer buffer)) - (let ((buffer-read-only nil)) - (erase-buffer) - (insert-buffer-substring gnus-backlog-buffer beg end))) - t)))) - -(provide 'gnus-bcklg) - -;;; arch-tag: 66259e56-505a-4bba-8a0d-3552c5b94e39 -;;; gnus-bcklg.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-cache.el b/xemacs-packages/gnus/lisp/gnus-cache.el deleted file mode 100644 index 98e4b4d2..00000000 --- a/xemacs-packages/gnus/lisp/gnus-cache.el +++ /dev/null @@ -1,781 +0,0 @@ -;;; gnus-cache.el --- cache interface for Gnus - -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) -(require 'gnus-int) -(require 'gnus-range) -(require 'gnus-start) -(eval-when-compile - (if (not (fboundp 'gnus-agent-load-alist)) - (defun gnus-agent-load-alist (group))) - (require 'gnus-sum)) - -(defcustom gnus-cache-active-file - (expand-file-name "active" gnus-cache-directory) - "*The cache active file." - :group 'gnus-cache - :type 'file) - -(defcustom gnus-cache-enter-articles '(ticked dormant) - "Classes of articles to enter into the cache." - :group 'gnus-cache - :type '(set (const ticked) (const dormant) (const unread) (const read))) - -(defcustom gnus-cache-remove-articles '(read) - "Classes of articles to remove from the cache." - :group 'gnus-cache - :type '(set (const ticked) (const dormant) (const unread) (const read))) - -(defcustom gnus-cacheable-groups nil - "*Groups that match this regexp will be cached. - -If you only want to cache your nntp groups, you could set this -variable to \"^nntp\". - -If a group matches both gnus-cacheable-groups and gnus-uncacheable-groups -it's not cached." - :group 'gnus-cache - :type '(choice (const :tag "off" nil) - regexp)) - -(defcustom gnus-uncacheable-groups nil - "*Groups that match this regexp will not be cached. - -If you want to avoid caching your nnml groups, you could set this -variable to \"^nnml\". - -If a group matches both gnus-cacheable-groups and gnus-uncacheable-groups -it's not cached." - :group 'gnus-cache - :type '(choice (const :tag "off" nil) - regexp)) - -(defvar gnus-cache-overview-coding-system 'raw-text - "Coding system used on Gnus cache files.") - -(defvar gnus-cache-coding-system 'raw-text - "Coding system used on Gnus cache files.") - - - -;;; Internal variables. - -(defvar gnus-cache-removable-articles nil) -(defvar gnus-cache-buffer nil) -(defvar gnus-cache-active-hashtb nil) -(defvar gnus-cache-active-altered nil) - -(eval-and-compile - (autoload 'nnml-generate-nov-databases-1 "nnml") - (autoload 'nnvirtual-find-group-art "nnvirtual")) - - - -;;; Functions called from Gnus. - -(defun gnus-cache-open () - "Initialize the cache." - (when (or (file-exists-p gnus-cache-directory) - (and gnus-use-cache - (not (eq gnus-use-cache 'passive)))) - (gnus-cache-read-active))) - -;; Complexities of byte-compiling make this kludge necessary. Eeek. -(ignore-errors - (gnus-add-shutdown 'gnus-cache-close 'gnus)) - -(defun gnus-cache-close () - "Shut down the cache." - (gnus-cache-write-active) - (gnus-cache-save-buffers) - (setq gnus-cache-active-hashtb nil)) - -(defun gnus-cache-save-buffers () - ;; save the overview buffer if it exists and has been modified - ;; delete empty cache subdirectories - (when gnus-cache-buffer - (let ((buffer (cdr gnus-cache-buffer)) - (overview-file (gnus-cache-file-name - (car gnus-cache-buffer) ".overview"))) - ;; write the overview only if it was modified - (when (and (buffer-live-p buffer) (buffer-modified-p buffer)) - (with-current-buffer buffer - (if (> (buffer-size) 0) - ;; Non-empty overview, write it to a file. - (let ((coding-system-for-write - gnus-cache-overview-coding-system)) - (gnus-write-buffer overview-file)) - ;; Empty overview file, remove it - (when (file-exists-p overview-file) - (delete-file overview-file)) - ;; If possible, remove group's cache subdirectory. - (condition-case nil - ;; FIXME: we can detect the error type and warn the user - ;; of any inconsistencies (articles w/o nov entries?). - ;; for now, just be conservative...delete only if safe -- sj - (delete-directory (file-name-directory overview-file)) - (error nil))))) - ;; Kill the buffer -- it's either unmodified or saved. - (gnus-kill-buffer buffer) - (setq gnus-cache-buffer nil)))) - -(defun gnus-cache-possibly-enter-article - (group article ticked dormant unread &optional force) - (when (and (or force (not (eq gnus-use-cache 'passive))) - (numberp article) - (> article 0)) ; This might be a dummy article. - (let ((number article) file headers) - ;; If this is a virtual group, we find the real group. - (when (gnus-virtual-group-p group) - (let ((result (nnvirtual-find-group-art - (gnus-group-real-name group) article))) - (setq group (car result) - number (cdr result)))) - (when (and number - (> number 0) ; Reffed article. - (or force - (and (gnus-cache-fully-p group) - (gnus-cache-member-of-class - gnus-cache-enter-articles ticked dormant unread))) - (not (file-exists-p (setq file (gnus-cache-file-name - group number))))) - ;; Possibly create the cache directory. - (gnus-make-directory (file-name-directory file)) - ;; Save the article in the cache. - (if (file-exists-p file) - t ; The article already is saved. - (save-excursion - (set-buffer nntp-server-buffer) - (require 'gnus-art) - (let ((gnus-use-cache nil) - (gnus-article-decode-hook nil)) - (gnus-request-article-this-buffer number group)) - (when (> (buffer-size) 0) - (let ((coding-system-for-write gnus-cache-coding-system)) - (gnus-write-buffer file)) - (nnheader-remove-body) - (setq headers (nnheader-parse-naked-head)) - (mail-header-set-number headers number) - (gnus-cache-change-buffer group) - (set-buffer (cdr gnus-cache-buffer)) - (goto-char (point-max)) - (forward-line -1) - (while (condition-case () - (when (not (bobp)) - (> (read (current-buffer)) number)) - (error - ;; The line was malformed, so we just remove it!! - (gnus-delete-line) - t)) - (forward-line -1)) - (if (bobp) - (if (not (eobp)) - (progn - (beginning-of-line) - (when (< (read (current-buffer)) number) - (forward-line 1))) - (beginning-of-line)) - (forward-line 1)) - (beginning-of-line) - (nnheader-insert-nov headers) - ;; Update the active info. - (set-buffer gnus-summary-buffer) - (gnus-cache-possibly-update-active group (cons number number)) - (setq gnus-newsgroup-cached - (gnus-add-to-sorted-list gnus-newsgroup-cached article)) - (gnus-summary-update-secondary-mark article)) - t)))))) - -(defun gnus-cache-enter-remove-article (article) - "Mark ARTICLE for later possible removal." - (when article - (push article gnus-cache-removable-articles))) - -(defun gnus-cache-possibly-remove-articles () - "Possibly remove some of the removable articles." - (if (not (gnus-virtual-group-p gnus-newsgroup-name)) - (gnus-cache-possibly-remove-articles-1) - (let ((arts gnus-cache-removable-articles) - ga) - (while arts - (when (setq ga (nnvirtual-find-group-art - (gnus-group-real-name gnus-newsgroup-name) (pop arts))) - (let ((gnus-cache-removable-articles (list (cdr ga))) - (gnus-newsgroup-name (car ga))) - (gnus-cache-possibly-remove-articles-1))))) - (setq gnus-cache-removable-articles nil))) - -(defun gnus-cache-possibly-remove-articles-1 () - "Possibly remove some of the removable articles." - (when (gnus-cache-fully-p gnus-newsgroup-name) - (let ((articles gnus-cache-removable-articles) - (cache-articles gnus-newsgroup-cached) - article) - (gnus-cache-change-buffer gnus-newsgroup-name) - (while articles - (when (memq (setq article (pop articles)) cache-articles) - ;; The article was in the cache, so we see whether we are - ;; supposed to remove it from the cache. - (gnus-cache-possibly-remove-article - article (memq article gnus-newsgroup-marked) - (memq article gnus-newsgroup-dormant) - (or (memq article gnus-newsgroup-unreads) - (memq article gnus-newsgroup-unselected)))))) - ;; The overview file might have been modified, save it - ;; safe because we're only called at group exit anyway. - (gnus-cache-save-buffers))) - -(defun gnus-cache-request-article (article group) - "Retrieve ARTICLE in GROUP from the cache." - (let ((file (gnus-cache-file-name group article)) - (buffer-read-only nil)) - (when (file-exists-p file) - (erase-buffer) - (gnus-kill-all-overlays) - (let ((coding-system-for-read gnus-cache-coding-system)) - (insert-file-contents file)) - t))) - -(defun gnus-cache-possibly-alter-active (group active) - "Alter the ACTIVE info for GROUP to reflect the articles in the cache." - (when gnus-cache-active-hashtb - (let ((cache-active (gnus-gethash group gnus-cache-active-hashtb))) - (when cache-active - (when (< (car cache-active) (car active)) - (setcar active (car cache-active))) - (when (> (cdr cache-active) (cdr active)) - (setcdr active (cdr cache-active))))))) - -(defun gnus-cache-retrieve-headers (articles group &optional fetch-old) - "Retrieve the headers for ARTICLES in GROUP." - (let ((cached - (setq gnus-newsgroup-cached (gnus-cache-articles-in-group group)))) - (if (not cached) - ;; No cached articles here, so we just retrieve them - ;; the normal way. - (let ((gnus-use-cache nil)) - (gnus-retrieve-headers articles group fetch-old)) - (let ((uncached-articles (gnus-sorted-difference articles cached)) - (cache-file (gnus-cache-file-name group ".overview")) - type) - ;; We first retrieve all the headers that we don't have in - ;; the cache. - (let ((gnus-use-cache nil)) - (when uncached-articles - (setq type (and articles - (gnus-retrieve-headers - uncached-articles group fetch-old))))) - (gnus-cache-save-buffers) - ;; Then we insert the cached headers. - (save-excursion - (cond - ((not (file-exists-p cache-file)) - ;; There are no cached headers. - type) - ((null type) - ;; There were no uncached headers (or retrieval was - ;; unsuccessful), so we use the cached headers exclusively. - (set-buffer nntp-server-buffer) - (erase-buffer) - (let ((coding-system-for-read - gnus-cache-overview-coding-system)) - (insert-file-contents cache-file)) - 'nov) - ((eq type 'nov) - ;; We have both cached and uncached NOV headers, so we - ;; braid them. - (gnus-cache-braid-nov group cached) - type) - (t - ;; We braid HEADs. - (gnus-cache-braid-heads group (gnus-sorted-intersection - cached articles)) - type))))))) - -(defun gnus-cache-enter-article (&optional n) - "Enter the next N articles into the cache. -If not given a prefix, use the process marked articles instead. -Returns the list of articles entered." - (interactive "P") - (let ((articles (gnus-summary-work-articles n)) - article out) - (while (setq article (pop articles)) - (gnus-summary-remove-process-mark article) - (if (natnump article) - (when (gnus-cache-possibly-enter-article - gnus-newsgroup-name article - nil nil nil t) - (setq gnus-newsgroup-undownloaded (delq article gnus-newsgroup-undownloaded)) - (push article out)) - (gnus-message 2 "Can't cache article %d" article)) - (gnus-summary-update-download-mark article) - (gnus-summary-update-secondary-mark article)) - (gnus-summary-next-subject 1) - (gnus-summary-position-point) - (nreverse out))) - -(defun gnus-cache-remove-article (&optional n) - "Remove the next N articles from the cache. -If not given a prefix, use the process marked articles instead. -Returns the list of articles removed." - (interactive "P") - (gnus-cache-change-buffer gnus-newsgroup-name) - (let ((articles (gnus-summary-work-articles n)) - article out) - (while articles - (setq article (pop articles)) - (gnus-summary-remove-process-mark article) - (when (gnus-cache-possibly-remove-article article nil nil nil t) - (when gnus-newsgroup-agentized - (let ((alist (gnus-agent-load-alist gnus-newsgroup-name))) - (unless (cdr (assoc article alist)) - (setq gnus-newsgroup-undownloaded - (gnus-add-to-sorted-list - gnus-newsgroup-undownloaded article))))) - (push article out)) - (gnus-summary-update-download-mark article) - (gnus-summary-update-secondary-mark article)) - (gnus-summary-next-subject 1) - (gnus-summary-position-point) - (nreverse out))) - -(defun gnus-cached-article-p (article) - "Say whether ARTICLE is cached in the current group." - (memq article gnus-newsgroup-cached)) - -(defun gnus-summary-insert-cached-articles () - "Insert all the articles cached for this group into the current buffer." - (interactive) - (let ((gnus-verbose (max 6 gnus-verbose))) - (if (not gnus-newsgroup-cached) - (gnus-message 3 "No cached articles for this group") - (gnus-summary-goto-subjects gnus-newsgroup-cached)))) - -(defun gnus-summary-limit-include-cached () - "Limit the summary buffer to articles that are cached." - (interactive) - (let ((gnus-verbose (max 6 gnus-verbose))) - (if gnus-newsgroup-cached - (progn - (gnus-summary-limit gnus-newsgroup-cached) - (gnus-summary-position-point)) - (gnus-message 3 "No cached articles for this group")))) - -;;; Internal functions. - -(defun gnus-cache-change-buffer (group) - (and gnus-cache-buffer - ;; See if the current group's overview cache has been loaded. - (or (string= group (car gnus-cache-buffer)) - ;; Another overview cache is current, save it. - (gnus-cache-save-buffers))) - ;; if gnus-cache buffer is nil, create it - (unless gnus-cache-buffer - ;; Create cache buffer - (save-excursion - (setq gnus-cache-buffer - (cons group - (set-buffer (gnus-get-buffer-create - " *gnus-cache-overview*")))) - ;; Insert the contents of this group's cache overview. - (erase-buffer) - (let ((file (gnus-cache-file-name group ".overview"))) - (when (file-exists-p file) - (nnheader-insert-file-contents file))) - ;; We have a fresh (empty/just loaded) buffer, - ;; mark it as unmodified to save a redundant write later. - (set-buffer-modified-p nil)))) - -;; Return whether an article is a member of a class. -(defun gnus-cache-member-of-class (class ticked dormant unread) - (or (and ticked (memq 'ticked class)) - (and dormant (memq 'dormant class)) - (and unread (memq 'unread class)) - (and (not unread) (not ticked) (not dormant) (memq 'read class)))) - -(defun gnus-cache-file-name (group article) - (setq group (gnus-group-decoded-name group)) - (expand-file-name - (if (stringp article) article (int-to-string article)) - (file-name-as-directory - (expand-file-name - (nnheader-translate-file-chars - (if (gnus-use-long-file-name 'not-cache) - group - (let ((group (nnheader-replace-duplicate-chars-in-string - (nnheader-replace-chars-in-string group ?/ ?_) - ?. ?_))) - ;; Translate the first colon into a slash. - (when (string-match ":" group) - (setq group (concat (substring group 0 (match-beginning 0)) - "/" (substring group (match-end 0))))) - (nnheader-replace-chars-in-string group ?. ?/))) - t) - gnus-cache-directory)))) - -(defun gnus-cache-update-article (group article) - "If ARTICLE is in the cache, remove it and re-enter it." - (gnus-cache-change-buffer group) - (when (gnus-cache-possibly-remove-article article nil nil nil t) - (let ((gnus-use-cache nil)) - (gnus-cache-possibly-enter-article - gnus-newsgroup-name article - nil nil nil t)))) - -(defun gnus-cache-possibly-remove-article (article ticked dormant unread - &optional force) - "Possibly remove ARTICLE from the cache." - (let ((group gnus-newsgroup-name) - (number article) - file) - ;; If this is a virtual group, we find the real group. - (when (gnus-virtual-group-p group) - (let ((result (nnvirtual-find-group-art - (gnus-group-real-name group) article))) - (setq group (car result) - number (cdr result)))) - (setq file (gnus-cache-file-name group number)) - (when (and (file-exists-p file) - (or force - (gnus-cache-member-of-class - gnus-cache-remove-articles ticked dormant unread))) - (save-excursion - (delete-file file) - (set-buffer (cdr gnus-cache-buffer)) - (goto-char (point-min)) - (when (or (looking-at (concat (int-to-string number) "\t")) - (search-forward (concat "\n" (int-to-string number) "\t") - (point-max) t)) - (gnus-delete-line))) - (unless (setq gnus-newsgroup-cached - (delq article gnus-newsgroup-cached)) - (gnus-sethash gnus-newsgroup-name nil gnus-cache-active-hashtb) - (setq gnus-cache-active-altered t)) - (gnus-summary-update-secondary-mark article) - t))) - -(defun gnus-cache-articles-in-group (group) - "Return a sorted list of cached articles in GROUP." - (let ((dir (file-name-directory (gnus-cache-file-name group 1))) - articles) - (when (file-exists-p dir) - (setq articles - (sort (mapcar (lambda (name) (string-to-number name)) - (directory-files dir nil "^[0-9]+$" t)) - '<)) - ;; Update the cache active file, just to synch more. - (if articles - (progn - (gnus-cache-update-active group (car articles) t) - (gnus-cache-update-active group (car (last articles)))) - (when (gnus-gethash group gnus-cache-active-hashtb) - (gnus-sethash group nil gnus-cache-active-hashtb) - (setq gnus-cache-active-altered t))) - articles))) - -(defun gnus-cache-braid-nov (group cached &optional file) - (let ((cache-buf (gnus-get-buffer-create " *gnus-cache*")) - beg end) - (gnus-cache-save-buffers) - (save-excursion - (set-buffer cache-buf) - (erase-buffer) - (let ((coding-system-for-read - gnus-cache-overview-coding-system)) - (insert-file-contents - (or file (gnus-cache-file-name group ".overview")))) - (goto-char (point-min)) - (insert "\n") - (goto-char (point-min))) - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (while cached - (while (and (not (eobp)) - (< (read (current-buffer)) (car cached))) - (forward-line 1)) - (beginning-of-line) - (set-buffer cache-buf) - (if (search-forward (concat "\n" (int-to-string (car cached)) "\t") - nil t) - (setq beg (gnus-point-at-bol) - end (progn (end-of-line) (point))) - (setq beg nil)) - (set-buffer nntp-server-buffer) - (when beg - (insert-buffer-substring cache-buf beg end) - (insert "\n")) - (setq cached (cdr cached))) - (kill-buffer cache-buf))) - -(defun gnus-cache-braid-heads (group cached) - (let ((cache-buf (gnus-get-buffer-create " *gnus-cache*"))) - (save-excursion - (set-buffer cache-buf) - (erase-buffer)) - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (while cached - (while (and (not (eobp)) - (looking-at "2.. +\\([0-9]+\\) ") - (< (progn (goto-char (match-beginning 1)) - (read (current-buffer))) - (car cached))) - (search-forward "\n.\n" nil 'move)) - (beginning-of-line) - (set-buffer cache-buf) - (erase-buffer) - (let ((coding-system-for-read - gnus-cache-coding-system)) - (insert-file-contents (gnus-cache-file-name group (car cached)))) - (goto-char (point-min)) - (insert "220 ") - (princ (car cached) (current-buffer)) - (insert " Article retrieved.\n") - (search-forward "\n\n" nil 'move) - (delete-region (point) (point-max)) - (forward-char -1) - (insert ".") - (set-buffer nntp-server-buffer) - (insert-buffer-substring cache-buf) - (setq cached (cdr cached))) - (kill-buffer cache-buf))) - -;;;###autoload -(defun gnus-jog-cache () - "Go through all groups and put the articles into the cache. - -Usage: -$ emacs -batch -l ~/.emacs -l gnus -f gnus-jog-cache" - (interactive) - (let ((gnus-mark-article-hook nil) - (gnus-expert-user t) - (nnmail-spool-file nil) - (mail-sources nil) - (gnus-use-dribble-file nil) - (gnus-novice-user nil) - (gnus-large-newsgroup nil)) - ;; Start Gnus. - (gnus) - ;; Go through all groups... - (gnus-group-mark-buffer) - (gnus-group-iterate nil - (lambda (group) - (let (gnus-auto-select-next) - (gnus-summary-read-group group nil t) - ;; ... and enter the articles into the cache. - (when (eq major-mode 'gnus-summary-mode) - (gnus-uu-mark-buffer) - (gnus-cache-enter-article) - (kill-buffer (current-buffer)))))))) - -(defun gnus-cache-read-active (&optional force) - "Read the cache active file." - (gnus-make-directory gnus-cache-directory) - (if (or (not (file-exists-p gnus-cache-active-file)) - (zerop (nth 7 (file-attributes gnus-cache-active-file))) - force) - ;; There is no active file, so we generate one. - (gnus-cache-generate-active) - ;; We simply read the active file. - (save-excursion - (gnus-set-work-buffer) - (nnheader-insert-file-contents gnus-cache-active-file) - (gnus-active-to-gnus-format - nil (setq gnus-cache-active-hashtb - (gnus-make-hashtable - (count-lines (point-min) (point-max))))) - (setq gnus-cache-active-altered nil)))) - -(defun gnus-cache-write-active (&optional force) - "Write the active hashtb to the active file." - (when (or force - (and gnus-cache-active-hashtb - gnus-cache-active-altered)) - (gnus-write-active-file gnus-cache-active-file gnus-cache-active-hashtb t) - ;; Mark the active hashtb as unaltered. - (setq gnus-cache-active-altered nil))) - -(defun gnus-cache-possibly-update-active (group active) - "Update active info bounds of GROUP with ACTIVE if necessary. -The update is performed if ACTIVE contains a higher or lower bound -than the current." - (let ((lower t) (higher t)) - (if gnus-cache-active-hashtb - (let ((cache-active (gnus-gethash group gnus-cache-active-hashtb))) - (when cache-active - (unless (< (car active) (car cache-active)) - (setq lower nil)) - (unless (> (cdr active) (cdr cache-active)) - (setq higher nil)))) - (gnus-cache-read-active)) - (when lower - (gnus-cache-update-active group (car active) t)) - (when higher - (gnus-cache-update-active group (cdr active))))) - -(defun gnus-cache-update-active (group number &optional low) - "Update the upper bound of the active info of GROUP to NUMBER. -If LOW, update the lower bound instead." - (let ((active (gnus-gethash group gnus-cache-active-hashtb))) - (if (null active) - ;; We just create a new active entry for this group. - (gnus-sethash group (cons number number) gnus-cache-active-hashtb) - ;; Update the lower or upper bound. - (if low - (setcar active number) - (setcdr active number))) - ;; Mark the active hashtb as altered. - (setq gnus-cache-active-altered t))) - -;;;###autoload -(defun gnus-cache-generate-active (&optional directory) - "Generate the cache active file." - (interactive) - (let* ((top (null directory)) - (directory (expand-file-name (or directory gnus-cache-directory))) - (files (directory-files directory 'full)) - (group - (if top - "" - (string-match - (concat "^" (regexp-quote - (file-name-as-directory - (expand-file-name gnus-cache-directory)))) - (directory-file-name directory)) - (nnheader-replace-chars-in-string - (substring (directory-file-name directory) (match-end 0)) - ?/ ?.))) - nums alphs) - (when top - (gnus-message 5 "Generating the cache active file...") - (setq gnus-cache-active-hashtb (gnus-make-hashtable 123))) - (when (string-match "^\\(nn[^_]+\\)_" group) - (setq group (replace-match "\\1:" t nil group))) - ;; Separate articles from all other files and directories. - (while files - (if (string-match "^[0-9]+$" (file-name-nondirectory (car files))) - (push (string-to-number (file-name-nondirectory (pop files))) nums) - (push (pop files) alphs))) - ;; If we have nums, then this is probably a valid group. - (when (setq nums (sort nums '<)) - (gnus-sethash group (cons (car nums) (gnus-last-element nums)) - gnus-cache-active-hashtb)) - ;; Go through all the other files. - (while alphs - (when (and (file-directory-p (car alphs)) - (not (string-match "^\\." - (file-name-nondirectory (car alphs))))) - ;; We descend directories. - (gnus-cache-generate-active (car alphs))) - (setq alphs (cdr alphs))) - ;; Write the new active file. - (when top - (gnus-cache-write-active t) - (gnus-message 5 "Generating the cache active file...done")))) - -;;;###autoload -(defun gnus-cache-generate-nov-databases (dir) - "Generate NOV files recursively starting in DIR." - (interactive (list gnus-cache-directory)) - (gnus-cache-close) - (let ((nnml-generate-active-function 'identity)) - (nnml-generate-nov-databases-1 dir)) - (gnus-cache-open)) - -(defun gnus-cache-move-cache (dir) - "Move the cache tree to somewhere else." - (interactive "FMove the cache tree to: ") - (rename-file gnus-cache-directory dir)) - -(defun gnus-cache-fully-p (&optional group) - "Returns non-nil if the cache should be fully used. -If GROUP is non-nil, also cater to `gnus-cacheable-groups' and -`gnus-uncacheable-groups'." - (and gnus-use-cache - (not (eq gnus-use-cache 'passive)) - (if (null group) - t - (and (or (not gnus-cacheable-groups) - (string-match gnus-cacheable-groups group)) - (or (not gnus-uncacheable-groups) - (not (string-match gnus-uncacheable-groups group))))))) - -;;;###autoload -(defun gnus-cache-rename-group (old-group new-group) - "Rename OLD-GROUP as NEW-GROUP. -Always updates the cache, even when disabled, as the old cache -files would corrupt Gnus when the cache was next enabled. It -depends on the caller to determine whether group renaming is -supported." - (let ((old-dir (gnus-cache-file-name old-group "")) - (new-dir (gnus-cache-file-name new-group ""))) - (gnus-rename-file old-dir new-dir t)) - - (let ((no-save gnus-cache-active-hashtb)) - (unless gnus-cache-active-hashtb - (gnus-cache-read-active)) - (let* ((old-group-hash-value - (gnus-gethash old-group gnus-cache-active-hashtb)) - (new-group-hash-value - (gnus-gethash new-group gnus-cache-active-hashtb)) - (delta - (or old-group-hash-value new-group-hash-value))) - (gnus-sethash new-group old-group-hash-value gnus-cache-active-hashtb) - (gnus-sethash old-group nil gnus-cache-active-hashtb) - - (if no-save - (setq gnus-cache-active-altered delta) - (gnus-cache-write-active delta))))) - -;;;###autoload -(defun gnus-cache-delete-group (group) - "Delete GROUP from the cache. -Always updates the cache, even when disabled, as the old cache -files would corrupt gnus when the cache was next enabled. -Depends upon the caller to determine whether group deletion is -supported." - (let ((dir (gnus-cache-file-name group ""))) - (gnus-delete-directory dir)) - - (let ((no-save gnus-cache-active-hashtb)) - (unless gnus-cache-active-hashtb - (gnus-cache-read-active)) - (let* ((group-hash-value (gnus-gethash group gnus-cache-active-hashtb))) - (gnus-sethash group nil gnus-cache-active-hashtb) - - (if no-save - (setq gnus-cache-active-altered group-hash-value) - (gnus-cache-write-active group-hash-value))))) - -(provide 'gnus-cache) - -;;; arch-tag: 05a79442-8c58-4e65-bd0a-3cbb1b89a33a -;;; gnus-cache.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-cite.el b/xemacs-packages/gnus/lisp/gnus-cite.el deleted file mode 100644 index 758a0ecb..00000000 --- a/xemacs-packages/gnus/lisp/gnus-cite.el +++ /dev/null @@ -1,1113 +0,0 @@ -;;; gnus-cite.el --- parse citations in articles for Gnus - -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Per Abhiddenware - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) -(require 'gnus-range) -(require 'gnus-art) -(require 'message) ; for message-cite-prefix-regexp - -;;; Customization: - -(defgroup gnus-cite nil - "Citation." - :prefix "gnus-cite-" - :link '(custom-manual "(gnus)Article Highlighting") - :group 'gnus-article) - -(defcustom gnus-cited-opened-text-button-line-format "%(%{[-]%}%)\n" - "Format of opened cited text buttons." - :group 'gnus-cite - :type 'string) - -(defcustom gnus-cited-closed-text-button-line-format "%(%{[+]%}%)\n" - "Format of closed cited text buttons." - :group 'gnus-cite - :type 'string) - -(defcustom gnus-cited-lines-visible nil - "The number of lines of hidden cited text to remain visible. -Or a pair (cons) of numbers which are the number of lines at the top -and bottom of the text, respectively, to remain visible." - :group 'gnus-cite - :type '(choice (const :tag "none" nil) - integer - (cons :tag "Top and Bottom" integer integer))) - -(defcustom gnus-cite-parse-max-size 25000 - "Maximum article size (in bytes) where parsing citations is allowed. -Set it to nil to parse all articles." - :group 'gnus-cite - :type '(choice (const :tag "all" nil) - integer)) - -(defcustom gnus-cite-max-prefix 20 - "Maximum possible length for a citation prefix." - :group 'gnus-cite - :type 'integer) - -(defcustom gnus-supercite-regexp - (concat "^\\(" message-cite-prefix-regexp "\\)? *" - ">>>>> +\"\\([^\"\n]+\\)\" +==") - "*Regexp matching normal Supercite attribution lines. -The first grouping must match prefixes added by other packages." - :group 'gnus-cite - :type 'regexp) - -(defcustom gnus-supercite-secondary-regexp "^.*\"\\([^\"\n]+\\)\" +==" - "Regexp matching mangled Supercite attribution lines. -The first regexp group should match the Supercite attribution." - :group 'gnus-cite - :type 'regexp) - -(defcustom gnus-cite-minimum-match-count 2 - "Minimum number of identical prefixes before we believe it's a citation." - :group 'gnus-cite - :type 'integer) - -;; Some Microsoft products put in a citation that extends to the -;; remainder of the message: -;; -;; -----Original Message----- -;; From: ... -;; To: ... -;; Sent: ... [date, in non-RFC-2822 format] -;; Subject: ... -;; -;; Cited message, with no prefixes -;; -;; The four headers are always the same. But note they are prone to -;; folding without additional indentation. -;; -;; Others use "----- Original Message -----" instead, and properly quote -;; the body using "> ". This style is handled without special cases. - -(defcustom gnus-cite-attribution-prefix - "In article\\|in <\\|On \\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\),\\|----- ?Original Message ?-----" - "*Regexp matching the beginning of an attribution line." - :group 'gnus-cite - :type 'regexp) - -(defcustom gnus-cite-attribution-suffix - "\\(\\(wrote\\|writes\\|said\\|says\\|>\\)\\(:\\|\\.\\.\\.\\)\\|----- ?Original Message ?-----\\)[ \t]*$" - "*Regexp matching the end of an attribution line. -The text matching the first grouping will be used as a button." - :group 'gnus-cite - :type 'regexp) - -(defcustom gnus-cite-unsightly-citation-regexp - "^-----Original Message-----\nFrom: \\(.+\n\\)+\n" - "Regexp matching Microsoft-type rest-of-message citations." - :version "22.1" - :group 'gnus-cite - :type 'regexp) - -(defcustom gnus-cite-ignore-quoted-from t - "Non-nil means don't regard lines beginning with \">From \" as cited text. -Those lines may have been quoted by MTAs in order not to mix up with -the envelope From line." - :version "22.1" - :group 'gnus-cite - :type 'boolean) - -(defface gnus-cite-attribution '((t (:italic t))) - "Face used for attribution lines." - :group 'gnus-cite) -;; backward-compatibility alias -(put 'gnus-cite-attribution-face 'face-alias 'gnus-cite-attribution) - -(defcustom gnus-cite-attribution-face 'gnus-cite-attribution - "Face used for attribution lines. -It is merged with the face for the cited text belonging to the attribution." - :version "22.1" - :group 'gnus-cite - :type 'face) - -(defface gnus-cite-1 '((((class color) - (background dark)) - (:foreground "light blue")) - (((class color) - (background light)) - (:foreground "MidnightBlue")) - (t - (:italic t))) - "Citation face." - :group 'gnus-cite) -;; backward-compatibility alias -(put 'gnus-cite-face-1 'face-alias 'gnus-cite-1) - -(defface gnus-cite-2 '((((class color) - (background dark)) - (:foreground "light cyan")) - (((class color) - (background light)) - (:foreground "firebrick")) - (t - (:italic t))) - "Citation face." - :group 'gnus-cite) -;; backward-compatibility alias -(put 'gnus-cite-face-2 'face-alias 'gnus-cite-2) - -(defface gnus-cite-3 '((((class color) - (background dark)) - (:foreground "light yellow")) - (((class color) - (background light)) - (:foreground "dark green")) - (t - (:italic t))) - "Citation face." - :group 'gnus-cite) -;; backward-compatibility alias -(put 'gnus-cite-face-3 'face-alias 'gnus-cite-3) - -(defface gnus-cite-4 '((((class color) - (background dark)) - (:foreground "light pink")) - (((class color) - (background light)) - (:foreground "OrangeRed")) - (t - (:italic t))) - "Citation face." - :group 'gnus-cite) -;; backward-compatibility alias -(put 'gnus-cite-face-4 'face-alias 'gnus-cite-4) - -(defface gnus-cite-5 '((((class color) - (background dark)) - (:foreground "pale green")) - (((class color) - (background light)) - (:foreground "dark khaki")) - (t - (:italic t))) - "Citation face." - :group 'gnus-cite) -;; backward-compatibility alias -(put 'gnus-cite-face-5 'face-alias 'gnus-cite-5) - -(defface gnus-cite-6 '((((class color) - (background dark)) - (:foreground "beige")) - (((class color) - (background light)) - (:foreground "dark violet")) - (t - (:italic t))) - "Citation face." - :group 'gnus-cite) -;; backward-compatibility alias -(put 'gnus-cite-face-6 'face-alias 'gnus-cite-6) - -(defface gnus-cite-7 '((((class color) - (background dark)) - (:foreground "orange")) - (((class color) - (background light)) - (:foreground "SteelBlue4")) - (t - (:italic t))) - "Citation face." - :group 'gnus-cite) -;; backward-compatibility alias -(put 'gnus-cite-face-7 'face-alias 'gnus-cite-7) - -(defface gnus-cite-8 '((((class color) - (background dark)) - (:foreground "magenta")) - (((class color) - (background light)) - (:foreground "magenta")) - (t - (:italic t))) - "Citation face." - :group 'gnus-cite) -;; backward-compatibility alias -(put 'gnus-cite-face-8 'face-alias 'gnus-cite-8) - -(defface gnus-cite-9 '((((class color) - (background dark)) - (:foreground "violet")) - (((class color) - (background light)) - (:foreground "violet")) - (t - (:italic t))) - "Citation face." - :group 'gnus-cite) -;; backward-compatibility alias -(put 'gnus-cite-face-9 'face-alias 'gnus-cite-9) - -(defface gnus-cite-10 '((((class color) - (background dark)) - (:foreground "medium purple")) - (((class color) - (background light)) - (:foreground "medium purple")) - (t - (:italic t))) - "Citation face." - :group 'gnus-cite) -;; backward-compatibility alias -(put 'gnus-cite-face-10 'face-alias 'gnus-cite-10) - -(defface gnus-cite-11 '((((class color) - (background dark)) - (:foreground "turquoise")) - (((class color) - (background light)) - (:foreground "turquoise")) - (t - (:italic t))) - "Citation face." - :group 'gnus-cite) -;; backward-compatibility alias -(put 'gnus-cite-face-11 'face-alias 'gnus-cite-11) - -(defcustom gnus-cite-face-list - '(gnus-cite-1 gnus-cite-2 gnus-cite-3 gnus-cite-4 gnus-cite-5 gnus-cite-6 - gnus-cite-7 gnus-cite-8 gnus-cite-9 gnus-cite-10 gnus-cite-11) - "*List of faces used for highlighting citations. - -When there are citations from multiple articles in the same message, -Gnus will try to give each citation from each article its own face. -This should make it easier to see who wrote what." - :group 'gnus-cite - :type '(repeat face)) - -(defcustom gnus-cite-hide-percentage 50 - "Only hide excess citation if above this percentage of the body." - :group 'gnus-cite - :type 'number) - -(defcustom gnus-cite-hide-absolute 10 - "Only hide excess citation if above this number of lines in the body." - :group 'gnus-cite - :type 'integer) - -(defcustom gnus-cite-blank-line-after-header t - "If non-nil, put a blank line between the citation header and the button." - :group 'gnus-cite - :type 'boolean) - -;; This has to go here because its default value depends on -;; gnus-cite-face-list. -(defcustom gnus-article-boring-faces (cons 'gnus-signature gnus-cite-face-list) - "List of faces that are not worth reading. -If an article has more pages below the one you are looking at, but -nothing on those pages is a word of at least three letters that is not -in a boring face, then the pages will be skipped." - :type '(repeat face) - :group 'gnus-article-hiding) - -;;; Internal Variables: - -(defvar gnus-cite-article nil) -(defvar gnus-cite-overlay-list nil) - -(defvar gnus-cite-prefix-alist nil) -;; Alist of citation prefixes. -;; The cdr is a list of lines with that prefix. - -(defvar gnus-cite-attribution-alist nil) -;; Alist of attribution lines. -;; The car is a line number. -;; The cdr is the prefix for the citation started by that line. - -(defvar gnus-cite-loose-prefix-alist nil) -;; Alist of citation prefixes that have no matching attribution. -;; The cdr is a list of lines with that prefix. - -(defvar gnus-cite-loose-attribution-alist nil) -;; Alist of attribution lines that have no matching citation. -;; Each member has the form (WROTE IN PREFIX TAG), where -;; WROTE: is the attribution line number -;; IN: is the line number of the previous line if part of the same attribution, -;; PREFIX: Is the citation prefix of the attribution line(s), and -;; TAG: Is a Supercite tag, if any. - -(defvar gnus-cited-opened-text-button-line-format-alist - `((?b (marker-position beg) ?d) - (?e (marker-position end) ?d) - (?n (count-lines beg end) ?d) - (?l (- end beg) ?d))) -(defvar gnus-cited-opened-text-button-line-format-spec nil) -(defvar gnus-cited-closed-text-button-line-format-alist - gnus-cited-opened-text-button-line-format-alist) -(defvar gnus-cited-closed-text-button-line-format-spec nil) - - -;;; Commands: - -(defun gnus-article-highlight-citation (&optional force) - "Highlight cited text. -Each citation in the article will be highlighted with a different face. -The faces are taken from `gnus-cite-face-list'. -Attribution lines are highlighted with the same face as the -corresponding citation merged with the face `gnus-cite-attribution'. - -Text is considered cited if at least `gnus-cite-minimum-match-count' -lines matches `message-cite-prefix-regexp' with the same prefix. - -Lines matching `gnus-cite-attribution-suffix' and perhaps -`gnus-cite-attribution-prefix' are considered attribution lines." - (interactive (list 'force)) - (save-excursion - (set-buffer gnus-article-buffer) - (gnus-cite-parse-maybe force) - (let ((buffer-read-only nil) - (alist gnus-cite-prefix-alist) - (faces gnus-cite-face-list) - (inhibit-point-motion-hooks t) - face entry prefix skip numbers number face-alist) - ;; Loop through citation prefixes. - (while alist - (setq entry (car alist) - alist (cdr alist) - prefix (car entry) - numbers (cdr entry) - face (car faces) - faces (or (cdr faces) gnus-cite-face-list) - face-alist (cons (cons prefix face) face-alist)) - (while numbers - (setq number (car numbers) - numbers (cdr numbers)) - (and (not (assq number gnus-cite-attribution-alist)) - (not (assq number gnus-cite-loose-attribution-alist)) - (gnus-cite-add-face number prefix face)))) - ;; Loop through attribution lines. - (setq alist gnus-cite-attribution-alist) - (while alist - (setq entry (car alist) - alist (cdr alist) - number (car entry) - prefix (cdr entry) - skip (gnus-cite-find-prefix number) - face (cdr (assoc prefix face-alist))) - ;; Add attribution button. - (goto-char (point-min)) - (forward-line (1- number)) - (when (re-search-forward gnus-cite-attribution-suffix - (gnus-point-at-eol) - t) - (gnus-article-add-button (match-beginning 1) (match-end 1) - 'gnus-cite-toggle prefix)) - ;; Highlight attribution line. - (gnus-cite-add-face number skip face) - (gnus-cite-add-face number skip gnus-cite-attribution-face)) - ;; Loop through attribution lines. - (setq alist gnus-cite-loose-attribution-alist) - (while alist - (setq entry (car alist) - alist (cdr alist) - number (car entry) - skip (gnus-cite-find-prefix number)) - (gnus-cite-add-face number skip gnus-cite-attribution-face))))) - -(defun gnus-dissect-cited-text () - "Dissect the article buffer looking for cited text." - (save-excursion - (set-buffer gnus-article-buffer) - (gnus-cite-parse-maybe nil t) - (let ((alist gnus-cite-prefix-alist) - prefix numbers number marks m) - ;; Loop through citation prefixes. - (while alist - (setq numbers (pop alist) - prefix (pop numbers)) - (while numbers - (setq number (pop numbers)) - (goto-char (point-min)) - (forward-line number) - (push (cons (point-marker) "") marks) - (while (and numbers - (= (1- number) (car numbers))) - (setq number (pop numbers))) - (goto-char (point-min)) - (forward-line (1- number)) - (push (cons (point-marker) prefix) marks))) - ;; Skip to the beginning of the body. - (article-goto-body) - (push (cons (point-marker) "") marks) - ;; Find the end of the body. - (goto-char (point-max)) - (gnus-article-search-signature) - (push (cons (point-marker) "") marks) - ;; Sort the marks. - (setq marks (sort marks 'car-less-than-car)) - (let ((omarks marks)) - (setq marks nil) - (while (cdr omarks) - (if (= (caar omarks) (caadr omarks)) - (progn - (unless (equal (cdar omarks) "") - (push (car omarks) marks)) - (unless (equal (cdadr omarks) "") - (push (cadr omarks) marks)) - (unless (and (equal (cdar omarks) "") - (equal (cdadr omarks) "") - (not (cddr omarks))) - (setq omarks (cdr omarks)))) - (push (car omarks) marks)) - (setq omarks (cdr omarks))) - (when (car omarks) - (push (car omarks) marks)) - (setq marks (setq m (nreverse marks))) - (while (cddr m) - (if (and (equal (cdadr m) "") - (equal (cdar m) (cdaddr m)) - (goto-char (caadr m)) - (forward-line 1) - (= (point) (caaddr m))) - (setcdr m (cdddr m)) - (setq m (cdr m)))) - marks)))) - -(defun gnus-article-fill-cited-article (&optional force width) - "Do word wrapping in the current article. -If WIDTH (the numerical prefix), use that text width when filling." - (interactive (list t current-prefix-arg)) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((buffer-read-only nil) - (inhibit-point-motion-hooks t) - (marks (gnus-dissect-cited-text)) - (adaptive-fill-mode nil) - (filladapt-mode nil) - (fill-column (if width (prefix-numeric-value width) fill-column))) - (save-restriction - (while (cdr marks) - (narrow-to-region (caar marks) (caadr marks)) - (let ((adaptive-fill-regexp - (concat "^" (regexp-quote (cdar marks)) " *")) - (fill-prefix - (if (string= (cdar marks) "") "" - (concat (cdar marks) " "))) - use-hard-newlines) - (fill-region (point-min) (point-max))) - (set-marker (caar marks) nil) - (setq marks (cdr marks))) - (when marks - (set-marker (caar marks) nil)) - ;; All this information is now incorrect. - (setq gnus-cite-prefix-alist nil - gnus-cite-attribution-alist nil - gnus-cite-loose-prefix-alist nil - gnus-cite-loose-attribution-alist nil - gnus-cite-article nil))))) - -(defun gnus-article-hide-citation (&optional arg force) - "Toggle hiding of all cited text except attribution lines. -See the documentation for `gnus-article-highlight-citation'. -If given a negative prefix, always show; if given a positive prefix, -always hide." - (interactive (append (gnus-article-hidden-arg) (list 'force))) - (gnus-set-format 'cited-opened-text-button t) - (gnus-set-format 'cited-closed-text-button t) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((buffer-read-only nil) - marks - (inhibit-point-motion-hooks t) - (props (nconc (list 'article-type 'cite) - gnus-hidden-properties)) - (point (point-min)) - found beg end start) - (while (setq point - (text-property-any point (point-max) - 'gnus-callback - 'gnus-article-toggle-cited-text)) - (setq found t) - (goto-char point) - (gnus-article-toggle-cited-text - (get-text-property point 'gnus-data) arg) - (forward-line 1) - (setq point (point))) - (unless found - (setq marks (gnus-dissect-cited-text)) - (while marks - (setq beg nil - end nil) - (while (and marks (string= (cdar marks) "")) - (setq marks (cdr marks))) - (when marks - (setq beg (caar marks))) - (while (and marks (not (string= (cdar marks) ""))) - (setq marks (cdr marks))) - (when marks - (setq end (caar marks))) - ;; Skip past lines we want to leave visible. - (when (and beg end gnus-cited-lines-visible) - (goto-char beg) - (forward-line (if (consp gnus-cited-lines-visible) - (car gnus-cited-lines-visible) - gnus-cited-lines-visible)) - (if (>= (point) end) - (setq beg nil) - (setq beg (point-marker)) - (when (consp gnus-cited-lines-visible) - (goto-char end) - (forward-line (- (cdr gnus-cited-lines-visible))) - (if (<= (point) beg) - (setq beg nil) - (setq end (point-marker)))))) - (when (and beg end) - (gnus-add-wash-type 'cite) - ;; We use markers for the end-points to facilitate later - ;; wrapping and mangling of text. - (setq beg (set-marker (make-marker) beg) - end (set-marker (make-marker) end)) - (gnus-add-text-properties-when 'article-type nil beg end props) - (goto-char beg) - (when (and gnus-cite-blank-line-after-header - (not (save-excursion (search-backward "\n\n" nil t)))) - (insert "\n")) - (put-text-property - (setq start (point-marker)) - (progn - (gnus-article-add-button - (point) - (progn (eval gnus-cited-closed-text-button-line-format-spec) - (point)) - `gnus-article-toggle-cited-text - (list (cons beg end) start)) - (point)) - 'article-type 'annotation) - (set-marker beg (point)))))))) - -(defun gnus-article-toggle-cited-text (args &optional arg) - "Toggle hiding the text in REGION. -ARG can be nil or a number. Positive means hide, negative -means show, nil means toggle." - (let* ((region (car args)) - (beg (car region)) - (end (cdr region)) - (start (cadr args)) - (hidden - (text-property-any beg (1- end) 'article-type 'cite)) - (inhibit-point-motion-hooks t) - buffer-read-only) - (when (or (null arg) - (zerop arg) - (and (> arg 0) (not hidden)) - (and (< arg 0) hidden)) - (if hidden - (progn - ;; Can't remove 'cite from g-a-wash-types here because - ;; multiple citations may be hidden -jas - (gnus-remove-text-properties-when - 'article-type 'cite beg end - (cons 'article-type (cons 'cite - gnus-hidden-properties)))) - (gnus-add-wash-type 'cite) - (gnus-add-text-properties-when - 'article-type nil beg end - (cons 'article-type (cons 'cite - gnus-hidden-properties)))) - (let ((gnus-article-mime-handle-alist-1 gnus-article-mime-handle-alist)) - (gnus-set-mode-line 'article)) - (save-excursion - (goto-char start) - (gnus-delete-line) - (put-text-property - (point) - (progn - (gnus-article-add-button - (point) - (progn (eval - (if hidden - gnus-cited-opened-text-button-line-format-spec - gnus-cited-closed-text-button-line-format-spec)) - (point)) - `gnus-article-toggle-cited-text - args) - (point)) - 'article-type 'annotation))))) - -(defun gnus-article-hide-citation-maybe (&optional arg force) - "Toggle hiding of cited text that has an attribution line. -If given a negative prefix, always show; if given a positive prefix, -always hide. -This will do nothing unless at least `gnus-cite-hide-percentage' -percent and at least `gnus-cite-hide-absolute' lines of the body is -cited text with attributions. When called interactively, these two -variables are ignored. -See also the documentation for `gnus-article-highlight-citation'." - (interactive (append (gnus-article-hidden-arg) '(force))) - (with-current-buffer gnus-article-buffer - (gnus-delete-wash-type 'cite) - (unless (gnus-article-check-hidden-text 'cite arg) - (save-excursion - (gnus-cite-parse-maybe force) - (article-goto-body) - (let ((start (point)) - (atts gnus-cite-attribution-alist) - (buffer-read-only nil) - (inhibit-point-motion-hooks t) - (hidden 0) - total) - (goto-char (point-max)) - (gnus-article-search-signature) - (setq total (count-lines start (point))) - (while atts - (setq hidden (+ hidden (length (cdr (assoc (cdar atts) - gnus-cite-prefix-alist)))) - atts (cdr atts))) - (when (or force - (and (> (* 100 hidden) (* gnus-cite-hide-percentage total)) - (> hidden gnus-cite-hide-absolute))) - (gnus-add-wash-type 'cite) - (setq atts gnus-cite-attribution-alist) - (while atts - (setq total (cdr (assoc (cdar atts) gnus-cite-prefix-alist)) - atts (cdr atts)) - (while total - (setq hidden (car total) - total (cdr total)) - (goto-char (point-min)) - (forward-line (1- hidden)) - (unless (assq hidden gnus-cite-attribution-alist) - (gnus-add-text-properties - (point) (progn (forward-line 1) (point)) - (nconc (list 'article-type 'cite) - gnus-hidden-properties))))))))) - (gnus-set-mode-line 'article))) - -(defun gnus-article-hide-citation-in-followups () - "Hide cited text in non-root articles." - (interactive) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((article (cdr gnus-article-current))) - (unless (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-article-displayed-root-p article)) - (gnus-article-hide-citation))))) - -;;; Internal functions: - -(defun gnus-cite-parse-maybe (&optional force no-overlay) - "Always parse the buffer." - (gnus-cite-localize) - ;;Reset parser information. - (setq gnus-cite-prefix-alist nil - gnus-cite-attribution-alist nil - gnus-cite-loose-prefix-alist nil - gnus-cite-loose-attribution-alist nil) - (unless no-overlay - (gnus-cite-delete-overlays)) - ;; Parse if not too large. - (if (and gnus-cite-parse-max-size - (> (buffer-size) gnus-cite-parse-max-size)) - () - (setq gnus-cite-article (cons (car gnus-article-current) - (cdr gnus-article-current))) - (gnus-cite-parse-wrapper))) - -(defun gnus-cite-delete-overlays () - (dolist (overlay gnus-cite-overlay-list) - (ignore-errors - (when (or (not (gnus-overlay-end overlay)) - (and (>= (gnus-overlay-end overlay) (point-min)) - (<= (gnus-overlay-end overlay) (point-max)))) - (setq gnus-cite-overlay-list (delete overlay gnus-cite-overlay-list)) - (ignore-errors - (gnus-delete-overlay overlay)))))) - -(defun gnus-cite-parse-wrapper () - ;; Wrap chopped gnus-cite-parse. - (article-goto-body) - (let ((inhibit-point-motion-hooks t)) - (save-excursion - (gnus-cite-parse-attributions)) - (save-excursion - (gnus-cite-parse)) - (save-excursion - (gnus-cite-connect-attributions)))) - -(defun gnus-cite-parse () - ;; Parse and connect citation prefixes and attribution lines. - - ;; Parse current buffer searching for citation prefixes. - (let ((line (1+ (count-lines (point-min) (point)))) - (case-fold-search t) - (max (save-excursion - (goto-char (point-max)) - (gnus-article-search-signature) - (point))) - (prefix-regexp (concat "^\\(" message-cite-prefix-regexp "\\)")) - alist entry start begin end numbers prefix guess-limit) - ;; Get all potential prefixes in `alist'. - (while (< (point) max) - ;; Each line. - (setq begin (point) - guess-limit (progn (skip-chars-forward "^> \t\r\n") (point)) - end (gnus-point-at-bol 2) - start end) - (goto-char begin) - ;; Ignore standard Supercite attribution prefix. - (when (and (< guess-limit (+ begin gnus-cite-max-prefix)) - (looking-at gnus-supercite-regexp)) - (if (match-end 1) - (setq end (1+ (match-end 1))) - (setq end (1+ begin)))) - ;; Ignore very long prefixes. - (when (> end (+ begin gnus-cite-max-prefix)) - (setq end (+ begin gnus-cite-max-prefix))) - ;; Ignore quoted envelope From_. - (when (and gnus-cite-ignore-quoted-from - (prog2 - (setq case-fold-search nil) - (looking-at ">From ") - (setq case-fold-search t))) - (setq end (1+ begin))) - (while (re-search-forward prefix-regexp (1- end) t) - ;; Each prefix. - (setq end (match-end 0) - prefix (buffer-substring begin end)) - (gnus-set-text-properties 0 (length prefix) nil prefix) - (setq entry (assoc prefix alist)) - (if entry - (setcdr entry (cons line (cdr entry))) - (push (list prefix line) alist)) - (goto-char begin)) - (goto-char start) - (setq line (1+ line))) - ;; Horrible special case for some Microsoft mailers. - (goto-char (point-min)) - (when (re-search-forward gnus-cite-unsightly-citation-regexp max t) - (setq begin (count-lines (point-min) (point))) - (setq end (count-lines (point-min) max)) - (setq entry nil) - (while (< begin end) - (push begin entry) - (setq begin (1+ begin))) - (push (cons "" entry) alist)) - ;; We got all the potential prefixes. Now create - ;; `gnus-cite-prefix-alist' containing the oldest prefix for each - ;; line that appears at least `gnus-cite-minimum-match-count' - ;; times. First sort them by length. Longer is older. - (setq alist (sort alist (lambda (a b) - (> (length (car a)) (length (car b)))))) - (while alist - (setq entry (car alist) - prefix (car entry) - numbers (cdr entry) - alist (cdr alist)) - (cond ((null numbers) - ;; No lines with this prefix that wasn't also part of - ;; a longer prefix. - ) - ((< (length numbers) gnus-cite-minimum-match-count) - ;; Too few lines with this prefix. We keep it a bit - ;; longer in case it is an exact match for an attribution - ;; line, but we don't remove the line from other - ;; prefixes. - (push entry gnus-cite-prefix-alist)) - (t - (push entry - gnus-cite-prefix-alist) - ;; Remove articles from other prefixes. - (let ((loop alist) - current) - (while loop - (setq current (car loop) - loop (cdr loop)) - (setcdr current - (gnus-set-difference (cdr current) numbers))))))))) - -(defun gnus-cite-parse-attributions () - (let (al-alist) - ;; Parse attributions - (while (re-search-forward gnus-cite-attribution-suffix (point-max) t) - (let* ((start (match-beginning 0)) - (end (match-end 0)) - (wrote (count-lines (point-min) end)) - (prefix (gnus-cite-find-prefix wrote)) - ;; Check previous line for an attribution leader. - (tag (progn - (beginning-of-line 1) - (when (looking-at gnus-supercite-secondary-regexp) - (buffer-substring (match-beginning 1) - (match-end 1))))) - (in (progn - (goto-char start) - (and (re-search-backward gnus-cite-attribution-prefix - (save-excursion - (beginning-of-line 0) - (point)) - t) - (not (re-search-forward gnus-cite-attribution-suffix - start t)) - (count-lines (point-min) (1+ (point))))))) - (when (eq wrote in) - (setq in nil)) - (goto-char end) - ;; don't add duplicates - (let ((al (buffer-substring (save-excursion (beginning-of-line 0) - (1+ (point))) - end))) - (if (not (assoc al al-alist)) - (progn - (push (list wrote in prefix tag) - gnus-cite-loose-attribution-alist) - (push (cons al t) al-alist)))))))) - -(defun gnus-cite-connect-attributions () - ;; Connect attributions to citations - - ;; No citations have been connected to attribution lines yet. - (setq gnus-cite-loose-prefix-alist (append gnus-cite-prefix-alist nil)) - - ;; Parse current buffer searching for attribution lines. - ;; Find exact supercite citations. - (gnus-cite-match-attributions 'small nil - (lambda (prefix tag) - (when tag - (concat "\\`" - (regexp-quote prefix) "[ \t]*" - (regexp-quote tag) ">")))) - ;; Find loose supercite citations after attributions. - (gnus-cite-match-attributions 'small t - (lambda (prefix tag) - (when tag - (concat "\\<" - (regexp-quote tag) - "\\>")))) - ;; Find loose supercite citations anywhere. - (gnus-cite-match-attributions 'small nil - (lambda (prefix tag) - (when tag - (concat "\\<" - (regexp-quote tag) - "\\>")))) - ;; Find nested citations after attributions. - (gnus-cite-match-attributions 'small-if-unique t - (lambda (prefix tag) - (concat "\\`" (regexp-quote prefix) ".+"))) - ;; Find nested citations anywhere. - (gnus-cite-match-attributions 'small nil - (lambda (prefix tag) - (concat "\\`" (regexp-quote prefix) ".+"))) - ;; Remove loose prefixes with too few lines. - (let ((alist gnus-cite-loose-prefix-alist) - entry) - (while alist - (setq entry (car alist) - alist (cdr alist)) - (when (< (length (cdr entry)) gnus-cite-minimum-match-count) - (setq gnus-cite-prefix-alist - (delq entry gnus-cite-prefix-alist) - gnus-cite-loose-prefix-alist - (delq entry gnus-cite-loose-prefix-alist))))) - ;; Find flat attributions. - (gnus-cite-match-attributions 'first t nil) - ;; Find any attributions (are we getting desperate yet?). - (gnus-cite-match-attributions 'first nil nil)) - -(defun gnus-cite-match-attributions (sort after fun) - ;; Match all loose attributions and citations (SORT AFTER FUN) . - ;; - ;; If SORT is `small', the citation with the shortest prefix will be - ;; used, if it is `first' the first prefix will be used, if it is - ;; `small-if-unique' the shortest prefix will be used if the - ;; attribution line does not share its own prefix with other - ;; loose attribution lines, otherwise the first prefix will be used. - ;; - ;; If AFTER is non-nil, only citations after the attribution line - ;; will be considered. - ;; - ;; If FUN is non-nil, it will be called with the arguments (WROTE - ;; PREFIX TAG) and expected to return a regular expression. Only - ;; citations whose prefix matches the regular expression will be - ;; considered. - ;; - ;; WROTE is the attribution line number. - ;; PREFIX is the attribution line prefix. - ;; TAG is the Supercite tag on the attribution line. - (let ((atts gnus-cite-loose-attribution-alist) - (case-fold-search t) - att wrote in prefix tag regexp limit smallest best size) - (while atts - (setq att (car atts) - atts (cdr atts) - wrote (nth 0 att) - in (nth 1 att) - prefix (nth 2 att) - tag (nth 3 att) - regexp (if fun (funcall fun prefix tag) "") - size (cond ((eq sort 'small) t) - ((eq sort 'first) nil) - (t (< (length (gnus-cite-find-loose prefix)) 2))) - limit (if after wrote -1) - smallest 1000000 - best nil) - (let ((cites gnus-cite-loose-prefix-alist) - cite candidate numbers first compare) - (while cites - (setq cite (car cites) - cites (cdr cites) - candidate (car cite) - numbers (cdr cite) - first (apply 'min numbers) - compare (if size (length candidate) first)) - (and (> first limit) - regexp - (string-match regexp candidate) - (< compare smallest) - (setq best cite - smallest compare)))) - (if (null best) - () - (setq gnus-cite-loose-attribution-alist - (delq att gnus-cite-loose-attribution-alist)) - (push (cons wrote (car best)) gnus-cite-attribution-alist) - (when in - (push (cons in (car best)) gnus-cite-attribution-alist)) - (when (memq best gnus-cite-loose-prefix-alist) - (let ((loop gnus-cite-prefix-alist) - (numbers (cdr best)) - current) - (setq gnus-cite-loose-prefix-alist - (delq best gnus-cite-loose-prefix-alist)) - (while loop - (setq current (car loop) - loop (cdr loop)) - (if (eq current best) - () - (setcdr current (gnus-set-difference (cdr current) numbers)) - (when (null (cdr current)) - (setq gnus-cite-loose-prefix-alist - (delq current gnus-cite-loose-prefix-alist) - atts (delq current atts))))))))))) - -(defun gnus-cite-find-loose (prefix) - ;; Return a list of loose attribution lines prefixed by PREFIX. - (let* ((atts gnus-cite-loose-attribution-alist) - att line lines) - (while atts - (setq att (car atts) - line (car att) - atts (cdr atts)) - (when (string-equal (gnus-cite-find-prefix line) prefix) - (push line lines))) - lines)) - -(defun gnus-cite-add-face (number prefix face) - ;; At line NUMBER, ignore PREFIX and add FACE to the rest of the line. - (when face - (let ((inhibit-point-motion-hooks t) - from to overlay) - (goto-char (point-min)) - (when (zerop (forward-line (1- number))) - (forward-char (length prefix)) - (skip-chars-forward " \t") - (setq from (point)) - (end-of-line 1) - (skip-chars-backward " \t") - (setq to (point)) - (when (< from to) - (push (setq overlay (gnus-make-overlay from to)) - gnus-cite-overlay-list) - (gnus-overlay-put overlay 'evaporate t) - (gnus-overlay-put overlay 'face face)))))) - -(defun gnus-cite-toggle (prefix) - (save-excursion - (set-buffer gnus-article-buffer) - (gnus-cite-parse-maybe nil t) - (let ((buffer-read-only nil) - (numbers (cdr (assoc prefix gnus-cite-prefix-alist))) - (inhibit-point-motion-hooks t) - number) - (while numbers - (setq number (car numbers) - numbers (cdr numbers)) - (goto-char (point-min)) - (forward-line (1- number)) - (cond ((get-text-property (point) 'invisible) - ;; Can't remove 'cite from g-a-wash-types here because - ;; multiple citations may be hidden -jas - (remove-text-properties (point) (progn (forward-line 1) (point)) - gnus-hidden-properties)) - ((assq number gnus-cite-attribution-alist)) - (t - (gnus-add-wash-type 'cite) - (gnus-add-text-properties - (point) (progn (forward-line 1) (point)) - (nconc (list 'article-type 'cite) - gnus-hidden-properties)))) - (let ((gnus-article-mime-handle-alist-1 - gnus-article-mime-handle-alist)) - (gnus-set-mode-line 'article)))))) - -(defun gnus-cite-find-prefix (line) - ;; Return citation prefix for LINE. - (let ((alist gnus-cite-prefix-alist) - (prefix "") - entry) - (while alist - (setq entry (car alist) - alist (cdr alist)) - (when (memq line (cdr entry)) - (setq prefix (car entry)))) - prefix)) - -(defun gnus-cite-localize () - "Make the citation variables local to the article buffer." - (let ((vars '(gnus-cite-article - gnus-cite-overlay-list gnus-cite-prefix-alist - gnus-cite-attribution-alist gnus-cite-loose-prefix-alist - gnus-cite-loose-attribution-alist))) - (while vars - (make-local-variable (pop vars))))) - -(defun gnus-cited-line-p () - "Say whether the current line is a cited line." - (save-excursion - (beginning-of-line) - (let ((found nil)) - (dolist (prefix (mapcar 'car gnus-cite-prefix-alist)) - (when (string= (buffer-substring (point) (+ (length prefix) (point))) - prefix) - (setq found t))) - found))) - -(gnus-ems-redefine) - -(provide 'gnus-cite) - -;; Local Variables: -;; coding: iso-8859-1 -;; End: - -;;; arch-tag: 1997b044-6067-471e-8c8f-dc903093098a -;;; gnus-cite.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-cus.el b/xemacs-packages/gnus/lisp/gnus-cus.el deleted file mode 100644 index 2afabf70..00000000 --- a/xemacs-packages/gnus/lisp/gnus-cus.el +++ /dev/null @@ -1,1126 +0,0 @@ -;;; gnus-cus.el --- customization commands for Gnus - -;; Copyright (C) 1996, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Per Abrahamsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(require 'wid-edit) -(require 'gnus) -(require 'gnus-agent) -(require 'gnus-score) -(require 'gnus-topic) -(require 'gnus-art) - -;;; Widgets: - -(defun gnus-custom-mode () - "Major mode for editing Gnus customization buffers. - -The following commands are available: - -\\[widget-forward] Move to next button or editable field. -\\[widget-backward] Move to previous button or editable field. -\\[widget-button-click] Activate button under the mouse pointer. -\\[widget-button-press] Activate button under point. - -Entry to this mode calls the value of `gnus-custom-mode-hook' -if that value is non-nil." - (kill-all-local-variables) - (setq major-mode 'gnus-custom-mode - mode-name "Gnus Customize") - (use-local-map widget-keymap) - ;; Emacs 21 stuff: - (when (and (facep 'custom-button-face) - (facep 'custom-button-pressed-face)) - (set (make-local-variable 'widget-button-face) - 'custom-button-face) - (set (make-local-variable 'widget-button-pressed-face) - 'custom-button-pressed-face) - (set (make-local-variable 'widget-mouse-face) - 'custom-button-pressed-face)) - (when (and (boundp 'custom-raised-buttons) - (symbol-value 'custom-raised-buttons)) - (set (make-local-variable 'widget-push-button-prefix) "") - (set (make-local-variable 'widget-push-button-suffix) "") - (set (make-local-variable 'widget-link-prefix) "") - (set (make-local-variable 'widget-link-suffix) "")) - (gnus-run-mode-hooks 'gnus-custom-mode-hook)) - -;;; Group Customization: - -(defconst gnus-group-parameters - '((extra-aliases (choice - :tag "Extra Aliases" - (list - :tag "List" - (editable-list - :inline t - (gnus-email-address :tag "Address"))) - (gnus-email-address :tag "Address")) "\ -Store messages posted from or to this address in this group. - -You must be using gnus-group-split for this to work. The VALUE of the -nnmail-split-fancy SPLIT generated for this group will match these -addresses.") - - (split-regexp (regexp :tag "gnus-group-split Regular Expression") "\ -Like gnus-group-split Address, but expects a regular expression.") - - (split-exclude (list :tag "gnus-group-split Restricts" - (editable-list - :inline t (regexp :tag "Restrict"))) "\ -Regular expression that cancels gnus-group-split matches. - -Each entry is added to the nnmail-split-fancy SPLIT as a separate -RESTRICT clause.") - - (split-spec (choice :tag "gnus-group-split Overrider" - (sexp :tag "Fancy Split") - (const :tag "Catch All" catch-all) - (const :tag "Ignore" nil)) "\ -Override all other gnus-group-split fields. - -In `Fancy Split', you can enter any nnmail-split-fancy SPLIT. Note -that the name of this group won't be automatically assumed, you have -to add it to the SPLITs yourself. This means you can use such splits -to split messages to other groups too. - -If you select `Catch All', this group will get postings for any -messages not matched in any other group. It overrides the variable -gnus-group-split-default-catch-all-group. - -Selecting `Ignore' forces no SPLIT to be generated for this group, -disabling all other gnus-group-split fields.") - - (broken-reply-to (const :tag "Broken Reply To" t) "\ -Ignore `Reply-To' headers in this group. - -That can be useful if you're reading a mailing list group where the -listserv has inserted `Reply-To' headers that point back to the -listserv itself. This is broken behavior. So there!") - - (to-group (string :tag "To Group") "\ -All posts will be sent to the specified group.") - - (gcc-self (choice :tag "GCC" - :value t - (const :tag "To current group" t) - (const none) - (string :format "%v" :hide-front-space t)) "\ -Specify default value for GCC header. - -If this symbol is present in the group parameter list and set to t, -new composed messages will be `Gcc''d to the current group. If it is -present and set to `none', no `Gcc:' header will be generated, if it -is present and a string, this string will be inserted literally as a -`gcc' header (this symbol takes precedence over any default `Gcc' -rules as described later).") - - (expiry-wait (choice :tag "Expire Wait" - :value never - (const never) - (const immediate) - (number :hide-front-space t - :format "%v")) "\ -When to expire. - -Overrides any `nnmail-expiry-wait' and `nnmail-expiry-wait-function' -when expiring expirable messages. The value can either be a number of -days (not necessarily an integer) or the symbols `never' or -`immediate'.") - - (expiry-target (choice :tag "Expiry Target" - :value delete - (const delete) - (function :format "%v" nnmail-) - string) "\ -Where expired messages end up. - -Overrides `nnmail-expiry-target'.") - - (score-file (file :tag "Score File") "\ -Make the specified file into the current score file. -This means that all score commands you issue will end up in this file.") - - (adapt-file (file :tag "Adapt File") "\ -Make the specified file into the current adaptive file. -All adaptive score entries will be put into this file.") - - (admin-address (gnus-email-address :tag "Admin Address") "\ -Administration address for a mailing list. - -When unsubscribing to a mailing list you should never send the -unsubscription notice to the mailing list itself. Instead, you'd -send messages to the administrative address. This parameter allows -you to put the admin address somewhere convenient.") - - (display (choice :tag "Display" - :value default - (const all) - (integer) - (const default) - (sexp :tag "Other")) "\ -Which articles to display on entering the group. - -`all' - Display all articles, both read and unread. - -`integer' - Display the last NUMBER articles in the group. This is the same as - entering the group with C-u NUMBER. - -`default' - Display the default visible articles, which normally includes - unread and ticked articles. - -`Other' - Display the articles that satisfy the S-expression. The S-expression - should be in an array form.") - - (comment (string :tag "Comment") "\ -An arbitrary comment on the group.") - - (visible (const :tag "Permanently visible" t) "\ -Always display this group, even when there are no unread articles in it.") - - (highlight-words - (choice :tag "Highlight words" - :value nil - (repeat (list (regexp :tag "Highlight regexp") - (number :tag "Group for entire word" 0) - (number :tag "Group for displayed part" 0) - (symbol :tag "Face" - gnus-emphasis-highlight-words)))) - "highlight regexps. -See `gnus-emphasis-alist'.") - - (posting-style - (choice :tag "Posting style" - :value nil - (repeat (list - (choice :tag "Type" - :value nil - (const signature) - (const signature-file) - (const organization) - (const address) - (const x-face-file) - (const name) - (const body) - (symbol) - (string :tag "Header")) - (string :format "%v")))) - "post style. -See `gnus-posting-styles'.")) - "Alist of valid group or topic parameters. - -Each entry has the form (NAME TYPE DOC), where NAME is the parameter -itself (a symbol), TYPE is the parameters type (a sexp widget), and -DOC is a documentation string for the parameter.") - -(defconst gnus-extra-topic-parameters - '((subscribe (regexp :tag "Subscribe") "\ -If `gnus-subscribe-newsgroup-method' or -`gnus-subscribe-options-newsgroup-method' is set to -`gnus-subscribe-topics', new groups that matches this regexp will -automatically be subscribed to this topic") - (subscribe-level (integer :tag "Subscribe Level" :value 1) "\ -If this topic parameter is set, when new groups are subscribed -automatically under this topic (via the `subscribe' topic parameter) -assign this level to the group, rather than the default level -set in `gnus-level-default-subscribed'")) - "Alist of topic parameters that are not also group parameters. - -Each entry has the form (NAME TYPE DOC), where NAME is the parameter -itself (a symbol), TYPE is the parameters type (a sexp widget), and -DOC is a documentation string for the parameter.") - -(defconst gnus-extra-group-parameters - '((uidvalidity (string :tag "IMAP uidvalidity") "\ -Server-assigned value attached to IMAP groups, used to maintain consistency.")) - "Alist of group parameters that are not also topic parameters. - -Each entry has the form (NAME TYPE DOC), where NAME is the parameter -itself (a symbol), TYPE is the parameters type (a sexp widget), and -DOC is a documentation string for the parameter.") - -(eval-and-compile - (defconst gnus-agent-parameters - '((agent-predicate - (sexp :tag "Selection Predicate" :value false) - "Predicate used to automatically select articles for downloading." - gnus-agent-cat-predicate) - (agent-score - (choice :tag "Score File" :value nil - (const file :tag "Use group's score files") - (repeat (list (string :format "%v" :tag "File name")))) - "Which score files to use when using score to select articles to fetch. - - `nil' - All articles will be scored to zero (0). - - `file' - The group's score files will be used to score the articles. - - `List' - A list of score file names." - gnus-agent-cat-score-file) - (agent-short-article - (integer :tag "Max Length of Short Article" :value "") - "The SHORT predicate will evaluate to true when the article is -shorter than this length." gnus-agent-cat-length-when-short) - (agent-long-article - (integer :tag "Min Length of Long Article" :value "") - "The LONG predicate will evaluate to true when the article is -longer than this length." gnus-agent-cat-length-when-long) - (agent-low-score - (integer :tag "Low Score Limit" :value "") - "The LOW predicate will evaluate to true when the article scores -lower than this limit." gnus-agent-cat-low-score) - (agent-high-score - (integer :tag "High Score Limit" :value "") - "The HIGH predicate will evaluate to true when the article scores -higher than this limit." gnus-agent-cat-high-score) - (agent-days-until-old - (integer :tag "Days Until Old" :value "") - "The OLD predicate will evaluate to true when the fetched article -has been stored locally for at least this many days." - gnus-agent-cat-days-until-old) - (agent-enable-expiration - (radio :tag "Expire in this Group or Topic" :value nil - (const :format "Enable " ENABLE) - (const :format "Disable " DISABLE)) - "\nEnable, or disable, agent expiration in this group or topic." - gnus-agent-cat-enable-expiration) - (agent-enable-undownloaded-faces - (boolean :tag "Enable Agent Faces") - "Have the summary buffer use the agent's undownloaded faces. -These faces, when enabled, act as a warning that an article has not -been fetched into either the agent nor the cache. This is of most use -to users who use the agent as a cache (i.e. they only operate on -articles that have been downloaded). Leave disabled to display normal -article faces even when the article hasn't been downloaded." -gnus-agent-cat-enable-undownloaded-faces)) - "Alist of group parameters that are not also topic parameters. - -Each entry has the form (NAME TYPE DOC ACCESSOR), where NAME is the -parameter itself (a symbol), TYPE is the parameters type (a sexp -widget), DOC is a documentation string for the parameter, and ACCESSOR -is a function (symbol) that extracts the current value from the -category.")) - -(defvar gnus-custom-params) -(defvar gnus-custom-method) -(defvar gnus-custom-group) -(defvar gnus-custom-topic) - -(defun gnus-group-customize (group &optional topic) - "Edit the group or topic on the current line." - (interactive (list (gnus-group-group-name) (gnus-group-topic-name))) - (let (info - (types (mapcar (lambda (entry) - `(cons :format "%v%h\n" - :doc ,(nth 2 entry) - (const :format "" ,(nth 0 entry)) - ,(nth 1 entry))) - (append (reverse gnus-group-parameters-more) - gnus-group-parameters - (if group - gnus-extra-group-parameters - gnus-extra-topic-parameters)))) - (agent (mapcar (lambda (entry) - (let ((type (nth 1 entry)) - vcons) - (if (listp type) - (setq type (copy-sequence type))) - - (setq vcons (cdr (memq :value type))) - - (if (symbolp (car vcons)) - (condition-case nil - (setcar vcons (symbol-value (car vcons))) - (error))) - `(cons :format "%v%h\n" - :doc ,(nth 2 entry) - (const :format "" ,(nth 0 entry)) - ,type))) - (if gnus-agent - gnus-agent-parameters)))) - (unless (or group topic) - (error "No group on current line")) - (when (and group topic) - (error "Both a group an topic on current line")) - (unless (or topic (setq info (gnus-get-info group))) - (error "Killed group; can't be edited")) - ;; Ready. - (gnus-kill-buffer (gnus-get-buffer-create "*Gnus Customize*")) - (switch-to-buffer (gnus-get-buffer-create "*Gnus Customize*")) - (gnus-custom-mode) - (make-local-variable 'gnus-custom-group) - (setq gnus-custom-group group) - (make-local-variable 'gnus-custom-topic) - (setq gnus-custom-topic topic) - (buffer-disable-undo) - (widget-insert "Customize the ") - (if group - (widget-create 'info-link - :help-echo "Push me to learn more." - :tag "group parameters" - "(gnus)Group Parameters") - (widget-create 'info-link - :help-echo "Push me to learn more." - :tag "topic parameters" - "(gnus)Topic Parameters")) - (widget-insert " for <") - (widget-insert (gnus-group-decoded-name (or group topic))) - (widget-insert "> and press ") - (widget-create 'push-button - :tag "done" - :help-echo "Push me when done customizing." - :action 'gnus-group-customize-done) - (widget-insert ".\n\n") - (make-local-variable 'gnus-custom-params) - - (let ((values (if group - (gnus-info-params info) - (gnus-topic-parameters topic)))) - - ;; The parameters in values may contain duplicates. This is - ;; normally OK as assq returns the first. However, right here - ;; every duplicate ends up being displayed. So, rather than - ;; display them, remove them from the list. - - (let ((tmp (setq values (gnus-copy-sequence values))) - elem) - (while (cdr tmp) - (while (setq elem (assq (caar tmp) (cdr tmp))) - (delq elem tmp)) - (setq tmp (cdr tmp)))) - - (setq gnus-custom-params - (apply 'widget-create 'group - :value values - (delq nil - (list `(set :inline t - :greedy t - :tag "Parameters" - :format "%t:\n%h%v" - :doc "\ -These special parameters are recognized by Gnus. -Check the [ ] for the parameters you want to apply to this group or -to the groups in this topic, then edit the value to suit your taste." - ,@types) - (when gnus-agent - `(set :inline t - :greedy t - :tag "Agent Parameters" - :format "%t:\n%h%v" - :doc "\ These agent parameters are -recognized by Gnus. They control article selection and expiration for -use in the unplugged cache. Check the [ ] for the parameters you want -to apply to this group or to the groups in this topic, then edit the -value to suit your taste. - -For those interested, group parameters override topic parameters while -topic parameters override agent category parameters. Underlying -category parameters are the customizable variables." ,@agent)) - '(repeat :inline t - :tag "Variables" - :format "%t:\n%h%v%i\n\n" - :doc "\ -Set variables local to the group you are entering. - -If you want to turn threading off in `news.answers', you could put -`(gnus-show-threads nil)' in the group parameters of that group. -`gnus-show-threads' will be made into a local variable in the summary -buffer you enter, and the form nil will be `eval'ed there. - -This can also be used as a group-specific hook function, if you'd -like. If you want to hear a beep when you enter a group, you could -put something like `(dummy-variable (ding))' in the parameters of that -group. `dummy-variable' will be set to the result of the `(ding)' -form, but who cares?" - (list :format "%v" :value (nil nil) - (symbol :tag "Variable") - (sexp :tag - "Value"))) - - '(repeat :inline t - :tag "Unknown entries" - sexp)))))) - (when group - (widget-insert "\n\nYou can also edit the ") - (widget-create 'info-link - :tag "select method" - :help-echo "Push me to learn more about select methods." - "(gnus)Select Methods") - (widget-insert " for the group.\n") - (setq gnus-custom-method - (widget-create 'sexp - :tag "Method" - :value (gnus-info-method info)))) - (use-local-map widget-keymap) - (widget-setup) - (buffer-enable-undo) - (goto-char (point-min)))) - -(defun gnus-group-customize-done (&rest ignore) - "Apply changes and bury the buffer." - (interactive) - (if gnus-custom-topic - (gnus-topic-set-parameters gnus-custom-topic - (widget-value gnus-custom-params)) - (gnus-group-edit-group-done 'params gnus-custom-group - (widget-value gnus-custom-params)) - (gnus-group-edit-group-done 'method gnus-custom-group - (widget-value gnus-custom-method))) - (bury-buffer)) - -;;; Score Customization: - -(defconst gnus-score-parameters - '((mark (number :tag "Mark") "\ -The value of this entry should be a number. -Any articles with a score lower than this number will be marked as read.") - - (expunge (number :tag "Expunge") "\ -The value of this entry should be a number. -Any articles with a score lower than this number will be removed from -the summary buffer.") - - (mark-and-expunge (number :tag "Mark-and-expunge") "\ -The value of this entry should be a number. -Any articles with a score lower than this number will be marked as -read and removed from the summary buffer.") - - (thread-mark-and-expunge (number :tag "Thread-mark-and-expunge") "\ -The value of this entry should be a number. -All articles that belong to a thread that has a total score below this -number will be marked as read and removed from the summary buffer. -`gnus-thread-score-function' says how to compute the total score -for a thread.") - - (files (repeat :inline t :tag "Files" file) "\ -The value of this entry should be any number of file names. -These files are assumed to be score files as well, and will be loaded -the same way this one was.") - - (exclude-files (repeat :inline t :tag "Exclude-files" file) "\ -The clue of this entry should be any number of files. -These files will not be loaded, even though they would normally be so, -for some reason or other.") - - (eval (sexp :tag "Eval" :value nil) "\ -The value of this entry will be `eval'el. -This element will be ignored when handling global score files.") - - (read-only (boolean :tag "Read-only" :value t) "\ -Read-only score files will not be updated or saved. -Global score files should feature this atom.") - - (orphan (number :tag "Orphan") "\ -The value of this entry should be a number. -Articles that do not have parents will get this number added to their -scores. Imagine you follow some high-volume newsgroup, like -`comp.lang.c'. Most likely you will only follow a few of the threads, -also want to see any new threads. - -You can do this with the following two score file entries: - - (orphan -500) - (mark-and-expunge -100) - -When you enter the group the first time, you will only see the new -threads. You then raise the score of the threads that you find -interesting (with `I T' or `I S'), and ignore (`C y') the rest. -Next time you enter the group, you will see new articles in the -interesting threads, plus any new threads. - -I.e.---the orphan score atom is for high-volume groups where there -exist a few interesting threads which can't be found automatically -by ordinary scoring rules.") - - (adapt (choice :tag "Adapt" - (const t) - (const ignore) - (sexp :format "%v" - :hide-front-space t)) "\ -This entry controls the adaptive scoring. -If it is t, the default adaptive scoring rules will be used. If it -is `ignore', no adaptive scoring will be performed on this group. If -it is a list, this list will be used as the adaptive scoring rules. -If it isn't present, or is something other than t or `ignore', the -default adaptive scoring rules will be used. If you want to use -adaptive scoring on most groups, you'd set `gnus-use-adaptive-scoring' -to t, and insert an `(adapt ignore)' in the groups where you do not -want adaptive scoring. If you only want adaptive scoring in a few -groups, you'd set `gnus-use-adaptive-scoring' to nil, and insert -`(adapt t)' in the score files of the groups where you want it.") - - (adapt-file (file :tag "Adapt-file") "\ -All adaptive score entries will go to the file named by this entry. -It will also be applied when entering the group. This atom might -be handy if you want to adapt on several groups at once, using the -same adaptive file for a number of groups.") - - (local (repeat :tag "Local" - (group :value (nil nil) - (symbol :tag "Variable") - (sexp :tag "Value"))) "\ -The value of this entry should be a list of `(VAR VALUE)' pairs. -Each VAR will be made buffer-local to the current summary buffer, -and set to the value specified. This is a convenient, if somewhat -strange, way of setting variables in some groups if you don't like -hooks much.") - (touched (sexp :format "Touched\n") "Internal variable.")) - "Alist of valid symbolic score parameters. - -Each entry has the form (NAME TYPE DOC), where NAME is the parameter -itself (a symbol), TYPE is the parameters type (a sexp widget), and DOC is a -documentation string for the parameter.") - -(define-widget 'gnus-score-string 'group - "Edit score entries for string-valued headers." - :convert-widget 'gnus-score-string-convert) - -(defun gnus-score-string-convert (widget) - ;; Set args appropriately. - (let* ((tag (widget-get widget :tag)) - (item `(const :format "" :value ,(downcase tag))) - (match '(string :tag "Match")) - (score '(choice :tag "Score" - (const :tag "default" nil) - (integer :format "%v" - :hide-front-space t))) - (expire '(choice :tag "Expire" - (const :tag "off" nil) - (integer :format "%v" - :hide-front-space t))) - (type '(choice :tag "Type" - :value s - ;; I should really create a forgiving :match - ;; function for each type below, that only - ;; looked at the first letter. - (const :tag "Regexp" r) - (const :tag "Regexp (fixed case)" R) - (const :tag "Substring" s) - (const :tag "Substring (fixed case)" S) - (const :tag "Exact" e) - (const :tag "Exact (fixed case)" E) - (const :tag "Word" w) - (const :tag "Word (fixed case)" W) - (const :tag "default" nil))) - (group `(group ,match ,score ,expire ,type)) - (doc (concat (or (widget-get widget :doc) - (concat "Change score based on the " tag - " header.\n")) - " -You can have an arbitrary number of score entries for this header, -each score entry has four elements: - -1. The \"match element\". This should be the string to look for in the - header. - -2. The \"score element\". This number should be an integer in the - neginf to posinf interval. This number is added to the score - of the article if the match is successful. If this element is - not present, the `gnus-score-interactive-default-score' number - will be used instead. This is 1000 by default. - -3. The \"date element\". This date says when the last time this score - entry matched, which provides a mechanism for expiring the - score entries. It this element is not present, the score - entry is permanent. The date is represented by the number of - days since December 31, 1 ce. - -4. The \"type element\". This element specifies what function should - be used to see whether this score entry matches the article. - - There are the regexp, as well as substring types, and exact match, - and word match types. If this element is not present, Gnus will - assume that substring matching should be used. There is case - sensitive variants of all match types."))) - (widget-put widget :args `(,item - (repeat :inline t - :indent 0 - :tag ,tag - :doc ,doc - :format "%t:\n%h%v%i\n\n" - (choice :format "%v" - :value ("" nil nil s) - ,group - sexp))))) - widget) - -(define-widget 'gnus-score-integer 'group - "Edit score entries for integer-valued headers." - :convert-widget 'gnus-score-integer-convert) - -(defun gnus-score-integer-convert (widget) - ;; Set args appropriately. - (let* ((tag (widget-get widget :tag)) - (item `(const :format "" :value ,(downcase tag))) - (match '(integer :tag "Match")) - (score '(choice :tag "Score" - (const :tag "default" nil) - (integer :format "%v" - :hide-front-space t))) - (expire '(choice :tag "Expire" - (const :tag "off" nil) - (integer :format "%v" - :hide-front-space t))) - (type '(choice :tag "Type" - :value < - (const <) - (const >) - (const =) - (const >=) - (const <=))) - (group `(group ,match ,score ,expire ,type)) - (doc (concat (or (widget-get widget :doc) - (concat "Change score based on the " tag - " header."))))) - (widget-put widget :args `(,item - (repeat :inline t - :indent 0 - :tag ,tag - :doc ,doc - :format "%t:\n%h%v%i\n\n" - ,group)))) - widget) - -(define-widget 'gnus-score-date 'group - "Edit score entries for date-valued headers." - :convert-widget 'gnus-score-date-convert) - -(defun gnus-score-date-convert (widget) - ;; Set args appropriately. - (let* ((tag (widget-get widget :tag)) - (item `(const :format "" :value ,(downcase tag))) - (match '(string :tag "Match")) - (score '(choice :tag "Score" - (const :tag "default" nil) - (integer :format "%v" - :hide-front-space t))) - (expire '(choice :tag "Expire" - (const :tag "off" nil) - (integer :format "%v" - :hide-front-space t))) - (type '(choice :tag "Type" - :value regexp - (const regexp) - (const before) - (const at) - (const after))) - (group `(group ,match ,score ,expire ,type)) - (doc (concat (or (widget-get widget :doc) - (concat "Change score based on the " tag - " header.")) - " -For the Date header we have three kinda silly match types: `before', -`at' and `after'. I can't really imagine this ever being useful, but, -like, it would feel kinda silly not to provide this function. Just in -case. You never know. Better safe than sorry. Once burnt, twice -shy. Don't judge a book by its cover. Never not have sex on a first -date. (I have been told that at least one person, and I quote, -\"found this function indispensable\", however.) - -A more useful match type is `regexp'. With it, you can match the date -string using a regular expression. The date is normalized to ISO8601 -compact format first---`YYYYMMDDTHHMMSS'. If you want to match all -articles that have been posted on April 1st in every year, you could -use `....0401.........' as a match string, for instance. (Note that -the date is kept in its original time zone, so this will match -articles that were posted when it was April 1st where the article was -posted from. Time zones are such wholesome fun for the whole family, -eh?"))) - (widget-put widget :args `(,item - (repeat :inline t - :indent 0 - :tag ,tag - :doc ,doc - :format "%t:\n%h%v%i\n\n" - ,group)))) - widget) - -(define-widget 'gnus-score-extra 'group - "Edit score entries for extra headers." - :convert-widget 'gnus-score-extra-convert) - -(defun gnus-score-extra-convert (widget) - ;; Set args appropriately. - (let* ((tag (widget-get widget :tag)) - (item `(const :format "" :value ,(downcase tag))) - (match '(string :tag "Match")) - (score '(choice :tag "Score" - (const :tag "default" nil) - (integer :format "%v" - :hide-front-space t))) - (expire '(choice :tag "Expire" - (const :tag "off" nil) - (integer :format "%v" - :hide-front-space t))) - (type '(choice :tag "Type" - :value s - ;; I should really create a forgiving :match - ;; function for each type below, that only - ;; looked at the first letter. - (const :tag "Regexp" r) - (const :tag "Regexp (fixed case)" R) - (const :tag "Substring" s) - (const :tag "Substring (fixed case)" S) - (const :tag "Exact" e) - (const :tag "Exact (fixed case)" E) - (const :tag "Word" w) - (const :tag "Word (fixed case)" W) - (const :tag "default" nil))) - (header (if gnus-extra-headers - (let (name) - `(choice :tag "Header" - ,@(mapcar (lambda (h) - (setq name (symbol-name h)) - (list 'const :tag name name)) - gnus-extra-headers) - (string :tag "Other" :format "%v"))) - '(string :tag "Header"))) - (group `(group ,match ,score ,expire ,type ,header)) - (doc (concat (or (widget-get widget :doc) - (concat "Change score based on the " tag - " header.\n"))))) - (widget-put - widget :args - `(,item - (repeat :inline t - :indent 0 - :tag ,tag - :doc ,doc - :format "%t:\n%h%v%i\n\n" - (choice :format "%v" - :value ("" nil nil s - ,(if gnus-extra-headers - (symbol-name (car gnus-extra-headers)) - "")) - ,group - sexp))))) - widget) - -(defvar gnus-custom-scores) -(defvar gnus-custom-score-alist) - -(defun gnus-score-customize (file) - "Customize score file FILE. -When called interactively, FILE defaults to the current score file. -This can be changed using the `\\[gnus-score-change-score-file]' command." - (interactive (list gnus-current-score-file)) - (unless file - (error "No score file for %s" - (gnus-group-decoded-name gnus-newsgroup-name))) - (let ((scores (gnus-score-load file)) - (types (mapcar (lambda (entry) - `(group :format "%v%h\n" - :doc ,(nth 2 entry) - (const :format "" ,(nth 0 entry)) - ,(nth 1 entry))) - gnus-score-parameters))) - ;; Ready. - (kill-buffer (gnus-get-buffer-create "*Gnus Customize*")) - (switch-to-buffer (gnus-get-buffer-create "*Gnus Customize*")) - (gnus-custom-mode) - (make-local-variable 'gnus-custom-score-alist) - (setq gnus-custom-score-alist scores) - (widget-insert "Customize the ") - (widget-create 'info-link - :help-echo "Push me to learn more." - :tag "score entries" - "(gnus)Score File Format") - (widget-insert " for\n\t") - (widget-insert file) - (widget-insert "\nand press ") - (widget-create 'push-button - :tag "done" - :help-echo "Push me when done customizing." - :action 'gnus-score-customize-done) - (widget-insert ".\n -Check the [ ] for the entries you want to apply to this score file, then -edit the value to suit your taste. Don't forget to mark the checkbox, -if you do all your changes will be lost. ") - (widget-create 'push-button - :action (lambda (&rest ignore) - (require 'gnus-audio) - (gnus-audio-play "Evil_Laugh.au")) - "Bhahahah!") - (widget-insert "\n\n") - (make-local-variable 'gnus-custom-scores) - (setq gnus-custom-scores - (widget-create 'group - :value scores - `(checklist :inline t - :greedy t - (gnus-score-string :tag "From") - (gnus-score-string :tag "Subject") - (gnus-score-string :tag "References") - (gnus-score-string :tag "Xref") - (gnus-score-extra :tag "Extra") - (gnus-score-string :tag "Message-ID") - (gnus-score-integer :tag "Lines") - (gnus-score-integer :tag "Chars") - (gnus-score-date :tag "Date") - (gnus-score-string :tag "Head" - :doc "\ -Match all headers in the article. - -Using one of `Head', `Body', `All' will slow down scoring considerable. -") - (gnus-score-string :tag "Body" - :doc "\ -Match the body sans header of the article. - -Using one of `Head', `Body', `All' will slow down scoring considerable. -") - (gnus-score-string :tag "All" - :doc "\ -Match the entire article, including both headers and body. - -Using one of `Head', `Body', `All' will slow down scoring -considerable. -") - (gnus-score-string :tag - "Followup" - :doc "\ -Score all followups to the specified authors. - -This entry is somewhat special, in that it will match the `From:' -header, and affect the score of not only the matching articles, but -also all followups to the matching articles. This allows you -e.g. increase the score of followups to your own articles, or decrease -the score of followups to the articles of some known trouble-maker. -") - (gnus-score-string :tag "Thread" - :doc "\ -Add a score entry on all articles that are part of a thread. - -This match key works along the same lines as the `Followup' match key. -If you say that you want to score on a (sub-)thread that is started by -an article with a `Message-ID' X, then you add a `thread' match. This -will add a new `thread' match for each article that has X in its -`References' header. (These new `thread' matches will use the -`Message-ID's of these matching articles.) This will ensure that you -can raise/lower the score of an entire thread, even though some -articles in the thread may not have complete `References' headers. -Note that using this may lead to undeterministic scores of the -articles in the thread. -") - ,@types) - '(repeat :inline t - :tag "Unknown entries" - sexp))) - (use-local-map widget-keymap) - (widget-setup))) - -(defun gnus-score-customize-done (&rest ignore) - "Reset the score alist with the present value." - (let ((alist gnus-custom-score-alist) - (value (widget-value gnus-custom-scores))) - (setcar alist (car value)) - (setcdr alist (cdr value)) - (gnus-score-set 'touched '(t) alist)) - (bury-buffer)) - -(eval-when-compile - (defvar category-fields nil) - (defvar gnus-agent-cat-name) - (defvar gnus-agent-cat-score-file) - (defvar gnus-agent-cat-length-when-short) - (defvar gnus-agent-cat-length-when-long) - (defvar gnus-agent-cat-low-score) - (defvar gnus-agent-cat-high-score) - (defvar gnus-agent-cat-enable-expiration) - (defvar gnus-agent-cat-days-until-old) - (defvar gnus-agent-cat-predicate) - (defvar gnus-agent-cat-groups) - (defvar gnus-agent-cat-enable-undownloaded-faces) -) - -(defun gnus-trim-whitespace (s) - (when (string-match "\\`[ \n\t]+" s) - (setq s (substring s (match-end 0)))) - (when (string-match "[ \n\t]+\\'" s) - (setq s (substring s 0 (match-beginning 0)))) - s) - -(defmacro gnus-agent-cat-prepare-category-field (parameter) - (let* ((entry (assq parameter gnus-agent-parameters)) - (field (nth 3 entry))) - `(let* ((type (copy-sequence - (nth 1 (assq ',parameter gnus-agent-parameters)))) - (val (,field info)) - (deflt (if (,field defaults) - (concat " [" (gnus-trim-whitespace - (gnus-pp-to-string (,field defaults))) - "]"))) - symb) - - (if (eq (car type) 'radio) - (let* ((rtype (nreverse type)) - (rt rtype)) - (while (listp (or (cadr rt) 'not-list)) - (setq rt (cdr rt))) - - (setcdr rt (cons '(const :format "Inherit " nil) (cdr rt))) - (setq type (nreverse rtype)))) - - (if deflt - (let ((tag (cdr (memq :tag type)))) - (when (string-match "\n" deflt) - (while (progn (setq deflt (replace-match "\n " t t - deflt)) - (string-match "\n" deflt (match-end 0)))) - (setq deflt (concat "\n" deflt))) - - (setcar tag (concat (car tag) deflt)))) - - (widget-insert "\n") - - (setq val (if val - (widget-create type :value val) - (widget-create type)) - symb (set (make-local-variable ',field) val)) - - (widget-put symb :default val) - (widget-put symb :accessor ',field) - (push symb category-fields)))) - -(defun gnus-agent-customize-category (category) - "Edit the CATEGORY." - (interactive (list (gnus-category-name))) - (let ((info (assq category gnus-category-alist)) - (defaults (list nil '(agent-predicate . false) - (cons 'agent-enable-expiration - gnus-agent-enable-expiration) - '(agent-days-until-old . 7) - (cons 'agent-length-when-short - gnus-agent-short-article) - (cons 'agent-length-when-long gnus-agent-long-article) - (cons 'agent-low-score gnus-agent-low-score) - (cons 'agent-high-score gnus-agent-high-score)))) - - (let ((old (get-buffer "*Gnus Agent Category Customize*"))) - (when old - (gnus-kill-buffer old))) - (switch-to-buffer (gnus-get-buffer-create - "*Gnus Agent Category Customize*")) - - (let ((inhibit-read-only t)) - (gnus-custom-mode) - (buffer-disable-undo) - - (let* ((name (gnus-agent-cat-name info))) - (widget-insert "Customize the Agent Category '") - (widget-insert (symbol-name name)) - (widget-insert "' and press ") - (widget-create - 'push-button - :notify - '(lambda (&rest ignore) - (let* ((info (assq gnus-agent-cat-name gnus-category-alist)) - (widgets category-fields)) - (while widgets - (let* ((widget (pop widgets)) - (value (condition-case nil (widget-value widget) (error)))) - (eval `(setf (,(widget-get widget :accessor) ',info) - ',value))))) - (gnus-category-write) - (gnus-kill-buffer (current-buffer)) - (when (get-buffer gnus-category-buffer) - (switch-to-buffer (get-buffer gnus-category-buffer)) - (gnus-category-list))) - "Done") - (widget-insert - "\n Note: Empty fields default to the customizable global\ - variables.\n\n") - - (set (make-local-variable 'gnus-agent-cat-name) - name)) - - (set (make-local-variable 'category-fields) nil) - (gnus-agent-cat-prepare-category-field agent-predicate) - - (gnus-agent-cat-prepare-category-field agent-score) - (gnus-agent-cat-prepare-category-field agent-short-article) - (gnus-agent-cat-prepare-category-field agent-long-article) - (gnus-agent-cat-prepare-category-field agent-low-score) - (gnus-agent-cat-prepare-category-field agent-high-score) - - ;; The group list is NOT handled with - ;; gnus-agent-cat-prepare-category-field as I don't want the - ;; group list to appear when customizing a topic. - (widget-insert "\n") - - (let ((symb - (set - (make-local-variable 'gnus-agent-cat-groups) - (widget-create - `(choice - :format "%[Select Member Groups%]\n%v" :value ignore - (const :menu-tag "do not change" :tag "" :value ignore) - (checklist :entry-format "%b %v" - :menu-tag "display group selectors" - :greedy t - :value - ,(delq nil - (mapcar - (lambda (newsrc) - (car (member - (gnus-info-group newsrc) - (gnus-agent-cat-groups info)))) - (cdr gnus-newsrc-alist))) - ,@(mapcar (lambda (newsrc) - `(const ,(gnus-info-group newsrc))) - (cdr gnus-newsrc-alist)))))))) - - (widget-put symb :default (gnus-agent-cat-groups info)) - (widget-put symb :accessor 'gnus-agent-cat-groups) - (push symb category-fields)) - - (widget-insert "\nExpiration Settings ") - - (gnus-agent-cat-prepare-category-field agent-enable-expiration) - (gnus-agent-cat-prepare-category-field agent-days-until-old) - - (widget-insert "\nVisual Settings ") - - (gnus-agent-cat-prepare-category-field agent-enable-undownloaded-faces) - - (use-local-map widget-keymap) - (widget-setup) - (buffer-enable-undo)))) - -;;; The End: - -(provide 'gnus-cus) - -;;; arch-tag: a37c285a-49bc-4235-8244-804536effeaf -;;; gnus-cus.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-delay.el b/xemacs-packages/gnus/lisp/gnus-delay.el deleted file mode 100644 index cbd8bfe3..00000000 --- a/xemacs-packages/gnus/lisp/gnus-delay.el +++ /dev/null @@ -1,198 +0,0 @@ -;;; gnus-delay.el --- Delayed posting of articles - -;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Kai Großjohann -;; Keywords: mail, news, extensions - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published -;; by the Free Software Foundation; either version 3, or (at your -;; option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; Provide delayed posting of articles. - -;;; Todo: - -;; * `gnus-delay-send-queue' barfs when group does not exist. -;; * Integrate gnus-delay.el into the rest of Gnus automatically. How -;; should this be done? Basically, we need to do what -;; `gnus-delay-initialize' does. But in which files? - -;;; Code: - -(require 'nndraft) -(require 'gnus-draft) -(autoload 'parse-time-string "parse-time" nil nil) - -(defgroup gnus-delay nil - "Arrange for sending postings later." - :version "22.1" - :group 'gnus) - -(defcustom gnus-delay-group "delayed" - "Group name for storing delayed articles." - :type 'string - :group 'gnus-delay) - -(defcustom gnus-delay-header "X-Gnus-Delayed" - "Header name for storing info about delayed articles." - :type 'string - :group 'gnus-delay) - -(defcustom gnus-delay-default-delay "3d" - "*Default length of delay." - :type 'string - :group 'gnus-delay) - -(defcustom gnus-delay-default-hour 8 - "*If deadline is given as date, then assume this time of day." - :version "22.1" - :type 'integer - :group 'gnus-delay) - -;;;###autoload -(defun gnus-delay-article (delay) - "Delay this article by some time. -DELAY is a string, giving the length of the time. Possible values are: - -* for in minutes (`m'), hours (`h'), days (`d'), - weeks (`w'), months (`M'), or years (`Y'); - -* YYYY-MM-DD for a specific date. The time of day is given by the - variable `gnus-delay-default-hour', minute and second are zero. - -* hh:mm for a specific time. Use 24h format. If it is later than this - time, then the deadline is tomorrow, else today." - (interactive - (list (read-string - "Target date (YYYY-MM-DD) or length of delay (units in [mhdwMY]): " - gnus-delay-default-delay))) - (let (num unit days year month day hour minute deadline) - (cond ((string-match - "\\([0-9][0-9][0-9]?[0-9]?\\)-\\([0-9]+\\)-\\([0-9]+\\)" - delay) - (setq year (string-to-number (match-string 1 delay)) - month (string-to-number (match-string 2 delay)) - day (string-to-number (match-string 3 delay))) - (setq deadline - (message-make-date - (encode-time 0 0 ; second and minute - gnus-delay-default-hour - day month year)))) - ((string-match "\\([0-9]+\\):\\([0-9]+\\)" delay) - (setq hour (string-to-number (match-string 1 delay)) - minute (string-to-number (match-string 2 delay))) - ;; Use current time, except... - (setq deadline (apply 'vector (decode-time (current-time)))) - ;; ... for minute and hour. - (aset deadline 1 minute) - (aset deadline 2 hour) - ;; Convert to seconds. - (setq deadline (time-to-seconds (apply 'encode-time - (append deadline nil)))) - ;; If this time has passed already, add a day. - (when (< deadline (time-to-seconds (current-time))) - (setq deadline (+ 3600 deadline))) ;3600 secs/day - ;; Convert seconds to date header. - (setq deadline (message-make-date - (seconds-to-time deadline)))) - ((string-match "\\([0-9]+\\)\\s-*\\([mhdwMY]\\)" delay) - (setq num (match-string 1 delay)) - (setq unit (match-string 2 delay)) - ;; Start from seconds, then multiply into needed units. - (setq num (string-to-number num)) - (cond ((string= unit "Y") - (setq delay (* num 60 60 24 365))) - ((string= unit "M") - (setq delay (* num 60 60 24 30))) - ((string= unit "w") - (setq delay (* num 60 60 24 7))) - ((string= unit "d") - (setq delay (* num 60 60 24))) - ((string= unit "h") - (setq delay (* num 60 60))) - (t - (setq delay (* num 60)))) - (setq deadline (message-make-date - (seconds-to-time (+ (time-to-seconds (current-time)) - delay))))) - (t (error "Malformed delay `%s'" delay))) - (message-add-header (format "%s: %s" gnus-delay-header deadline))) - (set-buffer-modified-p t) - ;; If group does not exist, create it. - (let ((group (format "nndraft:%s" gnus-delay-group))) - (gnus-agent-queue-setup gnus-delay-group)) - (message-disassociate-draft) - (nndraft-request-associate-buffer gnus-delay-group) - (save-buffer 0) - (kill-buffer (current-buffer)) - (message-do-actions message-postpone-actions)) - -;;;###autoload -(defun gnus-delay-send-queue () - "Send all the delayed messages that are due now." - (interactive) - (save-excursion - (let* ((group (format "nndraft:%s" gnus-delay-group)) - (message-send-hook (copy-sequence message-send-hook)) - articles - article deadline) - (when (gnus-gethash group gnus-newsrc-hashtb) - (gnus-activate-group group) - (add-hook 'message-send-hook - '(lambda () - (message-remove-header gnus-delay-header))) - (setq articles (nndraft-articles)) - (while (setq article (pop articles)) - (gnus-request-head article group) - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (if (re-search-forward - (concat "^" (regexp-quote gnus-delay-header) ":\\s-+") - nil t) - (progn - (setq deadline (nnheader-header-value)) - (setq deadline (apply 'encode-time - (parse-time-string deadline))) - (setq deadline (time-since deadline)) - (when (and (>= (nth 0 deadline) 0) - (>= (nth 1 deadline) 0)) - (message "Sending delayed article %d" article) - (gnus-draft-send article group) - (message "Sending delayed article %d...done" article))) - (message "Delay header missing for article %d" article))))))) - -;;;###autoload -(defun gnus-delay-initialize (&optional no-keymap no-check) - "Initialize the gnus-delay package. -This sets up a key binding in `message-mode' to delay a message. -This tells Gnus to look for delayed messages after getting new news. - -The optional arg NO-KEYMAP is ignored. -Checking delayed messages is skipped if optional arg NO-CHECK is non-nil." - (unless no-check - (add-hook 'gnus-get-new-news-hook 'gnus-delay-send-queue))) - -(provide 'gnus-delay) - -;; Local Variables: -;; coding: iso-8859-1 -;; End: - -;; arch-tag: fb2ad634-a897-4142-a503-f5991ec2349d -;;; gnus-delay.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-demon.el b/xemacs-packages/gnus/lisp/gnus-demon.el deleted file mode 100644 index dbe150fe..00000000 --- a/xemacs-packages/gnus/lisp/gnus-demon.el +++ /dev/null @@ -1,329 +0,0 @@ -;;; gnus-demon.el --- daemonic Gnus behaviour - -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) -(require 'gnus-int) -(require 'nnheader) -(require 'nntp) -(require 'nnmail) -(require 'gnus-util) -(eval-and-compile - (if (featurep 'xemacs) - (require 'itimer) - (require 'timer))) - -(autoload 'parse-time-string "parse-time" nil nil) - -(defgroup gnus-demon nil - "Demonic behavior." - :group 'gnus) - -(defcustom gnus-demon-handlers nil - "Alist of daemonic handlers to be run at intervals. -Each handler is a list on the form - -\(FUNCTION TIME IDLE) - -FUNCTION is the function to be called. -TIME is the number of `gnus-demon-timestep's between each call. -If nil, never call. If t, call each `gnus-demon-timestep'. -If IDLE is t, only call if Emacs has been idle for a while. If IDLE -is a number, only call when Emacs has been idle more than this number -of `gnus-demon-timestep's. If IDLE is nil, don't care about -idleness. If IDLE is a number and TIME is nil, then call once each -time Emacs has been idle for IDLE `gnus-demon-timestep's." - :group 'gnus-demon - :type '(repeat (list function - (choice :tag "Time" - (const :tag "never" nil) - (const :tag "one" t) - (integer :tag "steps" 1)) - (choice :tag "Idle" - (const :tag "don't care" nil) - (const :tag "for a while" t) - (integer :tag "steps" 1))))) - -(defcustom gnus-demon-timestep 60 - "*Number of seconds in each demon timestep." - :group 'gnus-demon - :type 'integer) - -;;; Internal variables. - -(defvar gnus-demon-timer nil) -(defvar gnus-demon-idle-has-been-called nil) -(defvar gnus-demon-idle-time 0) -(defvar gnus-demon-handler-state nil) -(defvar gnus-demon-last-keys nil) -(defvar gnus-inhibit-demon nil - "*If non-nil, no daemonic function will be run.") - -;;; Functions. - -(defun gnus-demon-add-handler (function time idle) - "Add the handler FUNCTION to be run at TIME and IDLE." - ;; First remove any old handlers that use this function. - (gnus-demon-remove-handler function) - ;; Then add the new one. - (push (list function time idle) gnus-demon-handlers) - (gnus-demon-init)) - -(defun gnus-demon-remove-handler (function &optional no-init) - "Remove the handler FUNCTION from the list of handlers." - (gnus-pull function gnus-demon-handlers) - (unless no-init - (gnus-demon-init))) - -(defun gnus-demon-init () - "Initialize the Gnus daemon." - (interactive) - (gnus-demon-cancel) - (when gnus-demon-handlers - ;; Set up the timer. - (setq gnus-demon-timer - (nnheader-run-at-time - gnus-demon-timestep gnus-demon-timestep 'gnus-demon)) - ;; Reset control variables. - (setq gnus-demon-handler-state - (mapcar - (lambda (handler) - (list (car handler) (gnus-demon-time-to-step (nth 1 handler)) - (nth 2 handler))) - gnus-demon-handlers)) - (setq gnus-demon-idle-time 0) - (setq gnus-demon-idle-has-been-called nil))) - -(gnus-add-shutdown 'gnus-demon-cancel 'gnus) - -(defun gnus-demon-cancel () - "Cancel any Gnus daemons." - (interactive) - (when gnus-demon-timer - (nnheader-cancel-timer gnus-demon-timer)) - (setq gnus-demon-timer nil - gnus-demon-idle-has-been-called nil) - (condition-case () - (nnheader-cancel-function-timers 'gnus-demon) - (error t))) - -(defun gnus-demon-is-idle-p () - "Whether Emacs is idle or not." - ;; We do this simply by comparing the 100 most recent keystrokes - ;; with the ones we had last time. If they are the same, one might - ;; guess that Emacs is indeed idle. This only makes sense if one - ;; calls this function seldom -- like once a minute, which is what - ;; we do here. - (let ((keys (recent-keys))) - (or (equal keys gnus-demon-last-keys) - (progn - (setq gnus-demon-last-keys keys) - nil)))) - -(defun gnus-demon-time-to-step (time) - "Find out how many seconds to TIME, which is on the form \"17:43\"." - (if (not (stringp time)) - time - (let* ((now (current-time)) - ;; obtain NOW as discrete components -- make a vector for speed - (nowParts (decode-time now)) - ;; obtain THEN as discrete components - (thenParts (parse-time-string time)) - (thenHour (elt thenParts 2)) - (thenMin (elt thenParts 1)) - ;; convert time as elements into number of seconds since EPOCH. - (then (encode-time 0 - thenMin - thenHour - ;; If THEN is earlier than NOW, make it - ;; same time tomorrow. Doc for encode-time - ;; says that this is OK. - (+ (elt nowParts 3) - (if (or (< thenHour (elt nowParts 2)) - (and (= thenHour (elt nowParts 2)) - (<= thenMin (elt nowParts 1)))) - 1 0)) - (elt nowParts 4) - (elt nowParts 5) - (elt nowParts 6) - (elt nowParts 7) - (elt nowParts 8))) - ;; calculate number of seconds between NOW and THEN - (diff (+ (* 65536 (- (car then) (car now))) - (- (cadr then) (cadr now))))) - ;; return number of timesteps in the number of seconds - (round (/ diff gnus-demon-timestep))))) - -(defun gnus-demon () - "The Gnus daemon that takes care of running all Gnus handlers." - ;; Increase or reset the time Emacs has been idle. - (if (gnus-demon-is-idle-p) - (incf gnus-demon-idle-time) - (setq gnus-demon-idle-time 0) - (setq gnus-demon-idle-has-been-called nil)) - ;; Disable all daemonic stuff if we're in the minibuffer - (when (and (not (window-minibuffer-p (selected-window))) - (not gnus-inhibit-demon)) - ;; Then we go through all the handler and call those that are - ;; sufficiently ripe. - (let ((handlers gnus-demon-handler-state) - (gnus-inhibit-demon t) - ;; Try to avoid dialog boxes, e.g. by Mailcrypt. - ;; Unfortunately, Emacs 20's `message-or-box...' doesn't - ;; obey `use-dialog-box'. - use-dialog-box (last-nonmenu-event 10) - handler time idle) - (while handlers - (setq handler (pop handlers)) - (cond - ((numberp (setq time (nth 1 handler))) - ;; These handlers use a regular timeout mechanism. We decrease - ;; the timer if it hasn't reached zero yet. - (unless (zerop time) - (setcar (nthcdr 1 handler) (decf time))) - (and (zerop time) ; If the timer now is zero... - ;; Test for appropriate idleness - (progn - (setq idle (nth 2 handler)) - (cond - ((null idle) t) ; Don't care about idle. - ((numberp idle) ; Numerical idle... - (< idle gnus-demon-idle-time)) ; Idle timed out. - (t (< 0 gnus-demon-idle-time)))) ; Or just need to be idle. - ;; So we call the handler. - (gnus-with-local-quit - (ignore-errors (funcall (car handler))) - ;; And reset the timer. - (setcar (nthcdr 1 handler) - (gnus-demon-time-to-step - (nth 1 (assq (car handler) gnus-demon-handlers))))))) - ;; These are only supposed to be called when Emacs is idle. - ((null (setq idle (nth 2 handler))) - ;; We do nothing. - ) - ((and (not (numberp idle)) - (gnus-demon-is-idle-p)) - ;; We want to call this handler each and every time that - ;; Emacs is idle. - (gnus-with-local-quit - (ignore-errors (funcall (car handler))))) - (t - ;; We want to call this handler only if Emacs has been idle - ;; for a specified number of timesteps. - (and (not (memq (car handler) gnus-demon-idle-has-been-called)) - (< idle gnus-demon-idle-time) - (gnus-demon-is-idle-p) - (gnus-with-local-quit - (ignore-errors (funcall (car handler))) - ;; Make sure the handler won't be called once more in - ;; this idle-cycle. - (push (car handler) gnus-demon-idle-has-been-called))))))))) - -(defun gnus-demon-add-nocem () - "Add daemonic NoCeM handling to Gnus." - (gnus-demon-add-handler 'gnus-demon-scan-nocem 60 30)) - -(defun gnus-demon-scan-nocem () - "Scan NoCeM groups for NoCeM messages." - (save-window-excursion - (gnus-nocem-scan-groups))) - -(defun gnus-demon-add-disconnection () - "Add daemonic server disconnection to Gnus." - (gnus-demon-add-handler 'gnus-demon-close-connections nil 30)) - -(defun gnus-demon-close-connections () - (save-window-excursion - (gnus-close-backends))) - -(defun gnus-demon-add-nntp-close-connection () - "Add daemonic nntp server disconnection to Gnus. -If no commands have gone out via nntp during the last five -minutes, the connection is closed." - (gnus-demon-add-handler 'gnus-demon-nntp-close-connections 5 nil)) - -(defun gnus-demon-nntp-close-connection () - (save-window-excursion - (when (time-less-p '(0 300) (time-since nntp-last-command-time)) - (nntp-close-server)))) - -(defun gnus-demon-add-scanmail () - "Add daemonic scanning of mail from the mail backends." - (gnus-demon-add-handler 'gnus-demon-scan-mail 120 60)) - -(defun gnus-demon-scan-mail () - (save-window-excursion - (let ((servers gnus-opened-servers) - server - (nnmail-fetched-sources (list t))) - (while (setq server (car (pop servers))) - (and (gnus-check-backend-function 'request-scan (car server)) - (or (gnus-server-opened server) - (gnus-open-server server)) - (gnus-request-scan nil server)))))) - -(defun gnus-demon-add-rescan () - "Add daemonic scanning of new articles from all backends." - (gnus-demon-add-handler 'gnus-demon-scan-news 120 60)) - -(defun gnus-demon-scan-news () - (let ((win (current-window-configuration))) - (unwind-protect - (save-window-excursion - (save-excursion - (when (gnus-alive-p) - (save-excursion - (set-buffer gnus-group-buffer) - (gnus-group-get-new-news))))) - (set-window-configuration win)))) - -(defun gnus-demon-add-scan-timestamps () - "Add daemonic updating of timestamps in empty newgroups." - (gnus-demon-add-handler 'gnus-demon-scan-timestamps nil 30)) - -(defun gnus-demon-scan-timestamps () - "Set the timestamp on all newsgroups with no unread and no ticked articles." - (when (gnus-alive-p) - (let ((cur-time (current-time)) - (newsrc (cdr gnus-newsrc-alist)) - info group unread has-ticked) - (while (setq info (pop newsrc)) - (setq group (gnus-info-group info) - unread (gnus-group-unread group) - has-ticked (cdr (assq 'tick (gnus-info-marks info)))) - (when (and (numberp unread) - (= unread 0) - (not has-ticked)) - (gnus-group-set-parameter group 'timestamp cur-time)))))) - -(provide 'gnus-demon) - -;;; arch-tag: 8dd5cd3d-6ae4-46b4-9b15-f5fca09fd392 -;;; gnus-demon.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-diary.el b/xemacs-packages/gnus/lisp/gnus-diary.el deleted file mode 100644 index 30c92d7c..00000000 --- a/xemacs-packages/gnus/lisp/gnus-diary.el +++ /dev/null @@ -1,411 +0,0 @@ -;;; gnus-diary.el --- Wrapper around the NNDiary Gnus back end - -;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, -;; 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Didier Verna -;; Maintainer: Didier Verna -;; Created: Tue Jul 20 10:42:55 1999 -;; Keywords: calendar mail news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published -;; by the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - - -;;; Commentary: - -;; Contents management by FCM version 0.1. - -;; Description: -;; =========== - -;; gnus-diary is a utility toolkit used on top of the nndiary back end. It is -;; now fully documented in the Gnus manual. - - -;; Bugs / Todo: -;; =========== - - -;;; Code: - -(require 'nndiary) -(require 'message) -(require 'gnus-art) - -(defgroup gnus-diary nil - "Utilities on top of the nndiary back end for Gnus." - :version "22.1" - :group 'gnus) - -(defcustom gnus-diary-summary-line-format "%U%R%z %uD: %(%s%) (%ud)\n" - "*Summary line format for nndiary groups." - :type 'string - :group 'gnus-diary - :group 'gnus-summary-format) - -(defcustom gnus-diary-time-format "%a, %b %e %y, %H:%M" - "*Time format to display appointments in nndiary summary buffers. -Please refer to `format-time-string' for information on possible values." - :type 'string - :group 'gnus-diary) - -(defcustom gnus-diary-delay-format-function 'gnus-diary-delay-format-english - "*Function called to format a diary delay string. -It is passed two arguments. The first one is non-nil if the delay is in -the past. The second one is of the form ((NUM . UNIT) ...) where NUM is -an integer and UNIT is one of 'year 'month 'week 'day 'hour or 'minute. -It should return strings like \"In 2 months, 3 weeks\", \"3 hours, -1 minute ago\" and so on. - -There are currently two built-in format functions: -`gnus-diary-delay-format-english' (the default) -`gnus-diary-delay-format-french'" - :type '(choice (const :tag "english" gnus-diary-delay-format-english) - (const :tag "french" gnus-diary-delay-format-french) - (symbol :tag "other")) - :group 'gnus-diary) - -(defconst gnus-diary-version nndiary-version - "Current Diary back end version.") - - -;; Compatibility functions ================================================== - -(eval-and-compile - (if (fboundp 'kill-entire-line) - (defalias 'gnus-diary-kill-entire-line 'kill-entire-line) - (defun gnus-diary-kill-entire-line () - (beginning-of-line) - (let ((kill-whole-line t)) - (kill-line))))) - - -;; Summary line format ====================================================== - -(defun gnus-diary-delay-format-french (past delay) - (if (null delay) - "maintenant!" - ;; Keep only a precision of two degrees - (and (> (length delay) 1) (setcdr (cdr delay) nil)) - (concat (if past "il y a " "dans ") - (let ((str "") - del) - (while (setq del (pop delay)) - (setq str (concat str - (int-to-string (car del)) " " - (cond ((eq (cdr del) 'year) - "an") - ((eq (cdr del) 'month) - "mois") - ((eq (cdr del) 'week) - "semaine") - ((eq (cdr del) 'day) - "jour") - ((eq (cdr del) 'hour) - "heure") - ((eq (cdr del) 'minute) - "minute")) - (unless (or (eq (cdr del) 'month) - (= (car del) 1)) - "s") - (if delay ", ")))) - str)))) - - -(defun gnus-diary-delay-format-english (past delay) - (if (null delay) - "now!" - ;; Keep only a precision of two degrees - (and (> (length delay) 1) (setcdr (cdr delay) nil)) - (concat (unless past "in ") - (let ((str "") - del) - (while (setq del (pop delay)) - (setq str (concat str - (int-to-string (car del)) " " - (symbol-name (cdr del)) - (and (> (car del) 1) "s") - (if delay ", ")))) - str) - (and past " ago")))) - - -(defun gnus-diary-header-schedule (headers) - ;; Same as `nndiary-schedule', but given a set of headers HEADERS - (mapcar - (lambda (elt) - (let ((head (cdr (assoc (intern (format "X-Diary-%s" (car elt))) - headers)))) - (when head - (nndiary-parse-schedule-value head (cadr elt) (car (cddr elt)))))) - nndiary-headers)) - -;; #### NOTE: Gnus sometimes gives me a HEADER not corresponding to any -;; message, with all fields set to nil here. I don't know what it is for, and -;; I just ignore it. -;;;###autoload -(defun gnus-user-format-function-d (header) - ;; Returns an aproximative delay string for the next occurence of this - ;; message. The delay is given only in the first non zero unit. - ;; Code partly stolen from article-make-date-line - (let* ((extras (mail-header-extra header)) - (sched (gnus-diary-header-schedule extras)) - (occur (nndiary-next-occurence sched (current-time))) - (now (current-time)) - (real-time (subtract-time occur now))) - (if (null real-time) - "?????" - (let* ((sec (+ (* (float (car real-time)) 65536) (cadr real-time))) - (past (< sec 0)) - delay) - (and past (setq sec (- sec))) - (unless (zerop sec) - ;; This is a bit convoluted, but basically we go through the time - ;; units for years, weeks, etc, and divide things to see whether - ;; that results in positive answers. - (let ((units `((year . ,(* 365.25 24 3600)) - (month . ,(* 31 24 3600)) - (week . ,(* 7 24 3600)) - (day . ,(* 24 3600)) - (hour . 3600) - (minute . 60))) - unit num) - (while (setq unit (pop units)) - (unless (zerop (setq num (ffloor (/ sec (cdr unit))))) - (setq delay (append delay `((,(floor num) . ,(car unit)))))) - (setq sec (- sec (* num (cdr unit))))))) - (funcall gnus-diary-delay-format-function past delay))) - )) - -;; #### NOTE: Gnus sometimes gives me a HEADER not corresponding to any -;; message, with all fields set to nil here. I don't know what it is for, and -;; I just ignore it. -;;;###autoload -(defun gnus-user-format-function-D (header) - ;; Returns a formatted time string for the next occurence of this message. - (let* ((extras (mail-header-extra header)) - (sched (gnus-diary-header-schedule extras)) - (occur (nndiary-next-occurence sched (current-time)))) - (format-time-string gnus-diary-time-format occur))) - - -;; Article sorting functions ================================================ - -(defun gnus-article-sort-by-schedule (h1 h2) - (let* ((now (current-time)) - (e1 (mail-header-extra h1)) - (e2 (mail-header-extra h2)) - (s1 (gnus-diary-header-schedule e1)) - (s2 (gnus-diary-header-schedule e2)) - (o1 (nndiary-next-occurence s1 now)) - (o2 (nndiary-next-occurence s2 now))) - (if (and (= (car o1) (car o2)) (= (cadr o1) (cadr o2))) - (< (mail-header-number h1) (mail-header-number h2)) - (time-less-p o1 o2)))) - - -(defun gnus-thread-sort-by-schedule (h1 h2) - (gnus-article-sort-by-schedule (gnus-thread-header h1) - (gnus-thread-header h2))) - -(defun gnus-summary-sort-by-schedule (&optional reverse) - "Sort nndiary summary buffers by schedule of appointments. -Optional prefix (or REVERSE argument) means sort in reverse order." - (interactive "P") - (gnus-summary-sort 'schedule reverse)) - -(defvar gnus-summary-misc-menu) ;; Avoid byte compiler warning. -(add-hook 'gnus-summary-menu-hook - (lambda () - (easy-menu-add-item gnus-summary-misc-menu - '("Sort") - ["Sort by schedule" - gnus-summary-sort-by-schedule - (eq (car (gnus-find-method-for-group - gnus-newsgroup-name)) - 'nndiary)] - "Sort by number"))) - - - -;; Group parameters autosetting ============================================= - -(defun gnus-diary-update-group-parameters (group) - ;; Ensure that nndiary groups have convenient group parameters: - ;; - a posting style containing X-Diary headers - ;; - a nice summary line format - ;; - NNDiary specific sorting by schedule functions - ;; In general, try not to mess with what the user might have modified. - (let ((posting-style (gnus-group-get-parameter group 'posting-style t))) - ;; Posting style: - (mapcar (lambda (elt) - (let ((header (format "X-Diary-%s" (car elt)))) - (unless (assoc header posting-style) - (setq posting-style (append posting-style - `((,header "*"))))) - )) - nndiary-headers) - (gnus-group-set-parameter group 'posting-style posting-style) - ;; Summary line format: - (unless (gnus-group-get-parameter group 'gnus-summary-line-format t) - (gnus-group-set-parameter group 'gnus-summary-line-format - `(,gnus-diary-summary-line-format))) - ;; Sorting by schedule: - (unless (gnus-group-get-parameter group 'gnus-article-sort-functions) - (gnus-group-set-parameter group 'gnus-article-sort-functions - '((append gnus-article-sort-functions - (list - 'gnus-article-sort-by-schedule))))) - (unless (gnus-group-get-parameter group 'gnus-thread-sort-functions) - (gnus-group-set-parameter group 'gnus-thread-sort-functions - '((append gnus-thread-sort-functions - (list - 'gnus-thread-sort-by-schedule))))) - )) - -;; Called when a group is subscribed. This is needed because groups created -;; because of mail splitting are *not* created with the back end function. -;; Thus, `nndiary-request-create-group-hooks' is inoperative. -(defun gnus-diary-maybe-update-group-parameters (group) - (when (eq (car (gnus-find-method-for-group group)) 'nndiary) - (gnus-diary-update-group-parameters group))) - -(add-hook 'nndiary-request-create-group-hooks - 'gnus-diary-update-group-parameters) -;; Now that we have `gnus-subscribe-newsgroup-hooks', this is not needed -;; anymore. Maybe I should remove this completely. -(add-hook 'nndiary-request-update-info-hooks - 'gnus-diary-update-group-parameters) -(add-hook 'gnus-subscribe-newsgroup-hooks - 'gnus-diary-maybe-update-group-parameters) - - -;; Diary Message Checking =================================================== - -(defvar gnus-diary-header-value-history nil - ;; History variable for header value prompting - ) - -(defun gnus-diary-narrow-to-headers () - "Narrow the current buffer to the header part. -Point is left at the beginning of the region. -The buffer is assumed to contain a message, but the format is unknown." - (cond ((eq major-mode 'message-mode) - (message-narrow-to-headers)) - (t - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (narrow-to-region (point-min) (- (point) 1)) - (goto-char (point-min)))) - )) - -(defun gnus-diary-add-header (str) - "Add a header to the current buffer. -The buffer is assumed to contain a message, but the format is unknown." - (cond ((eq major-mode 'message-mode) - (message-add-header str)) - (t - (save-restriction - (gnus-diary-narrow-to-headers) - (goto-char (point-max)) - (if (string-match "\n$" str) - (insert str) - (insert str ?\n)))) - )) - -(defun gnus-diary-check-message (arg) - "Ensure that the current message is a valid for NNDiary. -This function checks that all NNDiary required headers are present and -valid, and prompts for values / correction otherwise. - -If ARG (or prefix) is non-nil, force prompting for all fields." - (interactive "P") - (save-excursion - (mapcar - (lambda (head) - (let ((header (concat "X-Diary-" (car head))) - (ask arg) - value invalid) - ;; First, try to find the header, and checks for validity: - (save-restriction - (gnus-diary-narrow-to-headers) - (when (re-search-forward (concat "^" header ":") nil t) - (unless (eq (char-after) ? ) - (insert " ")) - (setq value (buffer-substring (point) (gnus-point-at-eol))) - (and (string-match "[ \t]*\\([^ \t]+\\)[ \t]*" value) - (setq value (match-string 1 value))) - (condition-case () - (nndiary-parse-schedule-value value - (nth 1 head) (nth 2 head)) - (t - (setq invalid t))) - ;; #### NOTE: this (along with the `gnus-diary-add-header' - ;; function) could be rewritten in a better way, in particular - ;; not to blindly remove an already present header and reinsert - ;; it somewhere else afterwards. - (when (or ask invalid) - (gnus-diary-kill-entire-line)) - )) - ;; Now, loop until a valid value is provided: - (while (or ask (not value) invalid) - (let ((prompt (concat (and invalid - (prog1 "(current value invalid) " - (beep))) - header ": "))) - (setq value - (if (listp (nth 1 head)) - (completing-read prompt (cons '("*" nil) (nth 1 head)) - nil t value - gnus-diary-header-value-history) - (read-string prompt value - gnus-diary-header-value-history)))) - (setq ask nil) - (setq invalid nil) - (condition-case () - (nndiary-parse-schedule-value value - (nth 1 head) (nth 2 head)) - (t - (setq invalid t)))) - (gnus-diary-add-header (concat header ": " value)) - )) - nndiary-headers) - )) - -(add-hook 'nndiary-request-accept-article-hooks - (lambda () (gnus-diary-check-message nil))) - -(define-key message-mode-map "\C-cDc" 'gnus-diary-check-message) -(define-key gnus-article-edit-mode-map "\C-cDc" 'gnus-diary-check-message) - - -;; The end ================================================================== - -(defun gnus-diary-version () - "Current Diary back end version." - (interactive) - (message "NNDiary version %s" nndiary-version)) - -(define-key message-mode-map "\C-cDv" 'gnus-diary-version) -(define-key gnus-article-edit-mode-map "\C-cDv" 'gnus-diary-version) - - -(provide 'gnus-diary) - -;;; arch-tag: 98467e70-337e-4ddc-b92d-45d403ff1b4b -;;; gnus-diary.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-dired.el b/xemacs-packages/gnus/lisp/gnus-dired.el deleted file mode 100644 index 553c72c7..00000000 --- a/xemacs-packages/gnus/lisp/gnus-dired.el +++ /dev/null @@ -1,207 +0,0 @@ -;;; gnus-dired.el --- utility functions where gnus and dired meet - -;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Authors: Benjamin Rutt , -;; Shenghuo Zhu -;; Keywords: mail, news, extensions - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; This package provides utility functions for intersections of gnus -;; and dired. To enable the gnus-dired-mode minor mode which will -;; have the effect of installing keybindings in dired-mode, place the -;; following in your ~/.gnus: - -;; (require 'gnus-dired) ;, isn't needed due to autoload cookies -;; (add-hook 'dired-mode-hook 'turn-on-gnus-dired-mode) - -;; Note that if you visit dired buffers before your ~/.gnus file has -;; been read, those dired buffers won't have the keybindings in -;; effect. To get around that problem, you may want to add the above -;; statements to your ~/.emacs instead. - -;;; Code: - -(require 'dired) -(require 'gnus-ems) -(require 'gnus-msg) -(require 'gnus-util) -(require 'message) -(require 'mm-encode) -(require 'mml) - -(defvar gnus-dired-mode nil - "Minor mode for intersections of gnus and dired.") - -(defvar gnus-dired-mode-map nil) - -(unless gnus-dired-mode-map - (setq gnus-dired-mode-map (make-sparse-keymap)) - - (gnus-define-keys gnus-dired-mode-map - "\C-c\C-m\C-a" gnus-dired-attach - "\C-c\C-m\C-l" gnus-dired-find-file-mailcap - "\C-c\C-m\C-p" gnus-dired-print)) - -(defun gnus-dired-mode (&optional arg) - "Minor mode for intersections of gnus and dired. - -\\{gnus-dired-mode-map}" - (interactive "P") - (when (eq major-mode 'dired-mode) - (set (make-local-variable 'gnus-dired-mode) - (if (null arg) (not gnus-dired-mode) - (> (prefix-numeric-value arg) 0))) - (when gnus-dired-mode - (gnus-add-minor-mode 'gnus-dired-mode "" gnus-dired-mode-map) - (gnus-run-hooks 'gnus-dired-mode-hook)))) - -;;;###autoload -(defun turn-on-gnus-dired-mode () - "Convenience method to turn on gnus-dired-mode." - (gnus-dired-mode 1)) - -;; Method to attach files to a gnus composition. -(defun gnus-dired-attach (files-to-attach) - "Attach dired's marked files to a gnus message composition. -If called non-interactively, FILES-TO-ATTACH should be a list of -filenames." - (interactive - (list - (delq nil - (mapcar - ;; don't attach directories - (lambda (f) (if (file-directory-p f) nil f)) - (nreverse (dired-map-over-marks (dired-get-filename) nil)))))) - (let ((destination nil) - (files-str nil) - (bufs nil)) - ;; warn if user tries to attach without any files marked - (if (null files-to-attach) - (error "No files to attach") - (setq files-str - (mapconcat - (lambda (f) (file-name-nondirectory f)) - files-to-attach ", ")) - (setq bufs (message-buffers)) - - ;; set up destination message buffer - (if (and bufs - (y-or-n-p "Attach files to existing message buffer? ")) - (setq destination - (if (= (length bufs) 1) - (get-buffer (car bufs)) - (completing-read "Attach to which message buffer: " - (mapcar - (lambda (b) - (cons b (get-buffer b))) - bufs) - nil t))) - ;; setup a new gnus message buffer - (gnus-setup-message 'message (message-mail)) - (setq destination (current-buffer))) - - ;; set buffer to destination buffer, and attach files - (set-buffer destination) - (goto-char (point-max)) ;attach at end of buffer - (while files-to-attach - (mml-attach-file (car files-to-attach) - (or (mm-default-file-encoding (car files-to-attach)) - "application/octet-stream") nil) - (setq files-to-attach (cdr files-to-attach))) - (message "Attached file(s) %s" files-str)))) - -(autoload 'mailcap-parse-mailcaps "mailcap" "" t) - -(defun gnus-dired-find-file-mailcap (&optional file-name arg) - "In dired, visit FILE-NAME according to the mailcap file. -If ARG is non-nil, open it in a new buffer." - (interactive (list - (file-name-sans-versions (dired-get-filename) t) - current-prefix-arg)) - (mailcap-parse-mailcaps) - (if (file-exists-p file-name) - (let (mime-type method) - (if (and (not arg) - (not (file-directory-p file-name)) - (string-match "\\.[^\\.]+$" file-name) - (setq mime-type - (mailcap-extension-to-mime - (match-string 0 file-name))) - (stringp - (setq method - (cdr (assoc 'viewer - (car (mailcap-mime-info mime-type - 'all))))))) - (let ((view-command (mm-mailcap-command method file-name nil))) - (message "viewing via %s" view-command) - (start-process "*display*" - nil - shell-file-name - shell-command-switch - view-command)) - (find-file file-name))) - (if (file-symlink-p file-name) - (error "File is a symlink to a nonexistent target") - (error "File no longer exists; type `g' to update Dired buffer")))) - -(defun gnus-dired-print (&optional file-name print-to) - "In dired, print FILE-NAME according to the mailcap file. - -If there is no print command, print in a PostScript image. If the -optional argument PRINT-TO is nil, send the image to the printer. If -PRINT-TO is a string, save the PostScript image in a file with that -name. If PRINT-TO is a number, prompt the user for the name of the -file to save in." - (interactive (list - (file-name-sans-versions (dired-get-filename) t) - (ps-print-preprint current-prefix-arg))) - (mailcap-parse-mailcaps) - (cond - ((file-directory-p file-name) - (error "Can't print a directory")) - ((file-exists-p file-name) - (let (mime-type method) - (if (and (string-match "\\.[^\\.]+$" file-name) - (setq mime-type - (mailcap-extension-to-mime - (match-string 0 file-name))) - (stringp - (setq method (mailcap-mime-info mime-type "print")))) - (call-process shell-file-name nil - (generate-new-buffer " *mm*") - nil - shell-command-switch - (mm-mailcap-command method file-name mime-type)) - (with-temp-buffer - (insert-file-contents file-name) - (gnus-print-buffer)) - (ps-despool print-to)))) - ((file-symlink-p file-name) - (error "File is a symlink to a nonexistent target")) - (t - (error "File no longer exists; type `g' to update Dired buffer")))) - -(provide 'gnus-dired) - -;;; arch-tag: 44737731-e445-4638-a31e-713c7590ec76 -;;; gnus-dired.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-draft.el b/xemacs-packages/gnus/lisp/gnus-draft.el deleted file mode 100644 index edeb2f86..00000000 --- a/xemacs-packages/gnus/lisp/gnus-draft.el +++ /dev/null @@ -1,324 +0,0 @@ -;;; gnus-draft.el --- draft message support for Gnus - -;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) -(require 'gnus-sum) -(require 'message) -(require 'gnus-msg) -(require 'nndraft) -(require 'gnus-agent) -(eval-when-compile (require 'cl)) - -;;; Draft minor mode - -(defvar gnus-draft-mode nil - "Minor mode for providing a draft summary buffers.") - -(defvar gnus-draft-mode-map nil) - -(unless gnus-draft-mode-map - (setq gnus-draft-mode-map (make-sparse-keymap)) - - (gnus-define-keys gnus-draft-mode-map - "Dt" gnus-draft-toggle-sending - "e" gnus-draft-edit-message ;; Use `B w' for `gnus-summary-edit-article' - "De" gnus-draft-edit-message - "Ds" gnus-draft-send-message - "DS" gnus-draft-send-all-messages)) - -(defun gnus-draft-make-menu-bar () - (unless (boundp 'gnus-draft-menu) - (easy-menu-define - gnus-draft-menu gnus-draft-mode-map "" - '("Drafts" - ["Toggle whether to send" gnus-draft-toggle-sending t] - ["Edit" gnus-draft-edit-message t] - ["Send selected message(s)" gnus-draft-send-message t] - ["Send all messages" gnus-draft-send-all-messages t] - ["Delete draft" gnus-summary-delete-article t])))) - -(defun gnus-draft-mode (&optional arg) - "Minor mode for providing a draft summary buffers. - -\\{gnus-draft-mode-map}" - (interactive "P") - (when (eq major-mode 'gnus-summary-mode) - (when (set (make-local-variable 'gnus-draft-mode) - (if (null arg) (not gnus-draft-mode) - (> (prefix-numeric-value arg) 0))) - ;; Set up the menu. - (when (gnus-visual-p 'draft-menu 'menu) - (gnus-draft-make-menu-bar)) - (gnus-add-minor-mode 'gnus-draft-mode " Draft" gnus-draft-mode-map) - (gnus-run-hooks 'gnus-draft-mode-hook)))) - -;;; Commands - -(defun gnus-draft-toggle-sending (article) - "Toggle whether to send an article or not." - (interactive (list (gnus-summary-article-number))) - (if (gnus-draft-article-sendable-p article) - (progn - (push article gnus-newsgroup-unsendable) - (gnus-summary-mark-article article gnus-unsendable-mark)) - (setq gnus-newsgroup-unsendable - (delq article gnus-newsgroup-unsendable)) - (gnus-summary-mark-article article gnus-unread-mark)) - (gnus-summary-position-point)) - -(defun gnus-draft-edit-message () - "Enter a mail/post buffer to edit and send the draft." - (interactive) - (let ((article (gnus-summary-article-number)) - (group gnus-newsgroup-name)) - (gnus-draft-check-draft-articles (list article)) - (gnus-summary-mark-as-read article gnus-canceled-mark) - (gnus-draft-setup article group t) - (set-buffer-modified-p t) - (save-excursion - (save-restriction - (message-narrow-to-headers) - (message-remove-header "date"))) - (save-buffer) - (let ((gnus-verbose-backends nil)) - (gnus-request-expire-articles (list article) group t)) - (push - `((lambda () - (when (gnus-buffer-exists-p ,gnus-summary-buffer) - (save-excursion - (set-buffer ,gnus-summary-buffer) - (gnus-cache-possibly-remove-article ,article nil nil nil t))))) - message-send-actions))) - -(defun gnus-draft-send-message (&optional n) - "Send the current draft(s). -Obeys the standard process/prefix convention." - (interactive "P") - (let* ((articles (gnus-summary-work-articles n)) - (total (length articles)) - article) - (gnus-draft-check-draft-articles articles) - (while (setq article (pop articles)) - (gnus-summary-remove-process-mark article) - (unless (memq article gnus-newsgroup-unsendable) - (let ((message-sending-message - (format "Sending message %d of %d..." - (- total (length articles)) total))) - (gnus-draft-send article gnus-newsgroup-name t)) - (gnus-summary-mark-article article gnus-canceled-mark))))) - -(defun gnus-draft-send (article &optional group interactive) - "Send message ARTICLE." - (let* ((is-queue (or (not group) - (equal group "nndraft:queue"))) - (message-syntax-checks (if interactive message-syntax-checks - 'dont-check-for-anything-just-trust-me)) - (message-hidden-headers nil) - (message-inhibit-body-encoding (or is-queue - message-inhibit-body-encoding)) - (message-send-hook (and (not is-queue) - message-send-hook)) - (message-setup-hook (and (not is-queue) - message-setup-hook)) - (message-signature (and (not is-queue) - message-signature)) - (gnus-agent-queue-mail (and (not is-queue) - gnus-agent-queue-mail)) - (rfc2047-encode-encoded-words nil) - type method move-to) - (gnus-draft-setup article (or group "nndraft:queue")) - ;; We read the meta-information that says how and where - ;; this message is to be sent. - (save-restriction - (message-narrow-to-headers) - (when (re-search-forward - (concat "^" (regexp-quote gnus-agent-target-move-group-header) - ":") nil t) - (skip-syntax-forward "-") - (setq move-to (buffer-substring (point) (gnus-point-at-eol))) - (message-remove-header gnus-agent-target-move-group-header)) - (goto-char (point-min)) - (when (re-search-forward - (concat "^" (regexp-quote gnus-agent-meta-information-header) ":") - nil t) - (setq type (ignore-errors (read (current-buffer))) - method (ignore-errors (read (current-buffer)))) - (message-remove-header gnus-agent-meta-information-header))) - ;; Let Agent restore any GCC lines and have message.el perform them. - (gnus-agent-restore-gcc) - ;; Then we send it. If we have no meta-information, we just send - ;; it and let Message figure out how. - (when (and (or (null method) - (gnus-server-opened method) - (gnus-open-server method)) - (if type - (let ((message-this-is-news (eq type 'news)) - (message-this-is-mail (eq type 'mail)) - (gnus-post-method method) - (message-post-method method)) - (if move-to - (gnus-inews-do-gcc move-to) - (message-send-and-exit))) - (if move-to - (gnus-inews-do-gcc move-to) - (message-send-and-exit)))) - (let ((gnus-verbose-backends nil)) - (gnus-request-expire-articles - (list article) (or group "nndraft:queue") t))))) - -(defun gnus-draft-send-all-messages () - "Send all the sendable drafts." - (interactive) - (when (or - gnus-expert-user - (gnus-y-or-n-p - "Send all drafts? ")) - (gnus-uu-mark-buffer) - (gnus-draft-send-message))) - -(defun gnus-group-send-queue () - "Send all sendable articles from the queue group." - (interactive) - (when (or gnus-plugged - (not gnus-agent-prompt-send-queue) - (gnus-y-or-n-p "Gnus is unplugged; really send queue? ")) - (gnus-activate-group "nndraft:queue") - (save-excursion - (let* ((articles (nndraft-articles)) - (unsendable (gnus-uncompress-range - (cdr (assq 'unsend - (gnus-info-marks - (gnus-get-info "nndraft:queue")))))) - (gnus-posting-styles nil) - (total (length articles)) - article) - (while (setq article (pop articles)) - (unless (memq article unsendable) - (let ((message-sending-message - (format "Sending message %d of %d..." - (- total (length articles)) total))) - (gnus-draft-send article)))))))) - -;;;###autoload -(defun gnus-draft-reminder () - "Reminder user if there are unsent drafts." - (interactive) - (if (gnus-alive-p) - (let (active) - (catch 'continue - (dolist (group '("nndraft:drafts" "nndraft:queue")) - (setq active (gnus-activate-group group)) - (if (and active (>= (cdr active) (car active))) - (if (y-or-n-p "There are unsent drafts. Confirm to exit? ") - (throw 'continue t) - (error "Stop!")))))))) - -;;; Utility functions - -;;;!!!If this is byte-compiled, it fails miserably. -;;;!!!This is because `gnus-setup-message' uses uninterned symbols. -;;;!!!This has been fixed in recent versions of Emacs and XEmacs, -;;;!!!but for the time being, we'll just run this tiny function uncompiled. - -(progn - (defun gnus-draft-setup (narticle group &optional restore) - (let (ga) - (gnus-setup-message 'forward - (let ((article narticle)) - (message-mail) - (erase-buffer) - (if (not (gnus-request-restore-buffer article group)) - (error "Couldn't restore the article") - (when (and restore - (equal group "nndraft:queue")) - (mime-to-mml)) - ;; Insert the separator. - (goto-char (point-min)) - (search-forward "\n\n") - (forward-char -1) - (save-restriction - (narrow-to-region (point-min) (point)) - (setq ga - (message-fetch-field gnus-draft-meta-information-header))) - (insert mail-header-separator) - (forward-line 1) - (message-set-auto-save-file-name)))) - (gnus-backlog-remove-article group narticle) - (when (and ga - (ignore-errors (setq ga (car (read-from-string ga))))) - (setq gnus-newsgroup-name - (if (equal (car ga) "") nil (car ga))) - (gnus-configure-posting-styles) - (setq gnus-message-group-art (cons gnus-newsgroup-name (cadr ga))) - (setq message-post-method - `(lambda (arg) - (gnus-post-method arg ,(car ga)))) - (unless (equal (cadr ga) "") - (dolist (article (cdr ga)) - (message-add-action - `(progn - (gnus-add-mark ,(car ga) 'replied ,article) - (gnus-request-set-mark ,(car ga) (list (list (list ,article) - 'add '(reply))))) - 'send))))))) - -(defun gnus-draft-article-sendable-p (article) - "Say whether ARTICLE is sendable." - (not (memq article gnus-newsgroup-unsendable))) - -(defun gnus-draft-check-draft-articles (articles) - "Check whether the draft articles ARTICLES are under edit." - (when (equal gnus-newsgroup-name "nndraft:drafts") - (let ((buffers (buffer-list)) - file buffs buff) - (save-current-buffer - (while (and articles - (not buff)) - (setq file (nndraft-article-filename (pop articles)) - buffs buffers) - (while buffs - (set-buffer (setq buff (pop buffs))) - (if (and buffer-file-name - (string-equal (file-truename buffer-file-name) - (file-truename file)) - (buffer-modified-p)) - (setq buffs nil) - (setq buff nil))))) - (when buff - (let* ((window (get-buffer-window buff t)) - (frame (and window (window-frame window)))) - (if frame - (gnus-select-frame-set-input-focus frame) - (pop-to-buffer buff t))) - (error "The draft %s is under edit" file))))) - -(provide 'gnus-draft) - -;;; arch-tag: 3d92af58-8c97-4a5c-9db4-a98e85198022 -;;; gnus-draft.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-dup.el b/xemacs-packages/gnus/lisp/gnus-dup.el deleted file mode 100644 index bcafabd2..00000000 --- a/xemacs-packages/gnus/lisp/gnus-dup.el +++ /dev/null @@ -1,167 +0,0 @@ -;;; gnus-dup.el --- suppression of duplicate articles in Gnus - -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; This package tries to mark articles as read the second time the -;; user reads a copy. This is useful if the server doesn't support -;; Xref properly, or if the user reads the same group from several -;; servers. - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) -(require 'gnus-art) - -(defgroup gnus-duplicate nil - "Suppression of duplicate articles." - :group 'gnus) - -(defcustom gnus-save-duplicate-list nil - "*If non-nil, save the duplicate list when shutting down Gnus. -If nil, duplicate suppression will only work on duplicates -seen in the same session." - :group 'gnus-duplicate - :type 'boolean) - -(defcustom gnus-duplicate-list-length 10000 - "*The number of Message-IDs to keep in the duplicate suppression list." - :group 'gnus-duplicate - :type 'integer) - -(defcustom gnus-duplicate-file (nnheader-concat gnus-directory "suppression") - "*The name of the file to store the duplicate suppression list." - :group 'gnus-duplicate - :type 'file) - -;;; Internal variables - -(defvar gnus-dup-list nil) -(defvar gnus-dup-hashtb nil) - -(defvar gnus-dup-list-dirty nil) - -;;; -;;; Starting and stopping -;;; - -(gnus-add-shutdown 'gnus-dup-close 'gnus) - -(defun gnus-dup-close () - "Possibly save the duplicate suppression list and shut down the subsystem." - (gnus-dup-save) - (setq gnus-dup-list nil - gnus-dup-hashtb nil - gnus-dup-list-dirty nil)) - -(defun gnus-dup-open () - "Possibly read the duplicate suppression list and start the subsystem." - (if gnus-save-duplicate-list - (gnus-dup-read) - (setq gnus-dup-list nil)) - (setq gnus-dup-hashtb (gnus-make-hashtable gnus-duplicate-list-length)) - ;; Enter all Message-IDs into the hash table. - (let ((list gnus-dup-list) - (obarray gnus-dup-hashtb)) - (while list - (intern (pop list))))) - -(defun gnus-dup-read () - "Read the duplicate suppression list." - (setq gnus-dup-list nil) - (when (file-exists-p gnus-duplicate-file) - (load gnus-duplicate-file t t t))) - -(defun gnus-dup-save () - "Save the duplicate suppression list." - (when (and gnus-save-duplicate-list - gnus-dup-list-dirty) - (with-temp-file gnus-duplicate-file - (gnus-prin1 `(setq gnus-dup-list ',gnus-dup-list)))) - (setq gnus-dup-list-dirty nil)) - -;;; -;;; Interface functions -;;; - -(defun gnus-dup-enter-articles () - "Enter articles from the current group for future duplicate suppression." - (unless gnus-dup-list - (gnus-dup-open)) - (setq gnus-dup-list-dirty t) ; mark list for saving - (let ((data gnus-newsgroup-data) - datum msgid) - ;; Enter the Message-IDs of all read articles into the list - ;; and hash table. - (while (setq datum (pop data)) - (when (and (not (gnus-data-pseudo-p datum)) - (> (gnus-data-number datum) 0) - (not (memq (gnus-data-number datum) gnus-newsgroup-unreads)) - (not (= (gnus-data-mark datum) gnus-canceled-mark)) - (setq msgid (mail-header-id (gnus-data-header datum))) - (not (nnheader-fake-message-id-p msgid)) - (not (intern-soft msgid gnus-dup-hashtb))) - (push msgid gnus-dup-list) - (intern msgid gnus-dup-hashtb)))) - ;; Chop off excess Message-IDs from the list. - (let ((end (nthcdr gnus-duplicate-list-length gnus-dup-list))) - (when end - (setcdr end nil)))) - -(defun gnus-dup-suppress-articles () - "Mark duplicate articles as read." - (unless gnus-dup-list - (gnus-dup-open)) - (gnus-message 6 "Suppressing duplicates...") - (let ((headers gnus-newsgroup-headers) - (auto (and gnus-newsgroup-auto-expire - (memq gnus-duplicate-mark gnus-auto-expirable-marks))) - number header) - (while (setq header (pop headers)) - (when (and (intern-soft (mail-header-id header) gnus-dup-hashtb) - (gnus-summary-article-unread-p (mail-header-number header))) - (setq gnus-newsgroup-unreads - (delq (setq number (mail-header-number header)) - gnus-newsgroup-unreads)) - (if (not auto) - (push (cons number gnus-duplicate-mark) gnus-newsgroup-reads) - (push number gnus-newsgroup-expirable) - (push (cons number gnus-expirable-mark) gnus-newsgroup-reads))))) - (gnus-message 6 "Suppressing duplicates...done")) - -(defun gnus-dup-unsuppress-article (article) - "Stop suppression of ARTICLE." - (let ((id (mail-header-id (gnus-data-header (gnus-data-find article))))) - (when id - (setq gnus-dup-list-dirty t) - (setq gnus-dup-list (delete id gnus-dup-list)) - (unintern id gnus-dup-hashtb)))) - -(provide 'gnus-dup) - -;;; arch-tag: 903e94db-7b00-4d19-83ee-cf34a81fa5fb -;;; gnus-dup.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-eform.el b/xemacs-packages/gnus/lisp/gnus-eform.el deleted file mode 100644 index a788b5e6..00000000 --- a/xemacs-packages/gnus/lisp/gnus-eform.el +++ /dev/null @@ -1,135 +0,0 @@ -;;; gnus-eform.el --- a mode for editing forms for Gnus - -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) -(require 'gnus-win) - -;;; -;;; Editing forms -;;; - -(defgroup gnus-edit-form nil - "A mode for editing forms." - :group 'gnus) - -(defcustom gnus-edit-form-mode-hook nil - "Hook run in `gnus-edit-form-mode' buffers." - :group 'gnus-edit-form - :type 'hook) - -(defcustom gnus-edit-form-menu-hook nil - "Hook run when creating menus in `gnus-edit-form-mode' buffers." - :group 'gnus-edit-form - :type 'hook) - -;;; Internal variables - -(defvar gnus-edit-form-buffer "*Gnus edit form*") -(defvar gnus-edit-form-done-function nil) - -(defvar gnus-edit-form-mode-map nil) -(unless gnus-edit-form-mode-map - (setq gnus-edit-form-mode-map (make-sparse-keymap)) - (set-keymap-parent gnus-edit-form-mode-map emacs-lisp-mode-map) - (gnus-define-keys gnus-edit-form-mode-map - "\C-c\C-c" gnus-edit-form-done - "\C-c\C-k" gnus-edit-form-exit)) - -(defun gnus-edit-form-make-menu-bar () - (unless (boundp 'gnus-edit-form-menu) - (easy-menu-define - gnus-edit-form-menu gnus-edit-form-mode-map "" - '("Edit Form" - ["Exit and save changes" gnus-edit-form-done t] - ["Exit" gnus-edit-form-exit t])) - (gnus-run-hooks 'gnus-edit-form-menu-hook))) - -(defun gnus-edit-form-mode () - "Major mode for editing forms. -It is a slightly enhanced emacs-lisp-mode. - -\\{gnus-edit-form-mode-map}" - (interactive) - (when (gnus-visual-p 'group-menu 'menu) - (gnus-edit-form-make-menu-bar)) - (kill-all-local-variables) - (setq major-mode 'gnus-edit-form-mode) - (setq mode-name "Edit Form") - (use-local-map gnus-edit-form-mode-map) - (make-local-variable 'gnus-edit-form-done-function) - (make-local-variable 'gnus-prev-winconf) - (gnus-run-mode-hooks 'gnus-edit-form-mode-hook)) - -(defun gnus-edit-form (form documentation exit-func) - "Edit FORM in a new buffer. -Call EXIT-FUNC on exit. Display DOCUMENTATION in the beginning -of the buffer." - (let ((winconf (current-window-configuration))) - (set-buffer (gnus-get-buffer-create gnus-edit-form-buffer)) - (gnus-configure-windows 'edit-form) - (gnus-edit-form-mode) - (setq gnus-prev-winconf winconf) - (setq gnus-edit-form-done-function exit-func) - (erase-buffer) - (insert documentation) - (unless (bolp) - (insert "\n")) - (goto-char (point-min)) - (while (not (eobp)) - (insert ";;; ") - (forward-line 1)) - (insert ";; Type `C-c C-c' after you've finished editing.\n") - (insert "\n") - (let ((p (point))) - (gnus-pp form) - (insert "\n") - (goto-char p)))) - -(defun gnus-edit-form-done () - "Update changes and kill the current buffer." - (interactive) - (goto-char (point-min)) - (let ((form (condition-case nil - (read (current-buffer)) - (end-of-file nil))) - (func gnus-edit-form-done-function)) - (gnus-edit-form-exit) - (funcall func form))) - -(defun gnus-edit-form-exit () - "Kill the current buffer." - (interactive) - (let ((winconf gnus-prev-winconf)) - (kill-buffer (current-buffer)) - (set-window-configuration winconf))) - -(provide 'gnus-eform) - -;;; arch-tag: ef50678c-2c28-49ef-affc-e53b3b2c0bf6 -;;; gnus-eform.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-ems.el b/xemacs-packages/gnus/lisp/gnus-ems.el deleted file mode 100644 index 06d9ae31..00000000 --- a/xemacs-packages/gnus/lisp/gnus-ems.el +++ /dev/null @@ -1,305 +0,0 @@ -;;; gnus-ems.el --- functions for making Gnus work under different Emacsen - -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile - (require 'cl) - (require 'ring)) - -;;; Function aliases later to be redefined for XEmacs usage. - -(defvar gnus-mouse-2 [mouse-2]) -(defvar gnus-down-mouse-3 [down-mouse-3]) -(defvar gnus-down-mouse-2 [down-mouse-2]) -(defvar gnus-widget-button-keymap nil) -(defvar gnus-mode-line-modified - (if (or (featurep 'xemacs) - (< emacs-major-version 20)) - '("--**-" . "-----") - '("**" "--"))) - -(eval-and-compile - (autoload 'gnus-xmas-define "gnus-xmas") - (autoload 'gnus-xmas-redefine "gnus-xmas") - (autoload 'appt-select-lowest-window "appt") - (autoload 'gnus-get-buffer-create "gnus") - (autoload 'nnheader-find-etc-directory "nnheader")) - -(autoload 'smiley-region "smiley") -;; Fixme: shouldn't require message -(autoload 'message-text-with-property "message") - -(defun gnus-kill-all-overlays () - "Delete all overlays in the current buffer." - (let* ((overlayss (overlay-lists)) - (buffer-read-only nil) - (overlays (delq nil (nconc (car overlayss) (cdr overlayss))))) - (while overlays - (delete-overlay (pop overlays))))) - -;;; Mule functions. - -(defun gnus-mule-max-width-function (el max-width) - `(let* ((val (eval (, el))) - (valstr (if (numberp val) - (int-to-string val) val))) - (if (> (length valstr) ,max-width) - (truncate-string-to-width valstr ,max-width) - valstr))) - -(eval-and-compile - (defalias 'gnus-char-width - (if (fboundp 'char-width) - 'char-width - (lambda (ch) 1)))) ;; A simple hack. - -(eval-and-compile - (if (featurep 'xemacs) - (gnus-xmas-define) - (defvar gnus-mouse-face-prop 'mouse-face - "Property used for highlighting mouse regions."))) - -(eval-when-compile - (defvar gnus-tmp-unread) - (defvar gnus-tmp-replied) - (defvar gnus-tmp-score-char) - (defvar gnus-tmp-indentation) - (defvar gnus-tmp-opening-bracket) - (defvar gnus-tmp-lines) - (defvar gnus-tmp-name) - (defvar gnus-tmp-closing-bracket) - (defvar gnus-tmp-subject-or-nil) - (defvar gnus-check-before-posting) - (defvar gnus-mouse-face) - (defvar gnus-group-buffer)) - -(defun gnus-ems-redefine () - (cond - ((featurep 'xemacs) - (gnus-xmas-redefine)) - - ((featurep 'mule) - ;; Mule and new Emacs definitions - - ;; [Note] Now there are three kinds of mule implementations, - ;; original MULE, XEmacs/mule and Emacs 20+ including - ;; MULE features. Unfortunately these APIs are different. In - ;; particular, Emacs (including original Mule) and XEmacs are - ;; quite different. However, this version of Gnus doesn't support - ;; anything other than XEmacs 20+ and Emacs 20.3+. - - ;; Predicates to check are following: - ;; (boundp 'MULE) is t only if Mule (original; anything older than - ;; Mule 2.3) is running. - ;; (featurep 'mule) is t when other mule variants are running. - - ;; It is possible to detect XEmacs/mule by (featurep 'mule) and - ;; (featurep 'xemacs). In this case, the implementation for - ;; XEmacs/mule may be shareable between XEmacs and XEmacs/mule. - - (defvar gnus-summary-display-table nil - "Display table used in summary mode buffers.") - (defalias 'gnus-max-width-function 'gnus-mule-max-width-function) - - (when (boundp 'gnus-check-before-posting) - (setq gnus-check-before-posting - (delq 'long-lines - (delq 'control-chars gnus-check-before-posting)))) - - (defun gnus-summary-line-format-spec () - (insert gnus-tmp-unread gnus-tmp-replied - gnus-tmp-score-char gnus-tmp-indentation) - (put-text-property - (point) - (progn - (insert - gnus-tmp-opening-bracket - (format "%4d: %-20s" - gnus-tmp-lines - (if (> (length gnus-tmp-name) 20) - (truncate-string-to-width gnus-tmp-name 20) - gnus-tmp-name)) - gnus-tmp-closing-bracket) - (point)) - gnus-mouse-face-prop gnus-mouse-face) - (insert " " gnus-tmp-subject-or-nil "\n"))))) - -(defun gnus-region-active-p () - "Say whether the region is active." - (and (boundp 'transient-mark-mode) - transient-mark-mode - (boundp 'mark-active) - mark-active)) - -(defun gnus-mark-active-p () - "Non-nil means the mark and region are currently active in this buffer." - mark-active) ; aliased to region-exists-p in XEmacs. - -(if (fboundp 'add-minor-mode) - (defalias 'gnus-add-minor-mode 'add-minor-mode) - (defun gnus-add-minor-mode (mode name map &rest rest) - (set (make-local-variable mode) t) - (unless (assq mode minor-mode-alist) - (push `(,mode ,name) minor-mode-alist)) - (unless (assq mode minor-mode-map-alist) - (push (cons mode map) - minor-mode-map-alist)))) - -(defun gnus-x-splash () - "Show a splash screen using a pixmap in the current buffer." - (interactive) - (unless window-system - (error "`gnus-x-splash' requires running on the window system")) - (switch-to-buffer (gnus-get-buffer-create (if (or (gnus-alive-p) - (interactive-p)) - "*gnus-x-splash*" - gnus-group-buffer))) - (let ((inhibit-read-only t) - (file (nnheader-find-etc-directory "images/gnus/x-splash" t)) - pixmap fcw fch width height fringes sbars left yoffset top ls) - (erase-buffer) - (sit-for 0) ;; Necessary for measuring the window size correctly. - (when (and file - (ignore-errors - (let ((coding-system-for-read 'raw-text) - default-enable-multibyte-characters) - (with-temp-buffer - (insert-file-contents file) - (goto-char (point-min)) - (setq pixmap (read (current-buffer))))))) - (setq fcw (float (frame-char-width)) - fch (float (frame-char-height)) - width (/ (car pixmap) fcw) - height (/ (cadr pixmap) fch) - fringes (if (fboundp 'window-fringes) - (eval '(window-fringes)) - '(10 11 nil)) - sbars (frame-parameter nil 'vertical-scroll-bars)) - (cond ((eq sbars 'right) - (setq sbars - (cons 0 (/ (or (frame-parameter nil 'scroll-bar-width) 14) - fcw)))) - (sbars - (setq sbars - (cons (/ (or (frame-parameter nil 'scroll-bar-width) 14) - fcw) - 0))) - (t - (setq sbars '(0 . 0)))) - (setq left (- (* (round (/ (1- (/ (+ (window-width) - (car sbars) (cdr sbars) - (/ (+ (or (car fringes) 0) - (or (cadr fringes) 0)) - fcw)) - width)) - 2)) - width) - (car sbars) - (/ (or (car fringes) 0) fcw)) - yoffset (cadr (window-edges)) - top (max 0 (- (* (max (if (and tool-bar-mode - (not (featurep 'gtk)) - (eq (frame-first-window) - (selected-window))) - 1 0) - (round (/ (1- (/ (+ (1- (window-height)) - (* 2 yoffset)) - height)) - 2))) - height) - yoffset)) - ls (/ (or line-spacing 0) fch) - height (max 0 (- height ls))) - (cond ((>= (- top ls) 1) - (insert - (propertize - " " - 'display `(space :width 0 :ascent 100)) - "\n" - (propertize - " " - 'display `(space :width 0 :height ,(- top ls 1) :ascent 100)) - "\n")) - ((> (- top ls) 0) - (insert - (propertize - " " - 'display `(space :width 0 :height ,(- top ls) :ascent 100)) - "\n"))) - (if (and (> width 0) (> left 0)) - (insert (propertize - " " - 'display `(space :width ,left :height ,height :ascent 0))) - (setq width (+ width left))) - (when (> width 0) - (insert (propertize - " " - 'display `(space :width ,width :height ,height :ascent 0) - 'face `(gnus-splash :stipple ,pixmap)))) - (goto-char (if (<= (- top ls) 0) (1- (point)) (point-min))) - (redraw-frame (selected-frame)) - (sit-for 0)))) - -;;; Image functions. - -(defun gnus-image-type-available-p (type) - (and (fboundp 'image-type-available-p) - (image-type-available-p type) - (if (fboundp 'display-images-p) - (display-images-p) - t))) - -(defun gnus-create-image (file &optional type data-p &rest props) - (let ((face (plist-get props :face))) - (when face - (setq props (plist-put props :foreground (face-foreground face))) - (setq props (plist-put props :background (face-background face)))) - (apply 'create-image file type data-p props))) - -(defun gnus-put-image (glyph &optional string category) - (let ((point (point))) - (insert-image glyph (or string " ")) - (put-text-property point (point) 'gnus-image-category category) - (unless string - (put-text-property (1- (point)) (point) - 'gnus-image-text-deletable t)) - glyph)) - -(defun gnus-remove-image (image &optional category) - (dolist (position (message-text-with-property 'display)) - (when (and (equal (get-text-property position 'display) image) - (equal (get-text-property position 'gnus-image-category) - category)) - (put-text-property position (1+ position) 'display nil) - (when (get-text-property position 'gnus-image-text-deletable) - (delete-region position (1+ position)))))) - -(provide 'gnus-ems) - -;;; arch-tag: e7360b45-14b5-4171-aa39-69a44aed3cdb -;;; gnus-ems.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-fun.el b/xemacs-packages/gnus/lisp/gnus-fun.el deleted file mode 100644 index a525a5b0..00000000 --- a/xemacs-packages/gnus/lisp/gnus-fun.el +++ /dev/null @@ -1,262 +0,0 @@ -;;; gnus-fun.el --- various frivolous extension functions to Gnus - -;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile - (require 'cl)) - -(require 'mm-util) -(require 'gnus-ems) -(require 'gnus-util) -(require 'gnus) - -(defcustom gnus-x-face-directory (expand-file-name "x-faces" gnus-directory) - "*Directory where X-Face PBM files are stored." - :version "22.1" - :group 'gnus-fun - :type 'directory) - -(defcustom gnus-convert-pbm-to-x-face-command "pbmtoxbm %s | compface" - "Command for converting a PBM to an X-Face." - :version "22.1" - :group 'gnus-fun - :type 'string) - -(defcustom gnus-convert-image-to-x-face-command "giftopnm %s | ppmnorm | pnmscale -width 48 -height 48 | ppmtopgm | pgmtopbm | pbmtoxbm | compface" - "Command for converting an image to an X-Face. -By default it takes a GIF filename and output the X-Face header data -on stdout." - :version "22.1" - :group 'gnus-fun - :type 'string) - -(defcustom gnus-convert-image-to-face-command "djpeg %s | ppmnorm | pnmscale -width 48 -height 48 | ppmquant %d | pnmtopng" - "Command for converting an image to a Face. -By default it takes a JPEG filename and output the Face header data -on stdout." - :version "22.1" - :group 'gnus-fun - :type 'string) - -(defun gnus-shell-command-to-string (command) - "Like `shell-command-to-string' except not mingling ERROR." - (with-output-to-string - (call-process shell-file-name nil (list standard-output nil) - nil shell-command-switch command))) - -(defun gnus-shell-command-on-region (start end command) - "A simplified `shell-command-on-region'. -Output to the current buffer, replace text, and don't mingle error." - (call-process-region start end shell-file-name t - (list (current-buffer) nil) - nil shell-command-switch command)) - -;;;###autoload -(defun gnus-random-x-face () - "Return X-Face header data chosen randomly from `gnus-x-face-directory'." - (interactive) - (when (file-exists-p gnus-x-face-directory) - (let* ((files (directory-files gnus-x-face-directory t "\\.pbm$")) - (file (nth (random (length files)) files))) - (when file - (gnus-shell-command-to-string - (format gnus-convert-pbm-to-x-face-command - (shell-quote-argument file))))))) - -;;;###autoload -(defun gnus-insert-random-x-face-header () - "Insert a random X-Face header from `gnus-x-face-directory'." - (interactive) - (let ((data (gnus-random-x-face))) - (save-excursion - (message-goto-eoh) - (if data - (insert "X-Face: " data) - (message - "No face returned by `gnus-random-x-face'. Does %s/*.pbm exist?" - gnus-x-face-directory))))) - -;;;###autoload -(defun gnus-x-face-from-file (file) - "Insert an X-Face header based on an image file." - (interactive "fImage file name (by default GIF): ") - (when (file-exists-p file) - (gnus-shell-command-to-string - (format gnus-convert-image-to-x-face-command - (shell-quote-argument (expand-file-name file)))))) - -;;;###autoload -(defun gnus-face-from-file (file) - "Return a Face header based on an image file." - (interactive "fImage file name (by default JPEG): ") - (when (file-exists-p file) - (let ((done nil) - (attempt "") - (quant 16)) - (while (and (not done) - (> quant 1)) - (setq attempt - (let ((coding-system-for-read 'binary)) - (gnus-shell-command-to-string - (format gnus-convert-image-to-face-command - (shell-quote-argument (expand-file-name file)) - quant)))) - (if (> (length attempt) 726) - (progn - (setq quant (- quant 2)) - (gnus-message 9 "Length %d; trying quant %d" - (length attempt) quant)) - (setq done t))) - (if done - (mm-with-unibyte-buffer - (insert attempt) - (gnus-face-encode)) - nil)))) - -(defun gnus-face-encode () - (let ((step 72)) - (base64-encode-region (point-min) (point-max)) - (goto-char (point-min)) - (while (search-forward "\n" nil t) - (replace-match "")) - (goto-char (point-min)) - (while (> (- (point-max) (point)) - step) - (forward-char step) - (insert "\n ") - (setq step 76)) - (buffer-string))) - -;;;###autoload -(defun gnus-convert-face-to-png (face) - "Convert FACE (which is base64-encoded) to a PNG. -The PNG is returned as a string." - (mm-with-unibyte-buffer - (insert face) - (ignore-errors - (base64-decode-region (point-min) (point-max))) - (buffer-string))) - -;;;###autoload -(defun gnus-convert-png-to-face (file) - "Convert FILE to a Face. -FILE should be a PNG file that's 48x48 and smaller than or equal to -726 bytes." - (mm-with-unibyte-buffer - (insert-file-contents file) - (when (> (buffer-size) 726) - (error "The file is %d bytes long, which is too long" - (buffer-size))) - (gnus-face-encode))) - -(defface gnus-x-face '((t (:foreground "black" :background "white"))) - "Face to show X-Face. -The colors from this face are used as the foreground and background -colors of the displayed X-Faces." - :group 'gnus-article-headers) - -(defun gnus-display-x-face-in-from (data) - "Display the X-Face DATA in the From header." - (let ((default-enable-multibyte-characters nil) - pbm) - (when (or (gnus-image-type-available-p 'xface) - (and (gnus-image-type-available-p 'pbm) - (setq pbm (uncompface data)))) - (save-excursion - (save-restriction - (article-narrow-to-head) - (gnus-article-goto-header "from") - (when (bobp) - (insert "From: [no `from' set]\n") - (forward-char -17)) - (gnus-add-image - 'xface - (gnus-put-image - (if (gnus-image-type-available-p 'xface) - (gnus-create-image - (concat "X-Face: " data) - 'xface t :face 'gnus-x-face) - (gnus-create-image - pbm 'pbm t :face 'gnus-x-face)) nil 'xface)) - (gnus-add-wash-type 'xface)))))) - -(defun gnus-grab-cam-x-face () - "Grab a picture off the camera and make it into an X-Face." - (interactive) - (shell-command "xawtv-remote snap ppm") - (let ((file nil)) - (while (null (setq file (directory-files "/tftpboot/sparky/tmp" - t "snap.*ppm"))) - (sleep-for 1)) - (setq file (car file)) - (with-temp-buffer - (shell-command - (format "pnmcut -left 110 -top 30 -width 144 -height 144 '%s' | ppmnorm 2>/dev/null | pnmscale -width 48 | ppmtopgm | pgmtopbm -threshold -value 0.92 | pbmtoxbm | compface" - file) - (current-buffer)) - ;;(sleep-for 3) - (delete-file file) - (buffer-string)))) - -(defun gnus-grab-cam-face () - "Grab a picture off the camera and make it into an X-Face." - (interactive) - (shell-command "xawtv-remote snap ppm") - (let ((file nil) - (tempfile (make-temp-file "gnus-face-" nil ".ppm")) - result) - (while (null (setq file (directory-files "/tftpboot/sparky/tmp" - t "snap.*ppm"))) - (sleep-for 1)) - (setq file (car file)) - (shell-command - (format "pnmcut -left 110 -top 30 -width 144 -height 144 '%s' | pnmscale -width 48 -height 48 | ppmtopgm > %s" - file tempfile)) - (let ((gnus-convert-image-to-face-command - (format "cat '%%s' | ppmquant %%d | ppmchange %s | pnmtopng" - (gnus-fun-ppm-change-string)))) - (setq result (gnus-face-from-file tempfile))) - (delete-file file) - ;;(delete-file tempfile) ; FIXME why are we not deleting it?! - result)) - -(defun gnus-fun-ppm-change-string () - (let* ((possibilites '("%02x0000" "00%02x00" "0000%02x" - "%02x%02x00" "00%02x%02x" "%02x00%02x")) - (format (concat "'#%02x%02x%02x' '#" - (nth (random 6) possibilites) - "'")) - (values nil)) - (dotimes (i 255) - (push (format format i i i i i i) - values)) - (mapconcat 'identity values " "))) - -(provide 'gnus-fun) - -;;; arch-tag: 9d000a69-15cc-4491-9dc0-4627484f50c1 -;;; gnus-fun.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-gl.el b/xemacs-packages/gnus/lisp/gnus-gl.el deleted file mode 100644 index c757f4ff..00000000 --- a/xemacs-packages/gnus/lisp/gnus-gl.el +++ /dev/null @@ -1,860 +0,0 @@ -;;; gnus-gl.el --- an interface to GroupLens for Gnus - -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Brad Miller -;; Keywords: news, score - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; GroupLens software and documentation is copyright (c) 1995 by Paul -;; Resnick (Massachusetts Institute of Technology); Brad Miller, John -;; Riedl, Jon Herlocker, and Joseph Konstan (University of Minnesota), -;; and David Maltz (Carnegie-Mellon University). -;; -;; Permission to use, copy, modify, and distribute this documentation -;; for non-commercial and commercial purposes without fee is hereby -;; granted provided that this copyright notice and permission notice -;; appears in all copies and that the names of the individuals and -;; institutions holding this copyright are not used in advertising or -;; publicity pertaining to this software without specific, written -;; prior permission. The copyright holders make no representations -;; about the suitability of this software and documentation for any -;; purpose. It is provided ``as is'' without express or implied -;; warranty. -;; -;; The copyright holders request that they be notified of -;; modifications of this code. Please send electronic mail to -;; grouplens@cs.umn.edu for more information or to announce derived -;; works. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Author: Brad Miller -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; User Documentation: -;; To use GroupLens you must load this file. -;; You must also register a pseudonym with the Better Bit Bureau. -;; http://www.cs.umn.edu/Research/GroupLens -;; -;; ---------------- For your .emacs or .gnus file ---------------- -;; -;; As of version 2.5, grouplens now works as a minor mode of -;; gnus-summary-mode. To get make that work you just need a couple of -;; hooks. -;; (setq gnus-use-grouplens t) -;; (setq grouplens-pseudonym "") -;; (setq grouplens-bbb-host "grouplens.cs.umn.edu") -;; -;; (setq gnus-summary-default-score 0) -;; -;; USING GROUPLENS -;; How do I Rate an article?? -;; Before you type n to go to the next article, hit a number from 1-5 -;; Type r in the summary buffer and you will be prompted. -;; Note that when you're in grouplens-minor-mode 'r' masks the -;; usual reply binding for 'r' -;; -;; What if, Gasp, I find a bug??? -;; Please type M-x gnus-gl-submit-bug-report. This will set up a -;; mail buffer with the state of variables and buffers that will help -;; me debug the problem. A short description up front would help too! -;; -;; How do I display the prediction for an article: -;; If you set the gnus-summary-line-format as shown above, the score -;; (prediction) will be shown automatically. -;; -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Programmer Notes -;; 10/9/95 -;; gnus-scores-articles contains the articles -;; When scoring is done, the call tree looks something like: -;; gnus-possibly-score-headers -;; ==> gnus-score-headers -;; ==> gnus-score-load-file -;; ==> get-all-mids (from the eval form) -;; -;; it would be nice to have one that gets called after all the other -;; headers have been scored. -;; we may want a variable gnus-grouplens-scale-factor -;; and gnus-grouplens-offset this would probably be either -3 or 0 -;; to make the scores centered around zero or not. -;; Notes 10/12/95 -;; According to Lars, Norse god of gnus, the simple way to insert a -;; call to an external function is to have a function added to the -;; variable gnus-score-find-files-function This new function -;; gnus-grouplens-score-alist will return a core alist that -;; has (("message-id" ("" score) ("" score)) -;; This seems like it would be pretty inefficient, though workable. -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; TODO -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; 3. Add some more ways to rate messages -;; 4. Better error handling for token timeouts. -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; bugs -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus-score) -(require 'gnus) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; User variables -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defvar gnus-summary-grouplens-line-format - "%U\%R\%z%l%I\%(%[%4L: %-23,23n%]%) %s\n" - "*The line format spec in summary GroupLens mode buffers.") - -(defvar grouplens-pseudonym "" - "User's pseudonym. -This pseudonym is obtained during the registration process") - -(defvar grouplens-bbb-host "grouplens.cs.umn.edu" - "Host where the bbbd is running.") - -(defvar grouplens-bbb-port 9000 - "Port where the bbbd is listening.") - -(defvar grouplens-newsgroups - '("comp.groupware" "comp.human-factors" "comp.lang.c++" - "comp.lang.java" "comp.os.linux.admin" "comp.os.linux.advocacy" - "comp.os.linux.announce" "comp.os.linux.answers" - "comp.os.linux.development" "comp.os.linux.development.apps" - "comp.os.linux.development.system" "comp.os.linux.hardware" - "comp.os.linux.help" "comp.os.linux.m68k" "comp.os.linux.misc" - "comp.os.linux.networking" "comp.os.linux.setup" "comp.os.linux.x" - "mn.general" "rec.arts.movies" "rec.arts.movies.current-films" - "rec.food.recipes" "rec.humor") - "*Groups that are part of the GroupLens experiment.") - -(defvar grouplens-prediction-display 'prediction-spot - "valid values are: - prediction-spot -- an * corresponding to the prediction between 1 and 5, - confidence-interval -- a numeric confidence interval - prediction-bar -- |##### | the longer the bar, the better the article, - confidence-bar -- | ----- } the prediction is in the middle of the bar, - confidence-spot -- ) * | the spot gets bigger with more confidence, - prediction-num -- plain-old numeric value, - confidence-plus-minus -- prediction +/i confidence") - -(defvar grouplens-score-offset 0 - "Offset the prediction by this value. -Setting this variable to -2 would have the following effect on -GroupLens scores: - - 1 --> -2 - 2 --> -1 - 3 --> 0 - 4 --> 1 - 5 --> 2 - -The reason is that a user might want to do this is to combine -GroupLens predictions with scores calculated by other score methods.") - -(defvar grouplens-score-scale-factor 1 - "This variable allows the user to magnify the effect of GroupLens scores. -The scale factor is applied after the offset.") - -(defvar gnus-grouplens-override-scoring 'override - "Tell GroupLens to override the normal Gnus scoring mechanism. -GroupLens scores can be combined with gnus scores in one of three ways. -'override -- just use grouplens predictions for grouplens groups -'combine -- combine grouplens scores with gnus scores -'separate -- treat grouplens scores completely separate from gnus") - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; Program global variables -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar grouplens-bbb-token nil - "Current session token number.") - -(defvar grouplens-bbb-process nil - "Process Id of current bbbd network stream process.") - -(defvar grouplens-bbb-buffer nil - "Buffer associated with the BBBD process.") - -(defvar grouplens-rating-alist nil - "Current set of message-id rating pairs.") - -(defvar grouplens-current-hashtable nil - "A hashtable to hold predictions from the BBB.") - -(defvar grouplens-current-group nil) - -;;(defvar bbb-alist nil) - -(defvar bbb-timeout-secs 10 - "Number of seconds to wait for some response from the BBB. -If this times out we give up and assume that something has died..." ) - -(defvar grouplens-previous-article nil - "Message-ID of the last article read.") - -(defvar bbb-read-point) -(defvar bbb-response-point) - -(defun bbb-renew-hash-table () - (setq grouplens-current-hashtable (make-vector 100 0))) - -(bbb-renew-hash-table) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; Utility Functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun bbb-connect-to-bbbd (host port) - (unless grouplens-bbb-buffer - (setq grouplens-bbb-buffer - (gnus-get-buffer-create (format " *BBBD trace: %s*" host))) - (save-excursion - (set-buffer grouplens-bbb-buffer) - (make-local-variable 'bbb-read-point) - (make-local-variable 'bbb-response-point) - (setq bbb-read-point (point-min)))) - - ;; if an old process is still running for some reason, kill it - (when grouplens-bbb-process - (ignore-errors - (when (eq 'open (process-status grouplens-bbb-process)) - (set-process-buffer grouplens-bbb-process nil) - (delete-process grouplens-bbb-process)))) - - ;; clear the trace buffer of old output - (save-excursion - (set-buffer grouplens-bbb-buffer) - (erase-buffer)) - - ;; open the connection to the server - (catch 'done - (condition-case error - (setq grouplens-bbb-process - (open-network-stream "BBBD" grouplens-bbb-buffer host port)) - (error (gnus-message 3 "Error: Failed to connect to BBB") - nil)) - (and (null grouplens-bbb-process) - (throw 'done nil)) - (save-excursion - (set-buffer grouplens-bbb-buffer) - (setq bbb-read-point (point-min)) - (or (bbb-read-response grouplens-bbb-process) - (throw 'done nil)))) - - ;; return the process - grouplens-bbb-process) - -(defun bbb-send-command (process command) - (goto-char (point-max)) - (insert command) - (insert "\r\n") - (setq bbb-read-point (point)) - (setq bbb-response-point (point)) - (set-marker (process-mark process) (point)) ; process output also comes here - (process-send-string process command) - (process-send-string process "\r\n") - (process-send-eof process)) - -(defun bbb-read-response (process) - "This function eats the initial response of OK or ERROR from the BBB." - (let ((case-fold-search nil) - match-end) - (goto-char bbb-read-point) - (while (and (not (search-forward "\r\n" nil t)) - (accept-process-output process bbb-timeout-secs)) - (goto-char bbb-read-point)) - (setq match-end (point)) - (goto-char bbb-read-point) - (setq bbb-read-point match-end) - (looking-at "OK"))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; Login Functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun bbb-login () - "return the token number if login is successful, otherwise return nil." - (interactive) - (setq grouplens-bbb-token nil) - (if (not (equal grouplens-pseudonym "")) - (let ((bbb-process - (bbb-connect-to-bbbd grouplens-bbb-host grouplens-bbb-port))) - (if bbb-process - (save-excursion - (set-buffer (process-buffer bbb-process)) - (bbb-send-command bbb-process - (concat "login " grouplens-pseudonym)) - (if (bbb-read-response bbb-process) - (setq grouplens-bbb-token (bbb-extract-token-number)) - (gnus-message 3 "Error: GroupLens login failed"))))) - (gnus-message 3 "Error: you must set a pseudonym")) - grouplens-bbb-token) - -(defun bbb-extract-token-number () - (let ((token-pos (search-forward "token=" nil t))) - (when (looking-at "[0-9]+") - (buffer-substring token-pos (match-end 0))))) - -(gnus-add-shutdown 'bbb-logout 'gnus) - -(defun bbb-logout () - "logout of bbb session." - (when grouplens-bbb-token - (let ((bbb-process - (bbb-connect-to-bbbd grouplens-bbb-host grouplens-bbb-port))) - (when bbb-process - (save-excursion - (set-buffer (process-buffer bbb-process)) - (bbb-send-command bbb-process (concat "logout " grouplens-bbb-token)) - (bbb-read-response bbb-process)))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; Get Predictions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun bbb-build-mid-scores-alist (groupname) - "this function can be called as part of the function to return the list of score files to use. -See the gnus variable `gnus-score-find-score-files-function'. - -*Note:* If you want to use grouplens scores along with calculated scores, -you should see the offset and scale variables. At this point, I don't -recommend using both scores and grouplens predictions together." - (setq grouplens-current-group groupname) - (when (member groupname grouplens-newsgroups) - (setq grouplens-previous-article nil) - ;; scores-alist should be a list of lists: - ;; ((("message-id" ("" score1 nil s) (" score2 nil s)))) - ;;`((("message-id" . ,predict-list))) ; Yes, this is the return value - (list - (list - (list (append (list "message-id") - (bbb-get-predictions (bbb-get-all-mids) groupname))))))) - -(defun bbb-get-predictions (midlist groupname) - "Ask the bbb for predictions, and build up the score alist." - (gnus-message 5 "Fetching Predictions...") - (if grouplens-bbb-token - (let ((bbb-process (bbb-connect-to-bbbd grouplens-bbb-host - grouplens-bbb-port))) - (when bbb-process - (save-excursion - (set-buffer (process-buffer bbb-process)) - (bbb-send-command bbb-process - (bbb-build-predict-command midlist groupname - grouplens-bbb-token)) - (if (bbb-read-response bbb-process) - (bbb-get-prediction-response bbb-process) - (gnus-message 1 "Invalid Token, login and try again") - (ding))))) - (gnus-message 3 "Error: You are not logged in to a BBB") - (ding))) - -(defun bbb-get-all-mids () - (mapcar (function (lambda (x) (mail-header-id x))) gnus-newsgroup-headers)) - -(defun bbb-build-predict-command (mlist grpname token) - (concat "getpredictions " token " " grpname "\r\n" - (mapconcat 'identity mlist "\r\n") "\r\n.\r\n")) - -(defun bbb-get-prediction-response (process) - (let ((case-fold-search nil)) - (goto-char bbb-read-point) - (while (and (not (search-forward ".\r\n" nil t)) - (accept-process-output process bbb-timeout-secs)) - (goto-char bbb-read-point)) - (goto-char (+ bbb-response-point 4));; we ought to be right before OK - (bbb-build-response-alist))) - -;; build-response-alist assumes that the cursor has been positioned at -;; the first line of the list of mid/rating pairs. -(defun bbb-build-response-alist () - (let (resp mid pred) - (while - (cond - ((looking-at "\\(<.*>\\) :nopred=") - ;;(push `(,(bbb-get-mid) ,gnus-summary-default-score nil s) resp) - (forward-line 1) - t) - ((looking-at "\\(<.*>\\) :pred=\\([0-9]\.[0-9][0-9]\\) :conflow=\\([0-9]\.[0-9][0-9]\\) :confhigh=\\([0-9]\.[0-9][0-9]\\)") - (setq mid (bbb-get-mid) - pred (bbb-get-pred)) - (push `(,mid ,pred nil s) resp) - (gnus-sethash mid (list pred (bbb-get-confl) (bbb-get-confh)) - grouplens-current-hashtable) - (forward-line 1) - t) - ((looking-at "\\(<.*>\\) :pred=\\([0-9]\.[0-9][0-9]\\)") - (setq mid (bbb-get-mid) - pred (bbb-get-pred)) - (push `(,mid ,pred nil s) resp) - (gnus-sethash mid (list pred 0 0) grouplens-current-hashtable) - (forward-line 1) - t) - (t nil))) - resp)) - -;; these "get" functions assume that there is an active match lying -;; around. Where the first parenthesized expression is the -;; message-id, and the second is the prediction, the third and fourth -;; are the confidence interval -;; -;; Since gnus assumes that scores are integer values?? we round the -;; prediction. -(defun bbb-get-mid () - (buffer-substring (match-beginning 1) (match-end 1))) - -(defun bbb-get-pred () - (let ((tpred (string-to-number (buffer-substring (match-beginning 2) - (match-end 2))))) - (if (> tpred 0) - (round (* grouplens-score-scale-factor - (+ grouplens-score-offset tpred))) - 1))) - -(defun bbb-get-confl () - (string-to-number (buffer-substring (match-beginning 4) (match-end 4)))) - -(defun bbb-get-confh () - (string-to-number (buffer-substring (match-beginning 4) (match-end 4)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; Prediction Display -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defconst grplens-rating-range 4.0) -(defconst grplens-maxrating 5) -(defconst grplens-minrating 1) -(defconst grplens-predstringsize 12) - -(defvar gnus-tmp-score) -(defun bbb-grouplens-score (header) - (if (eq gnus-grouplens-override-scoring 'separate) - (bbb-grouplens-other-score header) - (let* ((rate-string (make-string 12 ?\ )) - (mid (mail-header-id header)) - (hashent (gnus-gethash mid grouplens-current-hashtable)) - (iscore gnus-tmp-score) - (low (car (cdr hashent))) - (high (car (cdr (cdr hashent))))) - (aset rate-string 0 ?|) - (aset rate-string 11 ?|) - (unless (member grouplens-current-group grouplens-newsgroups) - (unless (equal grouplens-prediction-display 'prediction-num) - (cond ((< iscore 0) - (setq iscore 1)) - ((> iscore 5) - (setq iscore 5)))) - (setq low 0) - (setq high 0)) - (if (and (bbb-valid-score iscore) - (not (null mid))) - (cond - ;; prediction-spot - ((equal grouplens-prediction-display 'prediction-spot) - (setq rate-string (bbb-fmt-prediction-spot rate-string iscore))) - ;; confidence-interval - ((equal grouplens-prediction-display 'confidence-interval) - (setq rate-string (bbb-fmt-confidence-interval iscore low high))) - ;; prediction-bar - ((equal grouplens-prediction-display 'prediction-bar) - (setq rate-string (bbb-fmt-prediction-bar rate-string iscore))) - ;; confidence-bar - ((equal grouplens-prediction-display 'confidence-bar) - (setq rate-string (format "| %4.2f |" iscore))) - ;; confidence-spot - ((equal grouplens-prediction-display 'confidence-spot) - (setq rate-string (format "| %4.2f |" iscore))) - ;; prediction-num - ((equal grouplens-prediction-display 'prediction-num) - (setq rate-string (bbb-fmt-prediction-num iscore))) - ;; confidence-plus-minus - ((equal grouplens-prediction-display 'confidence-plus-minus) - (setq rate-string (bbb-fmt-confidence-plus-minus iscore low high)) - ) - (t (gnus-message 3 "Invalid prediction display type"))) - (aset rate-string 5 ?N) (aset rate-string 6 ?A)) - rate-string))) - -;; Gnus user format function that doesn't depend on -;; bbb-build-mid-scores-alist being used as the score function, but is -;; instead called from gnus-select-group-hook. -- LAB -(defun bbb-grouplens-other-score (header) - (if (not (member grouplens-current-group grouplens-newsgroups)) - ;; Return an empty string - "" - (let* ((rate-string (make-string 12 ?\ )) - (mid (mail-header-id header)) - (hashent (gnus-gethash mid grouplens-current-hashtable)) - (pred (or (nth 0 hashent) 0)) - (low (nth 1 hashent)) - (high (nth 2 hashent))) - ;; Init rate-string - (aset rate-string 0 ?|) - (aset rate-string 11 ?|) - (unless (equal grouplens-prediction-display 'prediction-num) - (cond ((< pred 0) - (setq pred 1)) - ((> pred 5) - (setq pred 5)))) - ;; If no entry in BBB hash mark rate string as NA and return - (cond - ((null hashent) - (aset rate-string 5 ?N) - (aset rate-string 6 ?A) - rate-string) - - ((equal grouplens-prediction-display 'prediction-spot) - (bbb-fmt-prediction-spot rate-string pred)) - - ((equal grouplens-prediction-display 'confidence-interval) - (bbb-fmt-confidence-interval pred low high)) - - ((equal grouplens-prediction-display 'prediction-bar) - (bbb-fmt-prediction-bar rate-string pred)) - - ((equal grouplens-prediction-display 'confidence-bar) - (format "| %4.2f |" pred)) - - ((equal grouplens-prediction-display 'confidence-spot) - (format "| %4.2f |" pred)) - - ((equal grouplens-prediction-display 'prediction-num) - (bbb-fmt-prediction-num pred)) - - ((equal grouplens-prediction-display 'confidence-plus-minus) - (bbb-fmt-confidence-plus-minus pred low high)) - - (t - (gnus-message 3 "Invalid prediction display type") - (aset rate-string 0 ?|) - (aset rate-string 11 ?|) - rate-string))))) - -(defun bbb-valid-score (score) - (or (equal grouplens-prediction-display 'prediction-num) - (and (>= score grplens-minrating) - (<= score grplens-maxrating)))) - -(defun bbb-requires-confidence (format-type) - (or (equal format-type 'confidence-plus-minus) - (equal format-type 'confidence-spot) - (equal format-type 'confidence-interval))) - -(defun bbb-have-confidence (clow chigh) - (not (or (null clow) - (null chigh)))) - -(defun bbb-fmt-prediction-spot (rate-string score) - (aset rate-string - (round (* (/ (- score grplens-minrating) grplens-rating-range) - (+ (- grplens-predstringsize 4) 1.49))) - ?*) - rate-string) - -(defun bbb-fmt-confidence-interval (score low high) - (if (bbb-have-confidence low high) - (format "|%4.2f-%4.2f |" low high) - (bbb-fmt-prediction-num score))) - -(defun bbb-fmt-confidence-plus-minus (score low high) - (if (bbb-have-confidence low high) - (format "|%3.1f+/-%4.2f|" score (/ (- high low) 2.0)) - (bbb-fmt-prediction-num score))) - -(defun bbb-fmt-prediction-bar (rate-string score) - (let* ((i 1) - (step (/ grplens-rating-range (- grplens-predstringsize 4))) - (half-step (/ step 2)) - (loc (- grplens-minrating half-step))) - (while (< i (- grplens-predstringsize 2)) - (if (> score loc) - (aset rate-string i ?#) - (aset rate-string i ?\ )) - (setq i (+ i 1)) - (setq loc (+ loc step))) - ) - rate-string) - -(defun bbb-fmt-prediction-num (score) - (format "| %4.2f |" score)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; Put Ratings -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun bbb-put-ratings () - (if (and grouplens-bbb-token - grouplens-rating-alist - (member gnus-newsgroup-name grouplens-newsgroups)) - (let ((bbb-process (bbb-connect-to-bbbd grouplens-bbb-host - grouplens-bbb-port)) - (rate-command (bbb-build-rate-command grouplens-rating-alist))) - (if bbb-process - (save-excursion - (set-buffer (process-buffer bbb-process)) - (gnus-message 5 "Sending Ratings...") - (bbb-send-command bbb-process rate-command) - (if (bbb-read-response bbb-process) - (setq grouplens-rating-alist nil) - (gnus-message 1 - "Token timed out: call bbb-login and quit again") - (ding)) - (gnus-message 5 "Sending Ratings...Done")) - (gnus-message 3 "No BBB connection"))) - (setq grouplens-rating-alist nil))) - -(defun bbb-build-rate-command (rate-alist) - (concat "putratings " grouplens-bbb-token " " grouplens-current-group " \r\n" - (mapconcat (lambda (this) ; form (mid . (score . time)) - (concat (car this) - " :rating=" (cadr this) ".00" - " :time=" (cddr this))) - rate-alist "\r\n") - "\r\n.\r\n")) - -;; Interactive rating functions. -(defun bbb-summary-rate-article (rating &optional midin) - (interactive "nRating: ") - (when (member gnus-newsgroup-name grouplens-newsgroups) - (let ((mid (or midin (bbb-get-current-id)))) - (if (and rating - (>= rating grplens-minrating) - (<= rating grplens-maxrating) - mid) - (let ((oldrating (assoc mid grouplens-rating-alist))) - (if oldrating - (setcdr oldrating (cons rating 0)) - (push `(,mid . (,rating . 0)) grouplens-rating-alist)) - (gnus-summary-mark-article nil (int-to-string rating))) - (gnus-message 3 "Invalid rating"))))) - -(defun grouplens-next-unread-article (rating) - "Select unread article after current one." - (interactive "P") - (when rating - (bbb-summary-rate-article rating)) - (gnus-summary-next-unread-article)) - -(defun grouplens-best-unread-article (rating) - "Select unread article after current one." - (interactive "P") - (when rating - (bbb-summary-rate-article rating)) - (gnus-summary-best-unread-article)) - -(defun grouplens-summary-catchup-and-exit (rating) - "Mark all articles not marked as unread in this newsgroup as read, then exit. -If prefix argument ALL is non-nil, all articles are marked as read." - (interactive "P") - (when rating - (bbb-summary-rate-article rating)) - (if (numberp rating) - (gnus-summary-catchup-and-exit) - (gnus-summary-catchup-and-exit rating))) - -(defun grouplens-score-thread (score) - "Raise the score of the articles in the current thread with SCORE." - (interactive "nRating: ") - (let (e) - (save-excursion - (let ((articles (gnus-summary-articles-in-thread)) - article) - (while (setq article (pop articles)) - (gnus-summary-goto-subject article) - (bbb-summary-rate-article score - (mail-header-id - (gnus-summary-article-header article))))) - (setq e (point))) - (let ((gnus-summary-check-current t)) - (or (zerop (gnus-summary-next-subject 1 t)) - (goto-char e)))) - (gnus-summary-recenter) - (gnus-summary-position-point) - (gnus-set-mode-line 'summary)) - -(defun bbb-exit-group () - (bbb-put-ratings) - (bbb-renew-hash-table)) - -(defun bbb-get-current-id () - (if gnus-current-headers - (mail-header-id gnus-current-headers) - (gnus-message 3 "You must select an article before you rate it"))) - -(defun bbb-grouplens-group-p (group) - "Say whether GROUP is a GroupLens group." - (if (member group grouplens-newsgroups) " (GroupLens Enhanced)" "")) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; TIME SPENT READING -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar grouplens-current-starting-time nil) - -(defun grouplens-start-timer () - (setq grouplens-current-starting-time (current-time))) - -(defun grouplens-elapsed-time () - (let ((et (bbb-time-float (current-time)))) - (- et (bbb-time-float grouplens-current-starting-time)))) - -(defun bbb-time-float (timeval) - (+ (* (car timeval) 65536) - (cadr timeval))) - -(defun grouplens-do-time () - (when (member gnus-newsgroup-name grouplens-newsgroups) - (when grouplens-previous-article - (let ((elapsed-time (grouplens-elapsed-time)) - (oldrating (assoc grouplens-previous-article - grouplens-rating-alist))) - (if (not oldrating) - (push `(,grouplens-previous-article . (0 . ,elapsed-time)) - grouplens-rating-alist) - (setcdr oldrating (cons (cadr oldrating) elapsed-time))))) - (grouplens-start-timer) - (setq grouplens-previous-article (bbb-get-current-id)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; BUG REPORTING -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst gnus-gl-version "gnus-gl.el 2.50") -(defconst gnus-gl-maintainer-address "grouplens-bug@cs.umn.edu") -(defun gnus-gl-submit-bug-report () - "Submit via mail a bug report on gnus-gl." - (interactive) - (require 'reporter) - (reporter-submit-bug-report gnus-gl-maintainer-address - (concat "gnus-gl.el " gnus-gl-version) - (list 'grouplens-pseudonym - 'grouplens-bbb-host - 'grouplens-bbb-port - 'grouplens-newsgroups - 'grouplens-bbb-token - 'grouplens-bbb-process - 'grouplens-current-group - 'grouplens-previous-article) - nil - 'gnus-gl-get-trace)) - -(defun gnus-gl-get-trace () - "Insert the contents of the BBBD trace buffer." - (when grouplens-bbb-buffer - (insert-buffer-substring grouplens-bbb-buffer))) - -;; -;; GroupLens minor mode -;; - -(defvar gnus-grouplens-mode nil - "Minor mode for providing a GroupLens interface in Gnus summary buffers.") - -(defvar gnus-grouplens-mode-map nil) - -(unless gnus-grouplens-mode-map - (setq gnus-grouplens-mode-map (make-keymap)) - (gnus-define-keys - gnus-grouplens-mode-map - "n" grouplens-next-unread-article - "r" bbb-summary-rate-article - "k" grouplens-score-thread - "c" grouplens-summary-catchup-and-exit - "," grouplens-best-unread-article)) - -(defun gnus-grouplens-make-menu-bar () - (unless (boundp 'gnus-grouplens-menu) - (easy-menu-define - gnus-grouplens-menu gnus-grouplens-mode-map "" - '("GroupLens" - ["Login" bbb-login t] - ["Rate" bbb-summary-rate-article t] - ["Next article" grouplens-next-unread-article t] - ["Best article" grouplens-best-unread-article t] - ["Raise thread" grouplens-score-thread t] - ["Report bugs" gnus-gl-submit-bug-report t])))) - -(defun gnus-grouplens-mode (&optional arg) - "Minor mode for providing a GroupLens interface in Gnus summary buffers." - (interactive "P") - (when (and (eq major-mode 'gnus-summary-mode) - (member gnus-newsgroup-name grouplens-newsgroups)) - (make-local-variable 'gnus-grouplens-mode) - (setq gnus-grouplens-mode - (if (null arg) (not gnus-grouplens-mode) - (> (prefix-numeric-value arg) 0))) - (when gnus-grouplens-mode - (gnus-make-local-hook 'gnus-select-article-hook) - (add-hook 'gnus-select-article-hook 'grouplens-do-time nil 'local) - (gnus-make-local-hook 'gnus-exit-group-hook) - (add-hook 'gnus-exit-group-hook 'bbb-exit-group nil 'local) - (make-local-variable 'gnus-score-find-score-files-function) - - (cond - ((eq gnus-grouplens-override-scoring 'combine) - ;; either add bbb-buld-mid-scores-alist to a list - ;; or make a list - (if (listp gnus-score-find-score-files-function) - (setq gnus-score-find-score-files-function - (append 'bbb-build-mid-scores-alist - gnus-score-find-score-files-function)) - (setq gnus-score-find-score-files-function - (list gnus-score-find-score-files-function - 'bbb-build-mid-scores-alist)))) - ;; leave the gnus-score-find-score-files variable alone - ((eq gnus-grouplens-override-scoring 'separate) - (add-hook 'gnus-select-group-hook - (lambda () - (bbb-get-predictions (bbb-get-all-mids) - gnus-newsgroup-name)))) - ;; default is to override - (t - (setq gnus-score-find-score-files-function - 'bbb-build-mid-scores-alist))) - - ;; Change how summary lines look - (make-local-variable 'gnus-summary-line-format) - (make-local-variable 'gnus-summary-line-format-spec) - (setq gnus-summary-line-format gnus-summary-grouplens-line-format) - (setq gnus-summary-line-format-spec nil) - (gnus-update-format-specifications nil 'summary) - (gnus-update-summary-mark-positions) - - ;; Set up the menu. - (when (and menu-bar-mode - (gnus-visual-p 'grouplens-menu 'menu)) - (gnus-grouplens-make-menu-bar)) - (gnus-add-minor-mode - 'gnus-grouplens-mode " GroupLens" gnus-grouplens-mode-map) - (gnus-run-hooks 'gnus-grouplens-mode-hook)))) - -(provide 'gnus-gl) - -;;; arch-tag: 6f1bab2c-c2a3-4764-9ef6-0714cd5902a4 -;;; gnus-gl.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-group.el b/xemacs-packages/gnus/lisp/gnus-group.el deleted file mode 100644 index 28cda1a9..00000000 --- a/xemacs-packages/gnus/lisp/gnus-group.el +++ /dev/null @@ -1,4472 +0,0 @@ -;;; gnus-group.el --- group mode commands for Gnus - -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile - (require 'cl) - (defvar tool-bar-mode)) - -(require 'gnus) -(require 'gnus-start) -(require 'nnmail) -(require 'gnus-spec) -(require 'gnus-int) -(require 'gnus-range) -(require 'gnus-win) -(require 'gnus-undo) -(require 'gmm-utils) -(require 'time-date) -(require 'gnus-ems) - -(eval-when-compile - (require 'mm-url) - (let ((features (cons 'gnus-group features))) - (require 'gnus-sum)) - (defvar gnus-cache-active-hashtb)) - -(defcustom gnus-group-archive-directory - "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/" - "*The address of the (ding) archives." - :group 'gnus-group-foreign - :type 'directory) - -(defcustom gnus-group-recent-archive-directory - "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/" - "*The address of the most recent (ding) articles." - :group 'gnus-group-foreign - :type 'directory) - -(defcustom gnus-no-groups-message "No gnus is bad news" - "*Message displayed by Gnus when no groups are available." - :group 'gnus-start - :type 'string) - -(defcustom gnus-keep-same-level nil - "*Non-nil means that the next newsgroup after the current will be on the same level. -When you type, for instance, `n' after reading the last article in the -current newsgroup, you will go to the next newsgroup. If this variable -is nil, the next newsgroup will be the next from the group -buffer. -If this variable is non-nil, Gnus will either put you in the -next newsgroup with the same level, or, if no such newsgroup is -available, the next newsgroup with the lowest possible level higher -than the current level. -If this variable is `best', Gnus will make the next newsgroup the one -with the best level." - :group 'gnus-group-levels - :type '(choice (const nil) - (const best) - (sexp :tag "other" t))) - -(defcustom gnus-group-goto-unread t - "*If non-nil, movement commands will go to the next unread and subscribed group." - :link '(custom-manual "(gnus)Group Maneuvering") - :group 'gnus-group-various - :type 'boolean) - -(defcustom gnus-goto-next-group-when-activating t - "*If non-nil, the \\\\[gnus-group-get-new-news-this-group] command will advance point to the next group." - :link '(custom-manual "(gnus)Scanning New Messages") - :group 'gnus-group-various - :type 'boolean) - -(defcustom gnus-permanently-visible-groups nil - "*Regexp to match groups that should always be listed in the group buffer. -This means that they will still be listed even when there are no -unread articles in the groups. - -If nil, no groups are permanently visible." - :group 'gnus-group-listing - :type '(choice regexp (const nil))) - -(defcustom gnus-list-groups-with-ticked-articles t - "*If non-nil, list groups that have only ticked articles. -If nil, only list groups that have unread articles." - :group 'gnus-group-listing - :type 'boolean) - -(defcustom gnus-group-default-list-level gnus-level-subscribed - "*Default listing level. -Ignored if `gnus-group-use-permanent-levels' is non-nil." - :group 'gnus-group-listing - :type 'integer) - -(defcustom gnus-group-list-inactive-groups t - "*If non-nil, inactive groups will be listed." - :group 'gnus-group-listing - :group 'gnus-group-levels - :type 'boolean) - -(defcustom gnus-group-sort-function 'gnus-group-sort-by-alphabet - "*Function used for sorting the group buffer. -This function will be called with group info entries as the arguments -for the groups to be sorted. Pre-made functions include -`gnus-group-sort-by-alphabet', `gnus-group-sort-by-real-name', -`gnus-group-sort-by-unread', `gnus-group-sort-by-level', -`gnus-group-sort-by-score', `gnus-group-sort-by-method', -`gnus-group-sort-by-server', and `gnus-group-sort-by-rank'. - -This variable can also be a list of sorting functions. In that case, -the most significant sort function should be the last function in the -list." - :group 'gnus-group-listing - :link '(custom-manual "(gnus)Sorting Groups") - :type '(repeat :value-to-internal (lambda (widget value) - (if (listp value) value (list value))) - :match (lambda (widget value) - (or (symbolp value) - (widget-editable-list-match widget value))) - (choice (function-item gnus-group-sort-by-alphabet) - (function-item gnus-group-sort-by-real-name) - (function-item gnus-group-sort-by-unread) - (function-item gnus-group-sort-by-level) - (function-item gnus-group-sort-by-score) - (function-item gnus-group-sort-by-method) - (function-item gnus-group-sort-by-server) - (function-item gnus-group-sort-by-rank) - (function :tag "other" nil)))) - -(defcustom gnus-group-line-format "%M\%S\%p\%P\%5y:%B%(%g%)%l %O\n" - "*Format of group lines. -It works along the same lines as a normal formatting string, -with some simple extensions. - -%M Only marked articles (character, \"*\" or \" \") -%S Whether the group is subscribed (character, \"U\", \"K\", \"Z\" or \" \") -%L Level of subscribedness (integer) -%N Number of unread articles (integer) -%I Number of dormant articles (integer) -%i Number of ticked and dormant (integer) -%T Number of ticked articles (integer) -%R Number of read articles (integer) -%U Number of unseen articles (integer) -%t Estimated total number of articles (integer) -%y Number of unread, unticked articles (integer) -%G Group name (string) -%g Qualified group name (string) -%c Short (collapsed) group name. See `gnus-group-uncollapsed-levels'. -%C Group comment (string) -%D Group description (string) -%s Select method (string) -%o Moderated group (char, \"m\") -%p Process mark (char) -%B Whether a summary buffer for the group is open (char, \"*\") -%O Moderated group (string, \"(m)\" or \"\") -%P Topic indentation (string) -%m Whether there is new(ish) mail in the group (char, \"%\") -%l Whether there are GroupLens predictions for this group (string) -%n Select from where (string) -%z A string that look like `<%s:%n>' if a foreign select method is used -%d The date the group was last entered. -%E Icon as defined by `gnus-group-icon-list'. -%u User defined specifier. The next character in the format string should - be a letter. Gnus will call the function gnus-user-format-function-X, - where X is the letter following %u. The function will be passed a - single dummy parameter as argument. The function should return a - string, which will be inserted into the buffer just like information - from any other group specifier. - -Note that this format specification is not always respected. For -reasons of efficiency, when listing killed groups, this specification -is ignored altogether. If the spec is changed considerably, your -output may end up looking strange when listing both alive and killed -groups. - -If you use %o or %O, reading the active file will be slower and quite -a bit of extra memory will be used. %D will also worsen performance. -Also note that if you change the format specification to include any -of these specs, you must probably re-start Gnus to see them go into -effect. - -General format specifiers can also be used. -See Info node `(gnus)Formatting Variables'." - :link '(custom-manual "(gnus)Formatting Variables") - :group 'gnus-group-visual - :type 'string) - -(defcustom gnus-group-mode-line-format "Gnus: %%b {%M\%:%S}" - "*The format specification for the group mode line. -It works along the same lines as a normal formatting string, -with some simple extensions: - -%S The native news server. -%M The native select method. -%: \":\" if %S isn't \"\"." - :group 'gnus-group-visual - :type 'string) - -;; Extracted from gnus-xmas-redefine in order to preserve user settings -(when (featurep 'xemacs) - (add-hook 'gnus-group-mode-hook 'gnus-xmas-group-menu-add) - (add-hook 'gnus-group-mode-hook 'gnus-xmas-setup-group-toolbar)) - -(defcustom gnus-group-menu-hook nil - "Hook run after the creation of the group mode menu." - :group 'gnus-group-various - :type 'hook) - -(defcustom gnus-group-catchup-group-hook nil - "Hook run when catching up a group from the group buffer." - :group 'gnus-group-various - :link '(custom-manual "(gnus)Group Data") - :type 'hook) - -(defcustom gnus-group-update-group-hook nil - "Hook called when updating group lines." - :group 'gnus-group-visual - :type 'hook) - -(defcustom gnus-group-prepare-function 'gnus-group-prepare-flat - "*A function that is called to generate the group buffer. -The function is called with three arguments: The first is a number; -all group with a level less or equal to that number should be listed, -if the second is non-nil, empty groups should also be displayed. If -the third is non-nil, it is a number. No groups with a level lower -than this number should be displayed. - -The only current function implemented is `gnus-group-prepare-flat'." - :group 'gnus-group-listing - :type 'function) - -(defcustom gnus-group-prepare-hook nil - "Hook called after the group buffer has been generated. -If you want to modify the group buffer, you can use this hook." - :group 'gnus-group-listing - :type 'hook) - -(defcustom gnus-suspend-gnus-hook nil - "Hook called when suspending (not exiting) Gnus." - :group 'gnus-exit - :type 'hook) - -(defcustom gnus-exit-gnus-hook nil - "Hook called when exiting Gnus." - :group 'gnus-exit - :type 'hook) - -(defcustom gnus-after-exiting-gnus-hook nil - "Hook called after exiting Gnus." - :group 'gnus-exit - :type 'hook) - -(defcustom gnus-group-update-hook '(gnus-group-highlight-line) - "Hook called when a group line is changed. -The hook will not be called if `gnus-visual' is nil. - -The default function `gnus-group-highlight-line' will -highlight the line according to the `gnus-group-highlight' -variable." - :group 'gnus-group-visual - :type 'hook) - -(defcustom gnus-useful-groups - '(("(ding) mailing list mirrored at gmane.org" - "gmane.emacs.gnus.general" - (nntp "Gmane" - (nntp-address "news.gmane.org"))) - ("Gnus bug archive" - "gnus.gnus-bug" - (nntp "news.gnus.org" - (nntp-address "news.gnus.org"))) - ("Local Gnus help group" - "gnus-help" - (nndoc "gnus-help" - (nndoc-article-type mbox) - (eval `(nndoc-address - ,(let ((file (nnheader-find-etc-directory - "gnus-tut.txt" t))) - (unless file - (error "Couldn't find doc group")) - file)))))) - "*Alist of useful group-server pairs." - :group 'gnus-group-listing - :type '(repeat (list (string :tag "Description") - (string :tag "Name") - (sexp :tag "Method")))) - -(defcustom gnus-group-highlight - '(;; Mail. - ((and mailp (= unread 0) (eq level 1)) . - gnus-group-mail-1-empty) - ((and mailp (eq level 1)) . - gnus-group-mail-1) - ((and mailp (= unread 0) (eq level 2)) . - gnus-group-mail-2-empty) - ((and mailp (eq level 2)) . - gnus-group-mail-2) - ((and mailp (= unread 0) (eq level 3)) . - gnus-group-mail-3-empty) - ((and mailp (eq level 3)) . - gnus-group-mail-3) - ((and mailp (= unread 0)) . - gnus-group-mail-low-empty) - ((and mailp) . - gnus-group-mail-low) - ;; News. - ((and (= unread 0) (eq level 1)) . - gnus-group-news-1-empty) - ((and (eq level 1)) . - gnus-group-news-1) - ((and (= unread 0) (eq level 2)) . - gnus-group-news-2-empty) - ((and (eq level 2)) . - gnus-group-news-2) - ((and (= unread 0) (eq level 3)) . - gnus-group-news-3-empty) - ((and (eq level 3)) . - gnus-group-news-3) - ((and (= unread 0) (eq level 4)) . - gnus-group-news-4-empty) - ((and (eq level 4)) . - gnus-group-news-4) - ((and (= unread 0) (eq level 5)) . - gnus-group-news-5-empty) - ((and (eq level 5)) . - gnus-group-news-5) - ((and (= unread 0) (eq level 6)) . - gnus-group-news-6-empty) - ((and (eq level 6)) . - gnus-group-news-6) - ((and (= unread 0)) . - gnus-group-news-low-empty) - (t . - gnus-group-news-low)) - "*Controls the highlighting of group buffer lines. - -Below is a list of `Form'/`Face' pairs. When deciding how a a -particular group line should be displayed, each form is -evaluated. The content of the face field after the first true form is -used. You can change how those group lines are displayed by -editing the face field. - -It is also possible to change and add form fields, but currently that -requires an understanding of Lisp expressions. Hopefully this will -change in a future release. For now, you can use the following -variables in the Lisp expression: - -group: The name of the group. -unread: The number of unread articles in the group. -method: The select method used. -mailp: Whether it's a mail group or not. -level: The level of the group. -score: The score of the group. -ticked: The number of ticked articles." - :group 'gnus-group-visual - :type '(repeat (cons (sexp :tag "Form") face))) -(put 'gnus-group-highlight 'risky-local-variable t) - -(defcustom gnus-new-mail-mark ?% - "Mark used for groups with new mail." - :group 'gnus-group-visual - :type 'character) - -(defgroup gnus-group-icons nil - "Add Icons to your group buffer." - :group 'gnus-group-visual) - -(defcustom gnus-group-icon-list - nil - "*Controls the insertion of icons into group buffer lines. - -Below is a list of `Form'/`File' pairs. When deciding how a -particular group line should be displayed, each form is evaluated. -The icon from the file field after the first true form is used. You -can change how those group lines are displayed by editing the file -field. The File will either be found in the -`gnus-group-glyph-directory' or by designating absolute name of the -file. - -It is also possible to change and add form fields, but currently that -requires an understanding of Lisp expressions. Hopefully this will -change in a future release. For now, you can use the following -variables in the Lisp expression: - -group: The name of the group. -unread: The number of unread articles in the group. -method: The select method used. -mailp: Whether it's a mail group or not. -newsp: Whether it's a news group or not -level: The level of the group. -score: The score of the group. -ticked: The number of ticked articles." - :group 'gnus-group-icons - :type '(repeat (cons (sexp :tag "Form") file))) -(put 'gnus-group-icon-list 'risky-local-variable t) - -(defcustom gnus-group-name-charset-method-alist nil - "Alist of method and the charset for group names. - -For example: - (((nntp \"news.com.cn\") . cn-gb-2312))" - :version "21.1" - :group 'gnus-charset - :type '(repeat (cons (sexp :tag "Method") (symbol :tag "Charset")))) - -(defcustom gnus-group-name-charset-group-alist - (if (or (and (fboundp 'find-coding-system) (find-coding-system 'utf-8)) - (mm-coding-system-p 'utf-8)) - '((".*" . utf-8)) - nil) - "Alist of group regexp and the charset for group names. - -For example: - ((\"\\.com\\.cn:\" . cn-gb-2312))" - :group 'gnus-charset - :type '(repeat (cons (regexp :tag "Group") (symbol :tag "Charset")))) - -(defcustom gnus-group-jump-to-group-prompt nil - "Default prompt for `gnus-group-jump-to-group'. -If non-nil, the value should be a string, e.g. \"nnml:\", -in which case `gnus-group-jump-to-group' offers \"Group: nnml:\" -in the minibuffer prompt." - :version "22.1" - :group 'gnus-group-various - :type '(choice (string :tag "Prompt string") - (const :tag "Empty" nil))) - -(defvar gnus-group-listing-limit 1000 - "*A limit of the number of groups when listing. -If the number of groups is larger than the limit, list them in a -simple manner.") - -;;; Internal variables - -(defvar gnus-group-is-exiting-p nil) -(defvar gnus-group-is-exiting-without-update-p nil) -(defvar gnus-group-sort-alist-function 'gnus-group-sort-flat - "Function for sorting the group buffer.") - -(defvar gnus-group-sort-selected-function 'gnus-group-sort-selected-flat - "Function for sorting the selected groups in the group buffer.") - -(defvar gnus-group-indentation-function nil) -(defvar gnus-goto-missing-group-function nil) -(defvar gnus-group-update-group-function nil) -(defvar gnus-group-goto-next-group-function nil - "Function to override finding the next group after listing groups.") - -(defvar gnus-group-edit-buffer nil) - -(defvar gnus-group-line-format-alist - `((?M gnus-tmp-marked-mark ?c) - (?S gnus-tmp-subscribed ?c) - (?L gnus-tmp-level ?d) - (?N (cond ((eq number t) "*" ) - ((numberp number) - (int-to-string - (+ number - (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) - (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))))) - (t number)) ?s) - (?R gnus-tmp-number-of-read ?s) - (?U (gnus-number-of-unseen-articles-in-group gnus-tmp-group) ?d) - (?t gnus-tmp-number-total ?d) - (?y gnus-tmp-number-of-unread ?s) - (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d) - (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d) - (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) - (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d) - (?g (if (boundp 'gnus-tmp-decoded-group) - gnus-tmp-decoded-group - gnus-tmp-group) - ?s) - (?G gnus-tmp-qualified-group ?s) - (?c (gnus-short-group-name (if (boundp 'gnus-tmp-decoded-group) - gnus-tmp-decoded-group - gnus-tmp-group)) - ?s) - (?C gnus-tmp-comment ?s) - (?D gnus-tmp-newsgroup-description ?s) - (?o gnus-tmp-moderated ?c) - (?O gnus-tmp-moderated-string ?s) - (?p gnus-tmp-process-marked ?c) - (?s gnus-tmp-news-server ?s) - (?n ,(if (featurep 'xemacs) - '(symbol-name gnus-tmp-news-method) - 'gnus-tmp-news-method) - ?s) - (?P gnus-group-indentation ?s) - (?E gnus-tmp-group-icon ?s) - (?B gnus-tmp-summary-live ?c) - (?l gnus-tmp-grouplens ?s) - (?z gnus-tmp-news-method-string ?s) - (?m (gnus-group-new-mail gnus-tmp-group) ?c) - (?d (gnus-group-timestamp-string gnus-tmp-group) ?s) - (?u gnus-tmp-user-defined ?s))) - -(defvar gnus-group-mode-line-format-alist - `((?S gnus-tmp-news-server ?s) - (?M gnus-tmp-news-method ?s) - (?u gnus-tmp-user-defined ?s) - (?: gnus-tmp-colon ?s))) - -(defvar gnus-topic-topology nil - "The complete topic hierarchy.") - -(defvar gnus-topic-alist nil - "The complete topic-group alist.") - -(defvar gnus-group-marked nil) - -(defvar gnus-group-list-mode nil) - - -(defvar gnus-group-icon-cache nil) - -(defvar gnus-group-listed-groups nil) -(defvar gnus-group-list-option nil) - -;;; -;;; Gnus group mode -;;; - -(put 'gnus-group-mode 'mode-class 'special) - -(gnus-define-keys gnus-group-mode-map - " " gnus-group-read-group - "=" gnus-group-select-group - "\r" gnus-group-select-group - "\M-\r" gnus-group-quick-select-group - "\M- " gnus-group-visible-select-group - [(meta control return)] gnus-group-select-group-ephemerally - "j" gnus-group-jump-to-group - "n" gnus-group-next-unread-group - "p" gnus-group-prev-unread-group - "\177" gnus-group-prev-unread-group - [delete] gnus-group-prev-unread-group - [backspace] gnus-group-prev-unread-group - "N" gnus-group-next-group - "P" gnus-group-prev-group - "\M-n" gnus-group-next-unread-group-same-level - "\M-p" gnus-group-prev-unread-group-same-level - "," gnus-group-best-unread-group - "." gnus-group-first-unread-group - "u" gnus-group-unsubscribe-current-group - "U" gnus-group-unsubscribe-group - "c" gnus-group-catchup-current - "C" gnus-group-catchup-current-all - "\M-c" gnus-group-clear-data - "l" gnus-group-list-groups - "L" gnus-group-list-all-groups - "m" gnus-group-mail - "i" gnus-group-news - "g" gnus-group-get-new-news - "\M-g" gnus-group-get-new-news-this-group - "R" gnus-group-restart - "r" gnus-group-read-init-file - "B" gnus-group-browse-foreign-server - "b" gnus-group-check-bogus-groups - "F" gnus-group-find-new-groups - "\C-c\C-d" gnus-group-describe-group - "\M-d" gnus-group-describe-all-groups - "\C-c\C-a" gnus-group-apropos - "\C-c\M-\C-a" gnus-group-description-apropos - "a" gnus-group-post-news - "\ek" gnus-group-edit-local-kill - "\eK" gnus-group-edit-global-kill - "\C-k" gnus-group-kill-group - "\C-y" gnus-group-yank-group - "\C-w" gnus-group-kill-region - "\C-x\C-t" gnus-group-transpose-groups - "\C-c\C-l" gnus-group-list-killed - "\C-c\C-x" gnus-group-expire-articles - "\C-c\M-\C-x" gnus-group-expire-all-groups - "V" gnus-version - "s" gnus-group-save-newsrc - "z" gnus-group-suspend - "q" gnus-group-exit - "Q" gnus-group-quit - "?" gnus-group-describe-briefly - "\C-c\C-i" gnus-info-find-node - "\M-e" gnus-group-edit-group-method - "^" gnus-group-enter-server-mode - gnus-mouse-2 gnus-mouse-pick-group - [follow-link] mouse-face - "<" beginning-of-buffer - ">" end-of-buffer - "\C-c\C-b" gnus-bug - "\C-c\C-s" gnus-group-sort-groups - "t" gnus-topic-mode - "\C-c\M-g" gnus-activate-all-groups - "\M-&" gnus-group-universal-argument - "#" gnus-group-mark-group - "\M-#" gnus-group-unmark-group) - -(gnus-define-keys (gnus-group-mark-map "M" gnus-group-mode-map) - "m" gnus-group-mark-group - "u" gnus-group-unmark-group - "w" gnus-group-mark-region - "b" gnus-group-mark-buffer - "r" gnus-group-mark-regexp - "U" gnus-group-unmark-all-groups) - -(gnus-define-keys (gnus-group-sieve-map "D" gnus-group-mode-map) - "u" gnus-sieve-update - "g" gnus-sieve-generate) - -(gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map) - "d" gnus-group-make-directory-group - "h" gnus-group-make-help-group - "u" gnus-group-make-useful-group - "a" gnus-group-make-archive-group - "k" gnus-group-make-kiboze-group - "l" gnus-group-nnimap-edit-acl - "m" gnus-group-make-group - "E" gnus-group-edit-group - "e" gnus-group-edit-group-method - "p" gnus-group-edit-group-parameters - "v" gnus-group-add-to-virtual - "V" gnus-group-make-empty-virtual - "D" gnus-group-enter-directory - "f" gnus-group-make-doc-group - "w" gnus-group-make-web-group - "M" gnus-group-read-ephemeral-group - "r" gnus-group-rename-group - "R" gnus-group-make-rss-group - "c" gnus-group-customize - "x" gnus-group-nnimap-expunge - "\177" gnus-group-delete-group - [delete] gnus-group-delete-group) - -(gnus-define-keys (gnus-group-soup-map "s" gnus-group-group-map) - "b" gnus-group-brew-soup - "w" gnus-soup-save-areas - "s" gnus-soup-send-replies - "p" gnus-soup-pack-packet - "r" nnsoup-pack-replies) - -(gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map) - "s" gnus-group-sort-groups - "a" gnus-group-sort-groups-by-alphabet - "u" gnus-group-sort-groups-by-unread - "l" gnus-group-sort-groups-by-level - "v" gnus-group-sort-groups-by-score - "r" gnus-group-sort-groups-by-rank - "m" gnus-group-sort-groups-by-method - "n" gnus-group-sort-groups-by-real-name) - -(gnus-define-keys (gnus-group-sort-selected-map "P" gnus-group-group-map) - "s" gnus-group-sort-selected-groups - "a" gnus-group-sort-selected-groups-by-alphabet - "u" gnus-group-sort-selected-groups-by-unread - "l" gnus-group-sort-selected-groups-by-level - "v" gnus-group-sort-selected-groups-by-score - "r" gnus-group-sort-selected-groups-by-rank - "m" gnus-group-sort-selected-groups-by-method - "n" gnus-group-sort-selected-groups-by-real-name) - -(gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map) - "k" gnus-group-list-killed - "z" gnus-group-list-zombies - "s" gnus-group-list-groups - "u" gnus-group-list-all-groups - "A" gnus-group-list-active - "a" gnus-group-apropos - "d" gnus-group-description-apropos - "m" gnus-group-list-matching - "M" gnus-group-list-all-matching - "l" gnus-group-list-level - "c" gnus-group-list-cached - "?" gnus-group-list-dormant) - -(gnus-define-keys (gnus-group-list-limit-map "/" gnus-group-list-map) - "k" gnus-group-list-limit - "z" gnus-group-list-limit - "s" gnus-group-list-limit - "u" gnus-group-list-limit - "A" gnus-group-list-limit - "m" gnus-group-list-limit - "M" gnus-group-list-limit - "l" gnus-group-list-limit - "c" gnus-group-list-limit - "?" gnus-group-list-limit) - -(gnus-define-keys (gnus-group-list-flush-map "f" gnus-group-list-map) - "k" gnus-group-list-flush - "z" gnus-group-list-flush - "s" gnus-group-list-flush - "u" gnus-group-list-flush - "A" gnus-group-list-flush - "m" gnus-group-list-flush - "M" gnus-group-list-flush - "l" gnus-group-list-flush - "c" gnus-group-list-flush - "?" gnus-group-list-flush) - -(gnus-define-keys (gnus-group-list-plus-map "p" gnus-group-list-map) - "k" gnus-group-list-plus - "z" gnus-group-list-plus - "s" gnus-group-list-plus - "u" gnus-group-list-plus - "A" gnus-group-list-plus - "m" gnus-group-list-plus - "M" gnus-group-list-plus - "l" gnus-group-list-plus - "c" gnus-group-list-plus - "?" gnus-group-list-plus) - -(gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map) - "f" gnus-score-flush-cache) - -(gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map) - "c" gnus-group-fetch-charter - "C" gnus-group-fetch-control - "d" gnus-group-describe-group - "f" gnus-group-fetch-faq - "v" gnus-version) - -(gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map) - "l" gnus-group-set-current-level - "t" gnus-group-unsubscribe-current-group - "s" gnus-group-unsubscribe-group - "k" gnus-group-kill-group - "y" gnus-group-yank-group - "w" gnus-group-kill-region - "\C-k" gnus-group-kill-level - "z" gnus-group-kill-all-zombies) - -(defun gnus-topic-mode-p () - "Return non-nil in `gnus-topic-mode'." - (and (boundp 'gnus-topic-mode) - (symbol-value 'gnus-topic-mode))) - -(defun gnus-group-make-menu-bar () - (gnus-turn-off-edit-menu 'group) - (unless (boundp 'gnus-group-reading-menu) - - (easy-menu-define - gnus-group-reading-menu gnus-group-mode-map "" - `("Group" - ["Read" gnus-group-read-group - :included (not (gnus-topic-mode-p)) - :active (gnus-group-group-name)] - ["Read " gnus-topic-read-group - :included (gnus-topic-mode-p)] - ["Select" gnus-group-select-group - :included (not (gnus-topic-mode-p)) - :active (gnus-group-group-name)] - ["Select " gnus-topic-select-group - :included (gnus-topic-mode-p)] - ["See old articles" (gnus-group-select-group 'all) - :keys "C-u SPC" :active (gnus-group-group-name)] - ["Catch up" gnus-group-catchup-current - :included (not (gnus-topic-mode-p)) - :active (gnus-group-group-name) - ,@(if (featurep 'xemacs) nil - '(:help "Mark unread articles in the current group as read"))] - ["Catch up " gnus-topic-catchup-articles - :included (gnus-topic-mode-p) - ,@(if (featurep 'xemacs) nil - '(:help "Mark unread articles in the current group or topic as read"))] - ["Catch up all articles" gnus-group-catchup-current-all - (gnus-group-group-name)] - ["Check for new articles" gnus-group-get-new-news-this-group - :included (not (gnus-topic-mode-p)) - :active (gnus-group-group-name) - ,@(if (featurep 'xemacs) nil - '(:help "Check for new messages in current group"))] - ["Check for new articles " gnus-topic-get-new-news-this-topic - :included (gnus-topic-mode-p) - ,@(if (featurep 'xemacs) nil - '(:help "Check for new messages in current group or topic"))] - ["Toggle subscription" gnus-group-unsubscribe-current-group - (gnus-group-group-name)] - ["Kill" gnus-group-kill-group :active (gnus-group-group-name) - ,@(if (featurep 'xemacs) nil - '(:help "Kill (remove) current group"))] - ["Yank" gnus-group-yank-group gnus-list-of-killed-groups] - ["Describe" gnus-group-describe-group :active (gnus-group-group-name) - ,@(if (featurep 'xemacs) nil - '(:help "Display description of the current group"))] - ["Fetch FAQ" gnus-group-fetch-faq (gnus-group-group-name)] - ["Fetch charter" gnus-group-fetch-charter - :active (gnus-group-group-name) - ,@(if (featurep 'xemacs) nil - '(:help "Display the charter of the current group"))] - ["Fetch control message" gnus-group-fetch-control - :active (gnus-group-group-name) - ,@(if (featurep 'xemacs) nil - '(:help "Display the archived control message for the current group"))] - ;; Actually one should check, if any of the marked groups gives t for - ;; (gnus-check-backend-function 'request-expire-articles ...) - ["Expire articles" gnus-group-expire-articles - :included (not (gnus-topic-mode-p)) - :active (or (and (gnus-group-group-name) - (gnus-check-backend-function - 'request-expire-articles - (gnus-group-group-name))) gnus-group-marked)] - ["Expire articles " gnus-topic-expire-articles - :included (gnus-topic-mode-p)] - ["Set group level..." gnus-group-set-current-level - (gnus-group-group-name)] - ["Select quick" gnus-group-quick-select-group (gnus-group-group-name)] - ["Customize" gnus-group-customize (gnus-group-group-name)] - ("Edit" - ["Parameters" gnus-group-edit-group-parameters - :included (not (gnus-topic-mode-p)) - :active (gnus-group-group-name)] - ["Parameters " gnus-topic-edit-parameters - :included (gnus-topic-mode-p)] - ["Select method" gnus-group-edit-group-method - (gnus-group-group-name)] - ["Info" gnus-group-edit-group (gnus-group-group-name)] - ["Local kill file" gnus-group-edit-local-kill (gnus-group-group-name)] - ["Global kill file" gnus-group-edit-global-kill t]))) - - (easy-menu-define - gnus-group-group-menu gnus-group-mode-map "" - '("Groups" - ("Listing" - ["List unread subscribed groups" gnus-group-list-groups t] - ["List (un)subscribed groups" gnus-group-list-all-groups t] - ["List killed groups" gnus-group-list-killed gnus-killed-list] - ["List zombie groups" gnus-group-list-zombies gnus-zombie-list] - ["List level..." gnus-group-list-level t] - ["Describe all groups" gnus-group-describe-all-groups t] - ["Group apropos..." gnus-group-apropos t] - ["Group and description apropos..." gnus-group-description-apropos t] - ["List groups matching..." gnus-group-list-matching t] - ["List all groups matching..." gnus-group-list-all-matching t] - ["List active file" gnus-group-list-active t] - ["List groups with cached" gnus-group-list-cached t] - ["List groups with dormant" gnus-group-list-dormant t]) - ("Sort" - ["Default sort" gnus-group-sort-groups t] - ["Sort by method" gnus-group-sort-groups-by-method t] - ["Sort by rank" gnus-group-sort-groups-by-rank t] - ["Sort by score" gnus-group-sort-groups-by-score t] - ["Sort by level" gnus-group-sort-groups-by-level t] - ["Sort by unread" gnus-group-sort-groups-by-unread t] - ["Sort by name" gnus-group-sort-groups-by-alphabet t] - ["Sort by real name" gnus-group-sort-groups-by-real-name t]) - ("Sort process/prefixed" - ["Default sort" gnus-group-sort-selected-groups - (not (gnus-topic-mode-p))] - ["Sort by method" gnus-group-sort-selected-groups-by-method - (not (gnus-topic-mode-p))] - ["Sort by rank" gnus-group-sort-selected-groups-by-rank - (not (gnus-topic-mode-p))] - ["Sort by score" gnus-group-sort-selected-groups-by-score - (not (gnus-topic-mode-p))] - ["Sort by level" gnus-group-sort-selected-groups-by-level - (not (gnus-topic-mode-p))] - ["Sort by unread" gnus-group-sort-selected-groups-by-unread - (not (gnus-topic-mode-p))] - ["Sort by name" gnus-group-sort-selected-groups-by-alphabet - (not (gnus-topic-mode-p))] - ["Sort by real name" gnus-group-sort-selected-groups-by-real-name - (not (gnus-topic-mode-p))]) - ("Mark" - ["Mark group" gnus-group-mark-group - (and (gnus-group-group-name) - (not (memq (gnus-group-group-name) gnus-group-marked)))] - ["Unmark group" gnus-group-unmark-group - (and (gnus-group-group-name) - (memq (gnus-group-group-name) gnus-group-marked))] - ["Unmark all" gnus-group-unmark-all-groups gnus-group-marked] - ["Mark regexp..." gnus-group-mark-regexp t] - ["Mark region" gnus-group-mark-region :active (gnus-mark-active-p)] - ["Mark buffer" gnus-group-mark-buffer t] - ["Execute command" gnus-group-universal-argument - (or gnus-group-marked (gnus-group-group-name))]) - ("Subscribe" - ["Subscribe to a group..." gnus-group-unsubscribe-group t] - ["Kill all newsgroups in region" gnus-group-kill-region - :active (gnus-mark-active-p)] - ["Kill all zombie groups" gnus-group-kill-all-zombies - gnus-zombie-list] - ["Kill all groups on level..." gnus-group-kill-level t]) - ("Foreign groups" - ["Make a foreign group..." gnus-group-make-group t] - ["Add a directory group..." gnus-group-make-directory-group t] - ["Add the help group" gnus-group-make-help-group t] - ["Add the archive group" gnus-group-make-archive-group t] - ["Make a doc group..." gnus-group-make-doc-group t] - ["Make a web group..." gnus-group-make-web-group t] - ["Make a kiboze group..." gnus-group-make-kiboze-group t] - ["Make a virtual group..." gnus-group-make-empty-virtual t] - ["Add a group to a virtual..." gnus-group-add-to-virtual t] - ["Make an ephemeral group..." gnus-group-read-ephemeral-group t] - ["Make an RSS group..." gnus-group-make-rss-group t] - ["Rename group..." gnus-group-rename-group - (gnus-check-backend-function - 'request-rename-group (gnus-group-group-name))] - ["Delete group" gnus-group-delete-group - (gnus-check-backend-function - 'request-delete-group (gnus-group-group-name))]) - ("Move" - ["Next" gnus-group-next-group t] - ["Previous" gnus-group-prev-group t] - ["Next unread" gnus-group-next-unread-group t] - ["Previous unread" gnus-group-prev-unread-group t] - ["Next unread same level" gnus-group-next-unread-group-same-level t] - ["Previous unread same level" - gnus-group-prev-unread-group-same-level t] - ["Jump to group..." gnus-group-jump-to-group t] - ["First unread group" gnus-group-first-unread-group t] - ["Best unread group" gnus-group-best-unread-group t]) - ("Sieve" - ["Generate" gnus-sieve-generate t] - ["Generate and update" gnus-sieve-update t]) - ["Delete bogus groups" gnus-group-check-bogus-groups t] - ["Find new newsgroups" gnus-group-find-new-groups t] - ["Transpose" gnus-group-transpose-groups - (gnus-group-group-name)] - ["Read a directory as a group..." gnus-group-enter-directory t])) - - (easy-menu-define - gnus-group-misc-menu gnus-group-mode-map "" - `("Gnus" - ("SOUP" - ["Pack replies" nnsoup-pack-replies (fboundp 'nnsoup-request-group)] - ["Send replies" gnus-soup-send-replies - (fboundp 'gnus-soup-pack-packet)] - ["Pack packet" gnus-soup-pack-packet (fboundp 'gnus-soup-pack-packet)] - ["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)] - ["Brew SOUP" gnus-group-brew-soup (fboundp 'gnus-soup-pack-packet)]) - ["Send a mail" gnus-group-mail t] - ["Send a message (mail or news)" gnus-group-post-news t] - ["Create a local message" gnus-group-news t] - ["Check for new news" gnus-group-get-new-news - ,@(if (featurep 'xemacs) '(t) - '(:help "Get newly arrived articles")) - ] - ["Send queued messages" gnus-delay-send-queue - ,@(if (featurep 'xemacs) '(t) - '(:help "Send all messages that are scheduled to be sent now")) - ] - ["Activate all groups" gnus-activate-all-groups t] - ["Restart Gnus" gnus-group-restart t] - ["Read init file" gnus-group-read-init-file t] - ["Browse foreign server..." gnus-group-browse-foreign-server t] - ["Enter server buffer" gnus-group-enter-server-mode t] - ["Expire all expirable articles" gnus-group-expire-all-groups t] - ["Generate any kiboze groups" nnkiboze-generate-groups t] - ["Gnus version" gnus-version t] - ["Save .newsrc files" gnus-group-save-newsrc t] - ["Suspend Gnus" gnus-group-suspend t] - ["Clear dribble buffer" gnus-group-clear-dribble t] - ["Read manual" gnus-info-find-node t] - ["Flush score cache" gnus-score-flush-cache t] - ["Toggle topics" gnus-topic-mode t] - ["Send a bug report" gnus-bug t] - ["Exit from Gnus" gnus-group-exit - ,@(if (featurep 'xemacs) '(t) - '(:help "Quit reading news"))] - ["Exit without saving" gnus-group-quit t])) - - (gnus-run-hooks 'gnus-group-menu-hook))) - - -(defvar gnus-group-tool-bar-map nil) - -(defun gnus-group-tool-bar-update (&optional symbol value) - "Update group buffer toolbar. -Setter function for custom variables." - (when symbol - (set-default symbol value)) - ;; (setq-default gnus-group-tool-bar-map nil) - ;; (use-local-map gnus-group-mode-map) - (when (gnus-alive-p) - (with-current-buffer gnus-group-buffer - (gnus-group-make-tool-bar t)))) - -(defcustom gnus-group-tool-bar (if (eq gmm-tool-bar-style 'gnome) - 'gnus-group-tool-bar-gnome - 'gnus-group-tool-bar-retro) - "Specifies the Gnus group tool bar. - -It can be either a list or a symbol refering to a list. See -`gmm-tool-bar-from-list' for the format of the list. The -default key map is `gnus-group-mode-map'. - -Pre-defined symbols include `gnus-group-tool-bar-gnome' and -`gnus-group-tool-bar-retro'." - :type '(choice (const :tag "GNOME style" gnus-group-tool-bar-gnome) - (const :tag "Retro look" gnus-group-tool-bar-retro) - (repeat :tag "User defined list" gmm-tool-bar-item) - (symbol)) - :version "22.1" ;; Gnus 5.10.9 - :initialize 'custom-initialize-default - :set 'gnus-group-tool-bar-update - :group 'gnus-group) - -(defcustom gnus-group-tool-bar-gnome - '((gnus-group-post-news "mail/compose") - ;; Some useful agent icons? I don't use the agent so agent users should - ;; suggest useful commands: - (gnus-agent-toggle-plugged "disconnect" t - :help "Gnus is currently unplugged. Click to work online." - :visible (and gnus-agent (not gnus-plugged))) - (gnus-agent-toggle-plugged "connect" t - :help "Gnus is currently plugged. Click to work offline." - :visible (and gnus-agent gnus-plugged)) - ;; FIXME: gnus-agent-toggle-plugged (in gnus-agent-group-make-menu-bar) - ;; should have a better help text. - (gnus-group-send-queue "mail/outbox" t - :visible (and gnus-agent gnus-plugged) - :help "Send articles from the queue group") - (gnus-group-get-new-news "mail/inbox" nil - :visible (or (not gnus-agent) - gnus-plugged)) - ;; FIXME: gnus-*-read-group should have a better help text. - (gnus-topic-read-group "open" nil - :visible (and (boundp 'gnus-topic-mode) - gnus-topic-mode)) - (gnus-group-read-group "open" nil - :visible (not (and (boundp 'gnus-topic-mode) - gnus-topic-mode))) - ;; (gnus-group-find-new-groups "???" nil) - (gnus-group-save-newsrc "save") - (gnus-group-describe-group "describe") - (gnus-group-unsubscribe-current-group "gnus/toggle-subscription") - (gnus-group-prev-unread-group "left-arrow") - (gnus-group-next-unread-group "right-arrow") - (gnus-group-exit "exit") - (gmm-customize-mode "preferences" t :help "Edit mode preferences") - (gnus-info-find-node "help")) - "List of functions for the group tool bar (GNOME style). - -See `gmm-tool-bar-from-list' for the format of the list." - :type '(repeat gmm-tool-bar-item) - :version "22.1" ;; Gnus 5.10.9 - :initialize 'custom-initialize-default - :set 'gnus-group-tool-bar-update - :group 'gnus-group) - -(defcustom gnus-group-tool-bar-retro - '((gnus-group-get-new-news "gnus/get-news") - (gnus-group-get-new-news-this-group "gnus/gnntg") - (gnus-group-catchup-current "gnus/catchup") - (gnus-group-describe-group "gnus/describe-group") - (gnus-group-subscribe "gnus/subscribe" t - :help "Subscribe to the current group") - (gnus-group-unsubscribe "gnus/unsubscribe" t - :help "Unsubscribe from the current group") - (gnus-group-exit "gnus/exit-gnus" gnus-group-mode-map)) - "List of functions for the group tool bar (retro look). - -See `gmm-tool-bar-from-list' for the format of the list." - :type '(repeat gmm-tool-bar-item) - :version "22.1" ;; Gnus 5.10.9 - :initialize 'custom-initialize-default - :set 'gnus-group-tool-bar-update - :group 'gnus-group) - -(defcustom gnus-group-tool-bar-zap-list t - "List of icon items from the global tool bar. -These items are not displayed in the Gnus group mode tool bar. - -See `gmm-tool-bar-from-list' for the format of the list." - :type 'gmm-tool-bar-zap-list - :version "22.1" ;; Gnus 5.10.9 - :initialize 'custom-initialize-default - :set 'gnus-group-tool-bar-update - :group 'gnus-group) - -(defvar image-load-path) - -(defun gnus-group-make-tool-bar (&optional force) - "Make a group mode tool bar from `gnus-group-tool-bar'. -When FORCE, rebuild the tool bar." - (when (and (not (featurep 'xemacs)) - (boundp 'tool-bar-mode) - tool-bar-mode - ;; The Gnus 5.10.6 code checked (default-value 'tool-bar-mode). - ;; Why? --rsteib - (or (not gnus-group-tool-bar-map) force)) - (let* ((load-path - (gmm-image-load-path-for-library "gnus" - "gnus/toggle-subscription.xpm" - nil t)) - (image-load-path (cons (car load-path) - (when (boundp 'image-load-path) - image-load-path))) - (map (gmm-tool-bar-from-list gnus-group-tool-bar - gnus-group-tool-bar-zap-list - 'gnus-group-mode-map))) - (if map - (set (make-local-variable 'tool-bar-map) map)))) - gnus-group-tool-bar-map) - -(defun gnus-group-mode () - "Major mode for reading news. - -All normal editing commands are switched off. -\\ -The group buffer lists (some of) the groups available. For instance, -`\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]' -lists all zombie groups. - -Groups that are displayed can be entered with `\\[gnus-group-read-group]'. To subscribe -to a group not displayed, type `\\[gnus-group-unsubscribe-group]'. - -For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]'). - -The following commands are available: - -\\{gnus-group-mode-map}" - (interactive) - (kill-all-local-variables) - (when (gnus-visual-p 'group-menu 'menu) - (gnus-group-make-menu-bar) - (gnus-group-make-tool-bar)) - (gnus-simplify-mode-line) - (setq major-mode 'gnus-group-mode) - (setq mode-name "Group") - (gnus-group-set-mode-line) - (setq mode-line-process nil) - (use-local-map gnus-group-mode-map) - (buffer-disable-undo) - (setq truncate-lines t) - (setq buffer-read-only t) - (gnus-set-default-directory) - (gnus-update-format-specifications nil 'group 'group-mode) - (gnus-update-group-mark-positions) - (when gnus-use-undo - (gnus-undo-mode 1)) - (when gnus-slave - (gnus-slave-mode)) - (gnus-run-mode-hooks 'gnus-group-mode-hook)) - -(defun gnus-update-group-mark-positions () - (save-excursion - (let ((gnus-process-mark ?\200) - (gnus-group-update-hook nil) - (gnus-group-marked '("dummy.group")) - (gnus-active-hashtb (make-vector 10 0)) - (topic "")) - (gnus-set-active "dummy.group" '(0 . 0)) - (gnus-set-work-buffer) - (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil) - (goto-char (point-min)) - (setq gnus-group-mark-positions - (list (cons 'process (and (search-forward - (mm-string-as-multibyte "\200") nil t) - (- (point) 2)))))))) - -(defun gnus-mouse-pick-group (e) - "Enter the group under the mouse pointer." - (interactive "e") - (mouse-set-point e) - (gnus-group-read-group nil)) - -;; Look at LEVEL and find out what the level is really supposed to be. -;; If LEVEL is non-nil, LEVEL will be returned, if not, what happens -;; will depend on whether `gnus-group-use-permanent-levels' is used. -(defun gnus-group-default-level (&optional level number-or-nil) - (cond - (gnus-group-use-permanent-levels - (or (setq gnus-group-use-permanent-levels - (or level (if (numberp gnus-group-use-permanent-levels) - gnus-group-use-permanent-levels - (or gnus-group-default-list-level - gnus-level-subscribed)))) - gnus-group-default-list-level gnus-level-subscribed)) - (number-or-nil - level) - (t - (or level gnus-group-default-list-level gnus-level-subscribed)))) - -(defun gnus-group-setup-buffer () - (set-buffer (gnus-get-buffer-create gnus-group-buffer)) - (unless (eq major-mode 'gnus-group-mode) - (gnus-group-mode) - (when gnus-carpal - (gnus-carpal-setup-buffer 'group)))) - -(defun gnus-group-name-charset (method group) - (if (null method) - (setq method (gnus-find-method-for-group group))) - (let ((item (assoc method gnus-group-name-charset-method-alist)) - (alist gnus-group-name-charset-group-alist) - result) - (if item - (cdr item) - (while (setq item (pop alist)) - (if (string-match (car item) group) - (setq alist nil - result (cdr item)))) - result))) - -(defun gnus-group-name-decode (string charset) - ;; Fixme: Don't decode in unibyte mode. - (if (and string charset (featurep 'mule)) - (mm-decode-coding-string string charset) - string)) - -(defun gnus-group-decoded-name (string) - (let ((charset (gnus-group-name-charset nil string))) - (gnus-group-name-decode string charset))) - -(defun gnus-group-list-groups (&optional level unread lowest) - "List newsgroups with level LEVEL or lower that have unread articles. -Default is all subscribed groups. -If argument UNREAD is non-nil, groups with no unread articles are also -listed. - -Also see the `gnus-group-use-permanent-levels' variable." - (interactive - (list (if current-prefix-arg - (prefix-numeric-value current-prefix-arg) - (or - (gnus-group-default-level nil t) - gnus-group-default-list-level - gnus-level-subscribed)))) - (unless level - (setq level (car gnus-group-list-mode) - unread (cdr gnus-group-list-mode))) - (setq level (gnus-group-default-level level)) - (gnus-group-setup-buffer) - (gnus-update-format-specifications nil 'group 'group-mode) - (let ((case-fold-search nil) - (props (text-properties-at (gnus-point-at-bol))) - (empty (= (point-min) (point-max))) - (group (gnus-group-group-name)) - number) - (set-buffer gnus-group-buffer) - (setq number (funcall gnus-group-prepare-function level unread lowest)) - (when (or (and (numberp number) - (zerop number)) - (zerop (buffer-size))) - ;; No groups in the buffer. - (gnus-message 5 gnus-no-groups-message)) - ;; We have some groups displayed. - (goto-char (point-max)) - (when (or (not gnus-group-goto-next-group-function) - (not (funcall gnus-group-goto-next-group-function - group props))) - (cond - (empty - (goto-char (point-min))) - ((not group) - ;; Go to the first group with unread articles. - (gnus-group-search-forward t)) - (t - ;; Find the right group to put point on. If the current group - ;; has disappeared in the new listing, try to find the next - ;; one. If no next one can be found, just leave point at the - ;; first newsgroup in the buffer. - (when (not (gnus-goto-char - (text-property-any - (point-min) (point-max) - 'gnus-group (gnus-intern-safe - group gnus-active-hashtb)))) - (let ((newsrc (cdddr (gnus-gethash group gnus-newsrc-hashtb)))) - (while (and newsrc - (not (gnus-goto-char - (text-property-any - (point-min) (point-max) 'gnus-group - (gnus-intern-safe - (caar newsrc) gnus-active-hashtb))))) - (setq newsrc (cdr newsrc))) - (unless newsrc - (goto-char (point-max)) - (forward-line -1))))))) - ;; Adjust cursor point. - (gnus-group-position-point))) - -(defun gnus-group-list-level (level &optional all) - "List groups on LEVEL. -If ALL (the prefix), also list groups that have no unread articles." - (interactive "nList groups on level: \nP") - (gnus-group-list-groups level all level)) - -(defun gnus-group-prepare-logic (group test) - (or (and gnus-group-listed-groups - (null gnus-group-list-option) - (member group gnus-group-listed-groups)) - (cond - ((null gnus-group-listed-groups) test) - ((null gnus-group-list-option) test) - (t (and (member group gnus-group-listed-groups) - (if (eq gnus-group-list-option 'flush) - (not test) - test)))))) - -(defun gnus-group-prepare-flat (level &optional predicate lowest regexp) - "List all newsgroups with unread articles of level LEVEL or lower. -If PREDICATE is a function, list groups that the function returns non-nil; -if it is t, list groups that have no unread articles. -If LOWEST is non-nil, list all newsgroups of level LOWEST or higher. -If REGEXP is a function, list dead groups that the function returns non-nil; -if it is a string, only list groups matching REGEXP." - (set-buffer gnus-group-buffer) - (let ((buffer-read-only nil) - (newsrc (cdr gnus-newsrc-alist)) - (lowest (or lowest 1)) - (not-in-list (and gnus-group-listed-groups - (copy-sequence gnus-group-listed-groups))) - info clevel unread group params) - (erase-buffer) - (when (or (< lowest gnus-level-zombie) - gnus-group-listed-groups) - ;; List living groups. - (while newsrc - (setq info (car newsrc) - group (gnus-info-group info) - params (gnus-info-params info) - newsrc (cdr newsrc) - unread (car (gnus-gethash group gnus-newsrc-hashtb))) - (when not-in-list - (setq not-in-list (delete group not-in-list))) - (when (gnus-group-prepare-logic - group - (and unread ; This group might be unchecked - (or (not (stringp regexp)) - (string-match regexp group)) - (<= (setq clevel (gnus-info-level info)) level) - (>= clevel lowest) - (cond - ((functionp predicate) - (funcall predicate info)) - (predicate t) ; We list all groups? - (t - (or - (if (eq unread t) ; Unactivated? - gnus-group-list-inactive-groups - ; We list unactivated - (> unread 0)) - ; We list groups with unread articles - (and gnus-list-groups-with-ticked-articles - (cdr (assq 'tick (gnus-info-marks info)))) - ; And groups with tickeds - ;; Check for permanent visibility. - (and gnus-permanently-visible-groups - (string-match gnus-permanently-visible-groups - group)) - (memq 'visible params) - (cdr (assq 'visible params))))))) - (gnus-group-insert-group-line - group (gnus-info-level info) - (gnus-info-marks info) unread (gnus-info-method info))))) - - ;; List dead groups. - (when (or gnus-group-listed-groups - (and (>= level gnus-level-zombie) - (<= lowest gnus-level-zombie))) - (gnus-group-prepare-flat-list-dead - (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) - gnus-level-zombie ?Z - regexp)) - (when not-in-list - (dolist (group gnus-zombie-list) - (setq not-in-list (delete group not-in-list)))) - (when (or gnus-group-listed-groups - (and (>= level gnus-level-killed) (<= lowest gnus-level-killed))) - (gnus-group-prepare-flat-list-dead - (gnus-union - not-in-list - (setq gnus-killed-list (sort gnus-killed-list 'string<))) - gnus-level-killed ?K regexp)) - - (gnus-group-set-mode-line) - (setq gnus-group-list-mode (cons level predicate)) - (gnus-run-hooks 'gnus-group-prepare-hook) - t)) - -(defun gnus-group-prepare-flat-list-dead (groups level mark regexp) - ;; List zombies and killed lists somewhat faster, which was - ;; suggested by Jack Vinson . It does - ;; this by ignoring the group format specification altogether. - (let (group) - (if (> (length groups) gnus-group-listing-limit) - (while groups - (setq group (pop groups)) - (when (gnus-group-prepare-logic - group - (or (not regexp) - (and (stringp regexp) (string-match regexp group)) - (and (functionp regexp) (funcall regexp group)))) - (gnus-add-text-properties - (point) (prog1 (1+ (point)) - (insert " " mark " *: " - (gnus-group-decoded-name group) - "\n")) - (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) - 'gnus-unread t - 'gnus-level level)))) - (while groups - (setq group (pop groups)) - (when (gnus-group-prepare-logic - group - (or (not regexp) - (and (stringp regexp) (string-match regexp group)) - (and (functionp regexp) (funcall regexp group)))) - (gnus-group-insert-group-line - group level nil - (let ((active (gnus-active group))) - (if active - (if (zerop (cdr active)) - 0 - (- (1+ (cdr active)) (car active))) - nil)) - (gnus-method-simplify (gnus-find-method-for-group group)))))))) - -(defun gnus-group-update-group-line () - "Update the current line in the group buffer." - (let* ((buffer-read-only nil) - (group (gnus-group-group-name)) - (entry (and group (gnus-gethash group gnus-newsrc-hashtb))) - gnus-group-indentation) - (when group - (and entry - (not (gnus-ephemeral-group-p group)) - (gnus-dribble-enter - (concat "(gnus-group-set-info '" - (gnus-prin1-to-string (nth 2 entry)) - ")"))) - (setq gnus-group-indentation (gnus-group-group-indentation)) - (gnus-delete-line) - (gnus-group-insert-group-line-info group) - (forward-line -1) - (gnus-group-position-point)))) - -(defun gnus-group-insert-group-line-info (group) - "Insert GROUP on the current line." - (let ((entry (gnus-gethash group gnus-newsrc-hashtb)) - (gnus-group-indentation (gnus-group-group-indentation)) - active info) - (if entry - (progn - ;; (Un)subscribed group. - (setq info (nth 2 entry)) - (gnus-group-insert-group-line - group (gnus-info-level info) (gnus-info-marks info) - (or (car entry) t) (gnus-info-method info))) - ;; This group is dead. - (gnus-group-insert-group-line - group - (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed) - nil - (if (setq active (gnus-active group)) - (if (zerop (cdr active)) - 0 - (- (1+ (cdr active)) (car active))) - nil) - (gnus-method-simplify (gnus-find-method-for-group group)))))) - -(defun gnus-number-of-unseen-articles-in-group (group) - (let* ((info (nth 2 (gnus-group-entry group))) - (marked (gnus-info-marks info)) - (seen (cdr (assq 'seen marked))) - (active (gnus-active group))) - (if (not active) - 0 - (length (gnus-uncompress-range - (gnus-range-difference - (gnus-range-difference (list active) (gnus-info-read info)) - seen)))))) - -;; Moving through the Group buffer (in topic mode) e.g. with C-n doesn't -;; update the state (enabled/disabled) of the icon `gnus-group-describe-group' -;; automatically. After `C-l' the state is correct. See the following report -;; on emacs-devel -;; : -;; From: Reiner Steib -;; Subject: tool bar icons not updated according to :active condition -;; Newsgroups: gmane.emacs.devel -;; Date: Mon, 23 Jan 2006 19:59:13 +0100 -;; Message-ID: - -(defcustom gnus-group-update-tool-bar - (and (not (featurep 'xemacs)) - (boundp 'tool-bar-mode) - tool-bar-mode - ;; Using `redraw-frame' (see `gnus-tool-bar-update') in Emacs 21 might - ;; be confusing, so maybe we shouldn't call it by default. - (fboundp 'force-window-update)) - "Force updating the group buffer tool bar." - :group 'gnus-group - :version "22.1" - :initialize 'custom-initialize-default - :set (lambda (symbol value) - (set-default symbol value) - (when (gnus-alive-p) - (with-current-buffer gnus-group-buffer - ;; FIXME: Is there a better way to redraw the group buffer? - (gnus-group-get-new-news 0)))) - :type 'boolean) - -(defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level - gnus-tmp-marked number - gnus-tmp-method) - "Insert a group line in the group buffer." - (let* ((gnus-tmp-method - (gnus-server-get-method gnus-tmp-group gnus-tmp-method)) - (group-name-charset (gnus-group-name-charset gnus-tmp-method - gnus-tmp-group)) - (gnus-tmp-active (gnus-active gnus-tmp-group)) - (gnus-tmp-number-total - (if gnus-tmp-active - (1+ (- (cdr gnus-tmp-active) (car gnus-tmp-active))) - 0)) - (gnus-tmp-number-of-unread - (if (numberp number) (int-to-string (max 0 number)) - "*")) - (gnus-tmp-number-of-read - (if (numberp number) - (int-to-string (max 0 (- gnus-tmp-number-total number))) - "*")) - (gnus-tmp-subscribed - (cond ((<= gnus-tmp-level gnus-level-subscribed) ? ) - ((<= gnus-tmp-level gnus-level-unsubscribed) ?U) - ((= gnus-tmp-level gnus-level-zombie) ?Z) - (t ?K))) - (gnus-tmp-qualified-group - (gnus-group-name-decode (gnus-group-real-name gnus-tmp-group) - group-name-charset)) - (gnus-tmp-comment - (or (gnus-group-get-parameter gnus-tmp-group 'comment t) - gnus-tmp-group)) - (gnus-tmp-newsgroup-description - (if gnus-description-hashtb - (or (gnus-group-name-decode - (gnus-gethash gnus-tmp-group gnus-description-hashtb) - group-name-charset) "") - "")) - (gnus-tmp-moderated - (if (and gnus-moderated-hashtb - (gnus-gethash gnus-tmp-group gnus-moderated-hashtb)) - ?m ? )) - (gnus-tmp-moderated-string - (if (eq gnus-tmp-moderated ?m) "(m)" "")) - (gnus-tmp-group-icon "==&&==") - (gnus-tmp-news-server (or (cadr gnus-tmp-method) "")) - (gnus-tmp-news-method (or (car gnus-tmp-method) "")) - (gnus-tmp-news-method-string - (if gnus-tmp-method - (format "(%s:%s)" (car gnus-tmp-method) - (cadr gnus-tmp-method)) "")) - (gnus-tmp-marked-mark - (if (and (numberp number) - (zerop number) - (cdr (assq 'tick gnus-tmp-marked))) - ?* ? )) - (gnus-tmp-summary-live - (if (and (not gnus-group-is-exiting-p) - (gnus-buffer-live-p (gnus-summary-buffer-name - gnus-tmp-group))) - ?* ? )) - (gnus-tmp-process-marked - (if (member gnus-tmp-group gnus-group-marked) - gnus-process-mark ? )) - (gnus-tmp-grouplens - (or (and gnus-use-grouplens - (bbb-grouplens-group-p gnus-tmp-group)) - "")) - (buffer-read-only nil) - beg end - header gnus-tmp-header) ; passed as parameter to user-funcs. - (beginning-of-line) - (setq beg (point)) - (gnus-add-text-properties - (point) - (prog1 (1+ (point)) - ;; Insert the text. - (let ((gnus-tmp-decoded-group (gnus-group-name-decode - gnus-tmp-group group-name-charset))) - (eval gnus-group-line-format-spec))) - `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb) - gnus-unread ,(if (numberp number) - (string-to-number gnus-tmp-number-of-unread) - t) - gnus-marked ,gnus-tmp-marked-mark - gnus-indentation ,gnus-group-indentation - gnus-level ,gnus-tmp-level)) - (setq end (point)) - (when gnus-group-update-tool-bar - (gnus-put-text-property beg end 'point-entered - 'gnus-tool-bar-update) - (gnus-put-text-property beg end 'point-left - 'gnus-tool-bar-update)) - (forward-line -1) - (when (inline (gnus-visual-p 'group-highlight 'highlight)) - (gnus-run-hooks 'gnus-group-update-hook)) - (forward-line) - ;; Allow XEmacs to remove front-sticky text properties. - (gnus-group-remove-excess-properties))) - -(defun gnus-group-highlight-line () - "Highlight the current line according to `gnus-group-highlight'." - (let* ((list gnus-group-highlight) - (p (point)) - (end (gnus-point-at-eol)) - ;; now find out where the line starts and leave point there. - (beg (progn (beginning-of-line) (point))) - (group (gnus-group-group-name)) - (entry (gnus-group-entry group)) - (unread (if (numberp (car entry)) (car entry) 0)) - (active (gnus-active group)) - (total (if active (1+ (- (cdr active) (car active))) 0)) - (info (nth 2 entry)) - (method (inline (gnus-server-get-method group (gnus-info-method info)))) - (marked (gnus-info-marks info)) - (mailp (apply 'append - (mapcar - (lambda (x) - (memq x (assoc (symbol-name - (car (or method gnus-select-method))) - gnus-valid-select-methods))) - '(mail post-mail)))) - (level (or (gnus-info-level info) gnus-level-killed)) - (score (or (gnus-info-score info) 0)) - (ticked (gnus-range-length (cdr (assq 'tick marked)))) - (group-age (gnus-group-timestamp-delta group)) - (inhibit-read-only t)) - ;; Eval the cars of the lists until we find a match. - (while (and list - (not (eval (caar list)))) - (setq list (cdr list))) - (let ((face (cdar list))) - (unless (eq face (get-text-property beg 'face)) - (gnus-put-text-property-excluding-characters-with-faces - beg end 'face - (setq face (if (boundp face) (symbol-value face) face))) - (gnus-extent-start-open beg))) - (goto-char p))) - -(defun gnus-group-update-group (group &optional visible-only) - "Update all lines where GROUP appear. -If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't -already." - ;; Can't use `save-excursion' here, so we do it manually. - (let ((buf (current-buffer)) - mark) - (set-buffer gnus-group-buffer) - (setq mark (point-marker)) - ;; The buffer may be narrowed. - (save-restriction - (widen) - (let ((ident (gnus-intern-safe group gnus-active-hashtb)) - (loc (point-min)) - found buffer-read-only) - ;; Enter the current status into the dribble buffer. - (let ((entry (gnus-gethash group gnus-newsrc-hashtb))) - (when (and entry - (not (gnus-ephemeral-group-p group))) - (gnus-dribble-enter - (concat "(gnus-group-set-info '" - (gnus-prin1-to-string (nth 2 entry)) - ")")))) - ;; Find all group instances. If topics are in use, each group - ;; may be listed in more than once. - (while (setq loc (text-property-any - loc (point-max) 'gnus-group ident)) - (setq found t) - (goto-char loc) - (let ((gnus-group-indentation (gnus-group-group-indentation))) - (gnus-delete-line) - (gnus-group-insert-group-line-info group) - (save-excursion - (forward-line -1) - (gnus-run-hooks 'gnus-group-update-group-hook))) - (setq loc (1+ loc))) - (unless (or found visible-only) - ;; No such line in the buffer, find out where it's supposed to - ;; go, and insert it there (or at the end of the buffer). - (if gnus-goto-missing-group-function - (funcall gnus-goto-missing-group-function group) - (let ((entry (cddr (gnus-gethash group gnus-newsrc-hashtb)))) - (while (and entry (car entry) - (not - (gnus-goto-char - (text-property-any - (point-min) (point-max) - 'gnus-group (gnus-intern-safe - (caar entry) gnus-active-hashtb))))) - (setq entry (cdr entry))) - (or entry (goto-char (point-max))))) - ;; Finally insert the line. - (let ((gnus-group-indentation (gnus-group-group-indentation))) - (gnus-group-insert-group-line-info group) - (save-excursion - (forward-line -1) - (gnus-run-hooks 'gnus-group-update-group-hook)))) - (when gnus-group-update-group-function - (funcall gnus-group-update-group-function group)) - (gnus-group-set-mode-line))) - (goto-char mark) - (set-marker mark nil) - (set-buffer buf))) - -(defun gnus-group-set-mode-line () - "Update the mode line in the group buffer." - (when (memq 'group gnus-updated-mode-lines) - ;; Yes, we want to keep this mode line updated. - (save-excursion - (set-buffer gnus-group-buffer) - (let* ((gformat (or gnus-group-mode-line-format-spec - (gnus-set-format 'group-mode))) - (gnus-tmp-news-server (cadr gnus-select-method)) - (gnus-tmp-news-method (car gnus-select-method)) - (gnus-tmp-colon (if (equal gnus-tmp-news-server "") "" ":")) - (max-len 60) - gnus-tmp-header ;Dummy binding for user-defined formats - ;; Get the resulting string. - (modified - (and gnus-dribble-buffer - (buffer-name gnus-dribble-buffer) - (buffer-modified-p gnus-dribble-buffer) - (save-excursion - (set-buffer gnus-dribble-buffer) - (not (zerop (buffer-size)))))) - (mode-string (eval gformat))) - ;; Say whether the dribble buffer has been modified. - (setq mode-line-modified - (if modified (car gnus-mode-line-modified) - (cdr gnus-mode-line-modified))) - ;; If the line is too long, we chop it off. - (when (> (length mode-string) max-len) - (setq mode-string (substring mode-string 0 (- max-len 4)))) - (prog1 - (setq mode-line-buffer-identification - (gnus-mode-line-buffer-identification - (list mode-string))) - (set-buffer-modified-p modified)))))) - -(defun gnus-group-group-name () - "Get the name of the newsgroup on the current line." - (let ((group (get-text-property (gnus-point-at-bol) 'gnus-group))) - (when group - (symbol-name group)))) - -(defun gnus-group-group-level () - "Get the level of the newsgroup on the current line." - (get-text-property (gnus-point-at-bol) 'gnus-level)) - -(defun gnus-group-group-indentation () - "Get the indentation of the newsgroup on the current line." - (or (get-text-property (gnus-point-at-bol) 'gnus-indentation) - (and gnus-group-indentation-function - (funcall gnus-group-indentation-function)) - "")) - -(defun gnus-group-group-unread () - "Get the number of unread articles of the newsgroup on the current line." - (get-text-property (gnus-point-at-bol) 'gnus-unread)) - -(defun gnus-group-new-mail (group) - (if (nnmail-new-mail-p (gnus-group-real-name group)) - gnus-new-mail-mark - ? )) - -(defun gnus-group-level (group) - "Return the estimated level of GROUP." - (or (gnus-info-level (gnus-get-info group)) - (and (member group gnus-zombie-list) gnus-level-zombie) - gnus-level-killed)) - -(defun gnus-group-search-forward (&optional backward all level first-too) - "Find the next newsgroup with unread articles. -If BACKWARD is non-nil, find the previous newsgroup instead. -If ALL is non-nil, just find any newsgroup. -If LEVEL is non-nil, find group with level LEVEL, or higher if no such -group exists. -If FIRST-TOO, the current line is also eligible as a target." - (let ((way (if backward -1 1)) - (low gnus-level-killed) - (beg (point)) - pos found lev) - (if (and backward (progn (beginning-of-line)) (bobp)) - nil - (unless first-too - (forward-line way)) - (while (and - (not (eobp)) - (not (setq - found - (and - (get-text-property (point) 'gnus-group) - (or all - (and - (let ((unread - (get-text-property (point) 'gnus-unread))) - (and (numberp unread) (> unread 0))) - (setq lev (get-text-property (point) - 'gnus-level)) - (<= lev gnus-level-subscribed))) - (or (not level) - (and (setq lev (get-text-property (point) - 'gnus-level)) - (or (= lev level) - (and (< lev low) - (< level lev) - (progn - (setq low lev) - (setq pos (point)) - nil)))))))) - (zerop (forward-line way))))) - (if found - (progn (gnus-group-position-point) t) - (goto-char (or pos beg)) - (and pos t)))) - -;;; Gnus group mode commands - -;; Group marking. - -(defun gnus-group-mark-line-p () - (save-excursion - (beginning-of-line) - (forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2)) - (eq (char-after) gnus-process-mark))) - -(defun gnus-group-mark-group (n &optional unmark no-advance) - "Mark the current group." - (interactive "p") - (let ((buffer-read-only nil) - group) - (while (and (> n 0) - (not (eobp))) - (when (setq group (gnus-group-group-name)) - ;; Go to the mark position. - (beginning-of-line) - (forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2)) - (subst-char-in-region - (point) (1+ (point)) (char-after) - (if unmark - (progn - (setq gnus-group-marked (delete group gnus-group-marked)) - ? ) - (setq gnus-group-marked - (cons group (delete group gnus-group-marked))) - gnus-process-mark))) - (unless no-advance - (gnus-group-next-group 1)) - (decf n)) - (gnus-summary-position-point) - n)) - -(defun gnus-group-unmark-group (n) - "Remove the mark from the current group." - (interactive "p") - (gnus-group-mark-group n 'unmark) - (gnus-group-position-point)) - -(defun gnus-group-unmark-all-groups () - "Unmark all groups." - (interactive) - (let ((groups gnus-group-marked)) - (save-excursion - (while groups - (gnus-group-remove-mark (pop groups))))) - (gnus-group-position-point)) - -(defun gnus-group-mark-region (unmark beg end) - "Mark all groups between point and mark. -If UNMARK, remove the mark instead." - (interactive "P\nr") - (let ((num (count-lines beg end))) - (save-excursion - (goto-char beg) - (- num (gnus-group-mark-group num unmark))))) - -(defun gnus-group-mark-buffer (&optional unmark) - "Mark all groups in the buffer. -If UNMARK, remove the mark instead." - (interactive "P") - (gnus-group-mark-region unmark (point-min) (point-max))) - -(defun gnus-group-mark-regexp (regexp) - "Mark all groups that match some regexp." - (interactive "sMark (regexp): ") - (let ((alist (cdr gnus-newsrc-alist)) - group) - (save-excursion - (while alist - (when (string-match regexp (setq group (gnus-info-group (pop alist)))) - (gnus-group-jump-to-group group) - (gnus-group-set-mark group))))) - (gnus-group-position-point)) - -(defun gnus-group-remove-mark (group &optional test-marked) - "Remove the process mark from GROUP and move point there. -Return nil if the group isn't displayed." - (if (gnus-group-goto-group group nil test-marked) - (save-excursion - (gnus-group-mark-group 1 'unmark t) - t) - (setq gnus-group-marked - (delete group gnus-group-marked)) - nil)) - -(defun gnus-group-set-mark (group) - "Set the process mark on GROUP." - (if (gnus-group-goto-group group) - (save-excursion - (gnus-group-mark-group 1 nil t)) - (setq gnus-group-marked (cons group (delete group gnus-group-marked))))) - -(defun gnus-group-universal-argument (arg &optional groups func) - "Perform any command on all groups according to the process/prefix convention." - (interactive "P") - (if (eq (setq func (or func - (key-binding - (read-key-sequence - (substitute-command-keys - "\\\\[gnus-group-universal-argument]"))))) - 'undefined) - (gnus-error 1 "Undefined key") - (gnus-group-iterate arg - (lambda (group) - (command-execute func)))) - (gnus-group-position-point)) - -(defun gnus-group-process-prefix (n) - "Return a list of groups to work on. -Take into consideration N (the prefix) and the list of marked groups." - (cond - (n - (setq n (prefix-numeric-value n)) - ;; There is a prefix, so we return a list of the N next - ;; groups. - (let ((way (if (< n 0) -1 1)) - (n (abs n)) - group groups) - (save-excursion - (while (> n 0) - (if (setq group (gnus-group-group-name)) - (push group groups)) - (setq n (1- n)) - (gnus-group-next-group way))) - (nreverse groups))) - ((and (gnus-region-active-p) (mark)) - ;; Work on the region between point and mark. - (let ((max (max (point) (mark))) - groups) - (save-excursion - (goto-char (min (point) (mark))) - (while - (and - (push (gnus-group-group-name) groups) - (zerop (gnus-group-next-group 1)) - (< (point) max))) - (nreverse groups)))) - (gnus-group-marked - ;; No prefix, but a list of marked articles. - (reverse gnus-group-marked)) - (t - ;; Neither marked articles or a prefix, so we return the - ;; current group. - (let ((group (gnus-group-group-name))) - (and group (list group)))))) - -;;; !!!Surely gnus-group-iterate should be a macro instead? I can't -;;; imagine why I went through these contortions... -(eval-and-compile - (let ((function (make-symbol "gnus-group-iterate-function")) - (window (make-symbol "gnus-group-iterate-window")) - (groups (make-symbol "gnus-group-iterate-groups")) - (group (make-symbol "gnus-group-iterate-group"))) - (eval - `(defun gnus-group-iterate (arg ,function) - "Iterate FUNCTION over all process/prefixed groups. -FUNCTION will be called with the group name as the parameter -and with point over the group in question." - (let ((,groups (gnus-group-process-prefix arg)) - (,window (selected-window)) - ,group) - (while ,groups - (setq ,group (car ,groups) - ,groups (cdr ,groups)) - (select-window ,window) - (gnus-group-remove-mark ,group) - (save-selected-window - (save-excursion - (funcall ,function ,group))))))))) - -(put 'gnus-group-iterate 'lisp-indent-function 1) - -;; Selecting groups. - -(defun gnus-group-read-group (&optional all no-article group select-articles) - "Read news in this newsgroup. -If the prefix argument ALL is non-nil, already read articles become -readable. - -If ALL is a positive number, fetch this number of the latest -articles in the group. If ALL is a negative number, fetch this -number of the earliest articles in the group. - -If the optional argument NO-ARTICLE is non-nil, no article will -be auto-selected upon group entry. If GROUP is non-nil, fetch -that group." - (interactive "P") - (let ((no-display (eq all 0)) - (group (or group (gnus-group-group-name))) - number active marked entry) - (when (eq all 0) - (setq all nil)) - (unless group - (error "No group on current line")) - (setq marked (gnus-info-marks - (nth 2 (setq entry (gnus-gethash - group gnus-newsrc-hashtb))))) - ;; This group might be a dead group. In that case we have to get - ;; the number of unread articles from `gnus-active-hashtb'. - (setq number - (cond ((numberp all) all) - (entry (car entry)) - ((setq active (gnus-active group)) - (- (1+ (cdr active)) (car active))))) - (gnus-summary-read-group - group (or all (and (numberp number) - (zerop (+ number (gnus-range-length - (cdr (assq 'tick marked))) - (gnus-range-length - (cdr (assq 'dormant marked))))))) - no-article nil no-display nil select-articles))) - -(defun gnus-group-select-group (&optional all) - "Select this newsgroup. -No article is selected automatically. -If the group is opened, just switch the summary buffer. -If ALL is non-nil, already read articles become readable. -If ALL is a positive number, fetch this number of the latest -articles in the group. -If ALL is a negative number, fetch this number of the earliest -articles in the group." - (interactive "P") - (when (and (eobp) (not (gnus-group-group-name))) - (forward-line -1)) - (gnus-group-read-group all t)) - -(defun gnus-group-quick-select-group (&optional all) - "Select the current group \"quickly\". -This means that no highlighting or scoring will be performed. -If ALL (the prefix argument) is 0, don't even generate the summary -buffer. - -This might be useful if you want to toggle threading -before entering the group." - (interactive "P") - (require 'gnus-score) - (let (gnus-visual - gnus-score-find-score-files-function - gnus-home-score-file - gnus-apply-kill-hook - gnus-summary-expunge-below) - (gnus-group-read-group all t))) - -(defun gnus-group-visible-select-group (&optional all) - "Select the current group without hiding any articles." - (interactive "P") - (let ((gnus-inhibit-limiting t)) - (gnus-group-read-group all t))) - -(defun gnus-group-select-group-ephemerally () - "Select the current group without doing any processing whatsoever. -You will actually be entered into a group that's a copy of -the current group; no changes you make while in this group will -be permanent." - (interactive) - (require 'gnus-score) - (let* (gnus-visual - gnus-score-find-score-files-function gnus-apply-kill-hook - gnus-summary-expunge-below gnus-show-threads gnus-suppress-duplicates - gnus-summary-mode-hook gnus-select-group-hook - (group (gnus-group-group-name)) - (method (gnus-find-method-for-group group))) - (gnus-group-read-ephemeral-group - (gnus-group-prefixed-name group method) method))) - -;;;###autoload -(defun gnus-fetch-group (group &optional articles) - "Start Gnus if necessary and enter GROUP. -Returns whether the fetching was successful or not." - (interactive (list (completing-read "Group name: " gnus-active-hashtb))) - (unless (get-buffer gnus-group-buffer) - (gnus-no-server)) - (gnus-group-read-group articles nil group)) - -;;;###autoload -(defun gnus-fetch-group-other-frame (group) - "Pop up a frame and enter GROUP." - (interactive "P") - (let ((window (get-buffer-window gnus-group-buffer))) - (cond (window - (select-frame (window-frame window))) - ((= (length (frame-list)) 1) - (select-frame (make-frame))) - (t - (other-frame 1)))) - (gnus-fetch-group group)) - -(defvar gnus-ephemeral-group-server 0) - -(defcustom gnus-large-ephemeral-newsgroup 200 - "The number of articles which indicates a large ephemeral newsgroup. -Same as `gnus-large-newsgroup', but only used for ephemeral newsgroups. - -If the number of articles in a newsgroup is greater than this value, -confirmation is required for selecting the newsgroup. If it is nil, no -confirmation is required." - :version "22.1" - :group 'gnus-group-select - :type '(choice (const :tag "No limit" nil) - integer)) - -(defcustom gnus-fetch-old-ephemeral-headers nil - "Same as `gnus-fetch-old-headers', but only used for ephemeral newsgroups." - :version "22.1" - :group 'gnus-thread - :type '(choice (const :tag "off" nil) - (const some) - number - (sexp :menu-tag "other" t))) - -;; Enter a group that is not in the group buffer. Non-nil is returned -;; if selection was successful. -(defun gnus-group-read-ephemeral-group (group method &optional activate - quit-config request-only - select-articles - parameters - number) - "Read GROUP from METHOD as an ephemeral group. -If ACTIVATE, request the group first. -If QUIT-CONFIG, use that window configuration when exiting from the -ephemeral group. -If REQUEST-ONLY, don't actually read the group; just request it. -If SELECT-ARTICLES, only select those articles. -If PARAMETERS, use those as the group parameters. -If NUMBER, fetch this number of articles. - -Return the name of the group if selection was successful." - (interactive - (list - ;; (gnus-read-group "Group name: ") - (completing-read - "Group: " gnus-active-hashtb - nil nil nil - 'gnus-group-history) - (gnus-read-method "From method: "))) - ;; Transform the select method into a unique server. - (when (stringp method) - (setq method (gnus-server-to-method method))) - (setq method - `(,(car method) ,(concat (cadr method) "-ephemeral") - (,(intern (format "%s-address" (car method))) ,(cadr method)) - ,@(cddr method))) - (let ((group (if (gnus-group-foreign-p group) group - (gnus-group-prefixed-name (gnus-group-real-name group) - method)))) - (gnus-sethash - group - `(-1 nil (,group - ,gnus-level-default-subscribed nil nil ,method - ,(cons - (if quit-config - (cons 'quit-config quit-config) - (cons 'quit-config - (cons gnus-summary-buffer - gnus-current-window-configuration))) - parameters))) - gnus-newsrc-hashtb) - (push method gnus-ephemeral-servers) - (set-buffer gnus-group-buffer) - (unless (gnus-check-server method) - (error "Unable to contact server: %s" (gnus-status-message method))) - (when activate - (gnus-activate-group group 'scan) - (unless (gnus-request-group group) - (error "Couldn't request group: %s" - (nnheader-get-report (car method))))) - (if request-only - group - (condition-case () - (when (let ((gnus-large-newsgroup gnus-large-ephemeral-newsgroup) - (gnus-fetch-old-headers - gnus-fetch-old-ephemeral-headers)) - (gnus-group-read-group (or number t) t group select-articles)) - group) - ;;(error nil) - (quit - (message "Quit reading the ephemeral group") - nil))))) - -(defun gnus-group-jump-to-group (group) - "Jump to newsgroup GROUP." - (interactive - (list (mm-string-make-unibyte - (completing-read - "Group: " gnus-active-hashtb nil - (gnus-read-active-file-p) - gnus-group-jump-to-group-prompt - 'gnus-group-history)))) - - (when (equal group "") - (error "Empty group name")) - - (unless (gnus-ephemeral-group-p group) - ;; Either go to the line in the group buffer... - (unless (gnus-group-goto-group group) - ;; ... or insert the line. - (gnus-group-update-group group) - (gnus-group-goto-group group))) - ;; Adjust cursor point. - (gnus-group-position-point)) - -(defun gnus-group-goto-group (group &optional far test-marked) - "Goto to newsgroup GROUP. -If FAR, it is likely that the group is not on the current line. -If TEST-MARKED, the line must be marked." - (when group - (beginning-of-line) - (cond - ;; It's quite likely that we are on the right line, so - ;; we check the current line first. - ((and (not far) - (eq (get-text-property (point) 'gnus-group) - (gnus-intern-safe group gnus-active-hashtb)) - (or (not test-marked) (gnus-group-mark-line-p))) - (point)) - ;; Previous and next line are also likely, so we check them as well. - ((and (not far) - (save-excursion - (forward-line -1) - (and (eq (get-text-property (point) 'gnus-group) - (gnus-intern-safe group gnus-active-hashtb)) - (or (not test-marked) (gnus-group-mark-line-p))))) - (forward-line -1) - (point)) - ((and (not far) - (save-excursion - (forward-line 1) - (and (eq (get-text-property (point) 'gnus-group) - (gnus-intern-safe group gnus-active-hashtb)) - (or (not test-marked) (gnus-group-mark-line-p))))) - (forward-line 1) - (point)) - (test-marked - (goto-char (point-min)) - (let (found) - (while (and (not found) - (gnus-goto-char - (text-property-any - (point) (point-max) - 'gnus-group - (gnus-intern-safe group gnus-active-hashtb)))) - (if (gnus-group-mark-line-p) - (setq found t) - (forward-line 1))) - found)) - (t - ;; Search through the entire buffer. - (gnus-goto-char - (text-property-any - (point-min) (point-max) - 'gnus-group (gnus-intern-safe group gnus-active-hashtb))))))) - -(defun gnus-group-next-group (n &optional silent) - "Go to next N'th newsgroup. -If N is negative, search backward instead. -Returns the difference between N and the number of skips actually -done." - (interactive "p") - (gnus-group-next-unread-group n t nil silent)) - -(defun gnus-group-next-unread-group (n &optional all level silent) - "Go to next N'th unread newsgroup. -If N is negative, search backward instead. -If ALL is non-nil, choose any newsgroup, unread or not. -If LEVEL is non-nil, choose the next group with level LEVEL, or, if no -such group can be found, the next group with a level higher than -LEVEL. -Returns the difference between N and the number of skips actually -made." - (interactive "p") - (let ((backward (< n 0)) - (n (abs n))) - (while (and (> n 0) - (gnus-group-search-forward - backward (or (not gnus-group-goto-unread) all) level)) - (setq n (1- n))) - (when (and (/= 0 n) - (not silent)) - (gnus-message 7 "No more%s newsgroups%s" (if all "" " unread") - (if level " on this level or higher" ""))) - n)) - -(defun gnus-group-prev-group (n) - "Go to previous N'th newsgroup. -Returns the difference between N and the number of skips actually -done." - (interactive "p") - (gnus-group-next-unread-group (- n) t)) - -(defun gnus-group-prev-unread-group (n) - "Go to previous N'th unread newsgroup. -Returns the difference between N and the number of skips actually -done." - (interactive "p") - (gnus-group-next-unread-group (- n))) - -(defun gnus-group-next-unread-group-same-level (n) - "Go to next N'th unread newsgroup on the same level. -If N is negative, search backward instead. -Returns the difference between N and the number of skips actually -done." - (interactive "p") - (gnus-group-next-unread-group n t (gnus-group-group-level)) - (gnus-group-position-point)) - -(defun gnus-group-prev-unread-group-same-level (n) - "Go to next N'th unread newsgroup on the same level. -Returns the difference between N and the number of skips actually -done." - (interactive "p") - (gnus-group-next-unread-group (- n) t (gnus-group-group-level)) - (gnus-group-position-point)) - -(defun gnus-group-best-unread-group (&optional exclude-group) - "Go to the group with the highest level. -If EXCLUDE-GROUP, do not go to that group." - (interactive) - (goto-char (point-min)) - (let ((best 100000) - unread best-point) - (while (not (eobp)) - (setq unread (get-text-property (point) 'gnus-unread)) - (when (and (numberp unread) (> unread 0)) - (when (and (get-text-property (point) 'gnus-level) - (< (get-text-property (point) 'gnus-level) best) - (or (not exclude-group) - (not (equal exclude-group (gnus-group-group-name))))) - (setq best (get-text-property (point) 'gnus-level)) - (setq best-point (point)))) - (forward-line 1)) - (when best-point - (goto-char best-point)) - (gnus-group-position-point) - (and best-point (gnus-group-group-name)))) - -(defun gnus-group-first-unread-group () - "Go to the first group with unread articles." - (interactive) - (prog1 - (let ((opoint (point)) - unread) - (goto-char (point-min)) - (if (or (eq (setq unread (gnus-group-group-unread)) t) ; Not active. - (and (numberp unread) ; Not a topic. - (not (zerop unread))) ; Has unread articles. - (zerop (gnus-group-next-unread-group 1))) ; Next unread group. - (point) ; Success. - (goto-char opoint) - nil)) ; Not success. - (gnus-group-position-point))) - -(defun gnus-group-enter-server-mode () - "Jump to the server buffer." - (interactive) - (gnus-enter-server-buffer)) - -(defun gnus-group-make-group (name &optional method address args) - "Add a new newsgroup. -The user will be prompted for a NAME, for a select METHOD, and an -ADDRESS." - (interactive - (list - (gnus-read-group "Group name: ") - (gnus-read-method "From method: "))) - - (when (stringp method) - (setq method (or (gnus-server-to-method method) method))) - (let* ((meth (gnus-method-simplify - (when (and method - (not (gnus-server-equal method gnus-select-method))) - (if address (list (intern method) address) - method)))) - (nname (if method (gnus-group-prefixed-name name meth) name)) - backend info) - (when (gnus-gethash nname gnus-newsrc-hashtb) - (error "Group %s already exists" (gnus-group-decoded-name nname))) - ;; Subscribe to the new group. - (gnus-group-change-level - (setq info (list t nname gnus-level-default-subscribed nil nil meth)) - gnus-level-default-subscribed gnus-level-killed - (and (gnus-group-group-name) - (gnus-gethash (gnus-group-group-name) - gnus-newsrc-hashtb)) - t) - ;; Make it active. - (gnus-set-active nname (cons 1 0)) - (unless (gnus-ephemeral-group-p name) - (gnus-dribble-enter - (concat "(gnus-group-set-info '" - (gnus-prin1-to-string (cdr info)) ")"))) - ;; Insert the line. - (gnus-group-insert-group-line-info nname) - (forward-line -1) - (gnus-group-position-point) - - ;; Load the back end and try to make the back end create - ;; the group as well. - (when (assoc (symbol-name (setq backend (car (gnus-server-get-method - nil meth)))) - gnus-valid-select-methods) - (require backend)) - (gnus-check-server meth) - (when (gnus-check-backend-function 'request-create-group nname) - (unless (gnus-request-create-group nname nil args) - (error "Could not create group on server: %s" - (nnheader-get-report backend)))) - t)) - -(defun gnus-group-delete-groups (&optional arg) - "Delete the current group. Only meaningful with editable groups." - (interactive "P") - (let ((n (length (gnus-group-process-prefix arg)))) - (when (gnus-yes-or-no-p - (if (= n 1) - "Delete this 1 group? " - (format "Delete these %d groups? " n))) - (gnus-group-iterate arg - (lambda (group) - (gnus-group-delete-group group nil t)))))) - -(defun gnus-group-delete-group (group &optional force no-prompt) - "Delete the current group. Only meaningful with editable groups. -If FORCE (the prefix) is non-nil, all the articles in the group will -be deleted. This is \"deleted\" as in \"removed forever from the face -of the Earth\". There is no undo. The user will be prompted before -doing the deletion. -Note that you also have to specify FORCE if you want the group to -be removed from the server, even when it's empty." - (interactive - (list (gnus-group-group-name) - current-prefix-arg)) - (unless group - (error "No group to delete")) - (unless (gnus-check-backend-function 'request-delete-group group) - (error "This back end does not support group deletion")) - (prog1 - (let ((group-decoded (gnus-group-decoded-name group))) - (if (and (not no-prompt) - (not (gnus-yes-or-no-p - (format - "Do you really want to delete %s%s? " - group-decoded (if force " and all its contents" ""))))) - () ; Whew! - (gnus-message 6 "Deleting group %s..." group-decoded) - (if (not (gnus-request-delete-group group force)) - (gnus-error 3 "Couldn't delete group %s" group-decoded) - (gnus-message 6 "Deleting group %s...done" group-decoded) - (gnus-group-goto-group group) - (gnus-group-kill-group 1 t) - (gnus-sethash group nil gnus-active-hashtb) - t))) - (gnus-group-position-point))) - -(defun gnus-group-rename-group (group new-name) - "Rename group from GROUP to NEW-NAME. -When used interactively, GROUP is the group under point -and NEW-NAME will be prompted for." - (interactive - (list - (gnus-group-group-name) - (progn - (unless (gnus-check-backend-function - 'request-rename-group (gnus-group-group-name)) - (error "This back end does not support renaming groups")) - (gnus-read-group "Rename group to: " - (gnus-group-real-name (gnus-group-group-name)))))) - - (unless (gnus-check-backend-function 'request-rename-group group) - (error "This back end does not support renaming groups")) - (unless group - (error "No group to rename")) - (when (equal (gnus-group-real-name group) new-name) - (error "Can't rename to the same name")) - - ;; We find the proper prefixed name. - (setq new-name - (if (gnus-group-native-p group) - ;; Native group. - new-name - ;; Foreign group. - (gnus-group-prefixed-name - (gnus-group-real-name new-name) - (gnus-info-method (gnus-get-info group))))) - - (when (gnus-active new-name) - (error "The group %s already exists" new-name)) - - (gnus-message 6 "Renaming group %s to %s..." group new-name) - (prog1 - (if (progn - (gnus-group-goto-group group) - (not (when (< (gnus-group-group-level) gnus-level-zombie) - (gnus-request-rename-group group new-name)))) - (gnus-error 3 "Couldn't rename group %s to %s" group new-name) - ;; We rename the group internally by killing it... - (gnus-group-kill-group) - ;; ... changing its name ... - (setcar (cdar gnus-list-of-killed-groups) new-name) - ;; ... and then yanking it. Magic! - (gnus-group-yank-group) - (gnus-set-active new-name (gnus-active group)) - (gnus-message 6 "Renaming group %s to %s...done" group new-name) - new-name) - (setq gnus-killed-list (delete group gnus-killed-list)) - (gnus-set-active group nil) - (gnus-dribble-touch) - (gnus-group-position-point))) - -(defun gnus-group-edit-group (group &optional part) - "Edit the group on the current line." - (interactive (list (gnus-group-group-name))) - (let ((part (or part 'info)) - info) - (unless group - (error "No group on current line")) - (unless (setq info (gnus-get-info group)) - (error "Killed group; can't be edited")) - (ignore-errors - (gnus-close-group group)) - (gnus-edit-form - ;; Find the proper form to edit. - (cond ((eq part 'method) - (or (gnus-info-method info) "native")) - ((eq part 'params) - (gnus-info-params info)) - (t info)) - ;; The proper documentation. - (format - "Editing the %s for `%s'." - (cond - ((eq part 'method) "select method") - ((eq part 'params) "group parameters") - (t "group info")) - (gnus-group-decoded-name group)) - `(lambda (form) - (gnus-group-edit-group-done ',part ,group form))) - (local-set-key - "\C-c\C-i" - (gnus-create-info-command - (cond - ((eq part 'method) - "(gnus)Select Methods") - ((eq part 'params) - "(gnus)Group Parameters") - (t - "(gnus)Group Info")))))) - -(defun gnus-group-edit-group-method (group) - "Edit the select method of GROUP." - (interactive (list (gnus-group-group-name))) - (gnus-group-edit-group group 'method)) - -(defun gnus-group-edit-group-parameters (group) - "Edit the group parameters of GROUP." - (interactive (list (gnus-group-group-name))) - (gnus-group-edit-group group 'params)) - -(defun gnus-group-edit-group-done (part group form) - "Update variables." - (let* ((method (cond ((eq part 'info) (nth 4 form)) - ((eq part 'method) form) - (t nil))) - (info (cond ((eq part 'info) form) - ((eq part 'method) (gnus-get-info group)) - (t nil))) - (new-group (if info - (if (or (not method) - (gnus-server-equal - gnus-select-method method)) - (gnus-group-real-name (car info)) - (gnus-group-prefixed-name - (gnus-group-real-name (car info)) method)) - nil))) - (when (and new-group - (not (equal new-group group))) - (when (gnus-group-goto-group group) - (gnus-group-kill-group 1)) - (gnus-activate-group new-group)) - ;; Set the info. - (if (not (and info new-group)) - (gnus-group-set-info form (or new-group group) part) - (setq info (gnus-copy-sequence info)) - (setcar info new-group) - (unless (gnus-server-equal method "native") - (unless (nthcdr 3 info) - (nconc info (list nil nil))) - (unless (nthcdr 4 info) - (nconc info (list nil))) - (gnus-info-set-method info method)) - (gnus-group-set-info info)) - (gnus-group-update-group (or new-group group)) - (gnus-group-position-point))) - -(defun gnus-group-make-useful-group (group method) - "Create one of the groups described in `gnus-useful-groups'." - (interactive - (let ((entry (assoc (completing-read "Create group: " gnus-useful-groups - nil t) - gnus-useful-groups))) - (list (cadr entry) (caddr entry)))) - (setq method (gnus-copy-sequence method)) - (let (entry) - (while (setq entry (memq (assq 'eval method) method)) - (setcar entry (eval (cadar entry))))) - (gnus-group-make-group group method)) - -(defun gnus-group-make-help-group (&optional noerror) - "Create the Gnus documentation group. -Optional argument NOERROR modifies the behavior of this function when the -group already exists: -- if not given, and error is signaled, -- if t, stay silent, -- if anything else, just print a message." - (interactive) - (let ((name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help"))) - (file (nnheader-find-etc-directory "gnus-tut.txt" t))) - (if (gnus-gethash name gnus-newsrc-hashtb) - (cond ((eq noerror nil) - (error "Documentation group already exists")) - ((eq noerror t) - ;; stay silent - ) - (t - (gnus-message 1 "Documentation group already exists"))) - ;; else: - (if (not file) - (gnus-message 1 "Couldn't find doc group") - (gnus-group-make-group - (gnus-group-real-name name) - (list 'nndoc "gnus-help" - (list 'nndoc-address file) - (list 'nndoc-article-type 'mbox)))) - )) - (gnus-group-position-point)) - -(defun gnus-group-make-doc-group (file type) - "Create a group that uses a single file as the source. - -If called with a prefix argument, ask for the file type." - (interactive - (list (read-file-name "File name: ") - (and current-prefix-arg 'ask))) - (when (eq type 'ask) - (let ((err "") - char found) - (while (not found) - (message - "%sFile type (mbox, babyl, digest, forward, mmdf, guess) [m, b, d, f, a, g]: " - err) - (setq found (cond ((= (setq char (read-char)) ?m) 'mbox) - ((= char ?b) 'babyl) - ((= char ?d) 'digest) - ((= char ?f) 'forward) - ((= char ?a) 'mmfd) - ((= char ?g) 'guess) - (t (setq err (format "%c unknown. " char)) - nil)))) - (setq type found))) - (setq file (expand-file-name file)) - (let ((name (gnus-generate-new-group-name - (gnus-group-prefixed-name - (file-name-nondirectory file) '(nndoc "")))) - (encodable (mm-coding-system-p 'utf-8))) - (gnus-group-make-group - (if encodable - (mm-encode-coding-string (gnus-group-real-name name) 'utf-8) - (gnus-group-real-name name)) - (list 'nndoc (if encodable - (mm-encode-coding-string file 'utf-8) - file) - (list 'nndoc-address file) - (list 'nndoc-article-type (or type 'guess)))))) - -(defvar nnweb-type-definition) -(defvar gnus-group-web-type-history nil) -(defvar gnus-group-web-search-history nil) -(defun gnus-group-make-web-group (&optional solid) - "Create an ephemeral nnweb group. -If SOLID (the prefix), create a solid group." - (interactive "P") - (require 'nnweb) - (let* ((group - (if solid (gnus-read-group "Group name: ") - (message-unique-id))) - (default-type (or (car gnus-group-web-type-history) - (symbol-name (caar nnweb-type-definition)))) - (type - (gnus-string-or - (completing-read - (format "Search engine type (default %s): " default-type) - (mapcar (lambda (elem) (list (symbol-name (car elem)))) - nnweb-type-definition) - nil t nil 'gnus-group-web-type-history) - default-type)) - (search - (read-string - "Search string: " - (cons (or (car gnus-group-web-search-history) "") 0) - 'gnus-group-web-search-history)) - (method - `(nnweb ,group (nnweb-search ,search) - (nnweb-type ,(intern type)) - (nnweb-ephemeral-p t)))) - (if solid - (progn - (gnus-pull 'nnweb-ephemeral-p method) - (gnus-group-make-group group method)) - (gnus-group-read-ephemeral-group - group method t - (cons (current-buffer) - (if (eq major-mode 'gnus-summary-mode) 'summary 'group)))))) - -(eval-when-compile - (defvar nnrss-group-alist) - (defun nnrss-discover-feed (arg)) - (defun nnrss-save-server-data (arg))) -(defun gnus-group-make-rss-group (&optional url) - "Given a URL, discover if there is an RSS feed. -If there is, use Gnus to create an nnrss group" - (interactive) - (require 'nnrss) - (if (not url) - (setq url (read-from-minibuffer "URL to Search for RSS: "))) - (let ((feedinfo (nnrss-discover-feed url))) - (if feedinfo - (let ((title (gnus-newsgroup-savable-name - (read-from-minibuffer "Title: " - (gnus-newsgroup-savable-name - (or (cdr (assoc 'title - feedinfo)) - ""))))) - (desc (read-from-minibuffer "Description: " - (cdr (assoc 'description - feedinfo)))) - (href (cdr (assoc 'href feedinfo))) - (encodable (mm-coding-system-p 'utf-8))) - (when encodable - ;; Unify non-ASCII text. - (setq title (mm-decode-coding-string - (mm-encode-coding-string title 'utf-8) 'utf-8))) - (gnus-group-make-group (if encodable - (mm-encode-coding-string title 'utf-8) - title) - '(nnrss "")) - (push (list title href desc) nnrss-group-alist) - (nnrss-save-server-data nil)) - (error "No feeds found for %s" url)))) - -(defvar nnwarchive-type-definition) -(defvar gnus-group-warchive-type-history nil) -(defvar gnus-group-warchive-login-history nil) -(defvar gnus-group-warchive-address-history nil) - -(defun gnus-group-make-warchive-group () - "Create a nnwarchive group." - (interactive) - (require 'nnwarchive) - (let* ((group (gnus-read-group "Group name: ")) - (default-type (or (car gnus-group-warchive-type-history) - (symbol-name (caar nnwarchive-type-definition)))) - (type - (gnus-string-or - (completing-read - (format "Warchive type (default %s): " default-type) - (mapcar (lambda (elem) (list (symbol-name (car elem)))) - nnwarchive-type-definition) - nil t nil 'gnus-group-warchive-type-history) - default-type)) - (address (read-string "Warchive address: " - nil 'gnus-group-warchive-address-history)) - (default-login (or (car gnus-group-warchive-login-history) - user-mail-address)) - (login - (gnus-string-or - (read-string - (format "Warchive login (default %s): " user-mail-address) - default-login 'gnus-group-warchive-login-history) - user-mail-address)) - (method - `(nnwarchive ,address - (nnwarchive-type ,(intern type)) - (nnwarchive-login ,login)))) - (gnus-group-make-group group method))) - -(defun gnus-group-make-archive-group (&optional all) - "Create the (ding) Gnus archive group of the most recent articles. -Given a prefix, create a full group." - (interactive "P") - (let ((group (gnus-group-prefixed-name - (if all "ding.archives" "ding.recent") '(nndir "")))) - (when (gnus-gethash group gnus-newsrc-hashtb) - (error "Archive group already exists")) - (gnus-group-make-group - (gnus-group-real-name group) - (list 'nndir (if all "hpc" "edu") - (list 'nndir-directory - (if all gnus-group-archive-directory - gnus-group-recent-archive-directory)))) - (gnus-group-add-parameter group (cons 'to-address "ding@gnus.org")))) - -(defun gnus-group-make-directory-group (dir) - "Create an nndir group. -The user will be prompted for a directory. The contents of this -directory will be used as a newsgroup. The directory should contain -mail messages or news articles in files that have numeric names." - (interactive - (list (read-file-name "Create group from directory: "))) - (unless (file-exists-p dir) - (error "No such directory")) - (unless (file-directory-p dir) - (error "Not a directory")) - (let ((ext "") - (i 0) - group) - (while (or (not group) (gnus-gethash group gnus-newsrc-hashtb)) - (setq group - (gnus-group-prefixed-name - (expand-file-name ext dir) - '(nndir ""))) - (setq ext (format "<%d>" (setq i (1+ i))))) - (gnus-group-make-group - (gnus-group-real-name group) - (list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir))))) - -(defvar nnkiboze-score-file) -(defun gnus-group-make-kiboze-group (group address scores) - "Create an nnkiboze group. -The user will be prompted for a name, a regexp to match groups, and -score file entries for articles to include in the group." - (interactive - (list - (read-string "nnkiboze group name: ") - (read-string "Source groups (regexp): ") - (let ((headers (mapcar (lambda (group) (list group)) - '("subject" "from" "number" "date" "message-id" - "references" "chars" "lines" "xref" - "followup" "all" "body" "head"))) - scores header regexp regexps) - (while (not (equal "" (setq header (completing-read - "Match on header: " headers nil t)))) - (setq regexps nil) - (while (not (equal "" (setq regexp (read-string - (format "Match on %s (regexp): " - header))))) - (push (list regexp nil nil 'r) regexps)) - (push (cons header regexps) scores)) - scores))) - (gnus-group-make-group group "nnkiboze" address) - (let* ((nnkiboze-current-group group) - (score-file (car (nnkiboze-score-file ""))) - (score-dir (file-name-directory score-file))) - (unless (file-exists-p score-dir) - (make-directory score-dir)) - (with-temp-file score-file - (let (emacs-lisp-mode-hook) - (gnus-pp scores))))) - -(defun gnus-group-add-to-virtual (n vgroup) - "Add the current group to a virtual group." - (interactive - (list current-prefix-arg - (completing-read "Add to virtual group: " gnus-newsrc-hashtb nil t - "nnvirtual:"))) - (unless (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual) - (error "%s is not an nnvirtual group" vgroup)) - (gnus-close-group vgroup) - (let* ((groups (gnus-group-process-prefix n)) - (method (gnus-info-method (gnus-get-info vgroup)))) - (setcar (cdr method) - (concat - (nth 1 method) "\\|" - (mapconcat - (lambda (s) - (gnus-group-remove-mark s) - (concat "\\(^" (regexp-quote s) "$\\)")) - groups "\\|")))) - (gnus-group-position-point)) - -(defun gnus-group-make-empty-virtual (group) - "Create a new, fresh, empty virtual group." - (interactive "sCreate new, empty virtual group: ") - (let* ((method (list 'nnvirtual "^$")) - (pgroup (gnus-group-prefixed-name group method))) - ;; Check whether it exists already. - (when (gnus-gethash pgroup gnus-newsrc-hashtb) - (error "Group %s already exists" pgroup)) - ;; Subscribe the new group after the group on the current line. - (gnus-subscribe-group pgroup (gnus-group-group-name) method) - (gnus-group-update-group pgroup) - (forward-line -1) - (gnus-group-position-point))) - -(defun gnus-group-enter-directory (dir) - "Enter an ephemeral nneething group." - (interactive "DDirectory to read: ") - (let* ((method (list 'nneething dir '(nneething-read-only t))) - (leaf (gnus-group-prefixed-name - (file-name-nondirectory (directory-file-name dir)) - method)) - (name (gnus-generate-new-group-name leaf))) - (unless (gnus-group-read-ephemeral-group - name method t - (cons (current-buffer) - (if (eq major-mode 'gnus-summary-mode) - 'summary 'group))) - (error "Couldn't enter %s" dir)))) - -(eval-and-compile - (autoload 'nnimap-expunge "nnimap") - (autoload 'nnimap-acl-get "nnimap") - (autoload 'nnimap-acl-edit "nnimap")) - -(defun gnus-group-nnimap-expunge (group) - "Expunge deleted articles in current nnimap GROUP." - (interactive (list (gnus-group-group-name))) - (let ((mailbox (gnus-group-real-name group)) method) - (unless group - (error "No group on current line")) - (unless (gnus-get-info group) - (error "Killed group; can't be edited")) - (unless (eq 'nnimap (car (setq method (gnus-find-method-for-group group)))) - (error "%s is not an nnimap group" group)) - (nnimap-expunge mailbox (cadr method)))) - -(defun gnus-group-nnimap-edit-acl (group) - "Edit the Access Control List of current nnimap GROUP." - (interactive (list (gnus-group-group-name))) - (let ((mailbox (gnus-group-real-name group)) method acl) - (unless group - (error "No group on current line")) - (unless (gnus-get-info group) - (error "Killed group; can't be edited")) - (unless (eq (car (setq method (gnus-find-method-for-group group))) 'nnimap) - (error "%s is not an nnimap group" group)) - (unless (setq acl (nnimap-acl-get mailbox (cadr method))) - (error "Server does not support ACL's")) - (gnus-edit-form acl (format "Editing the access control list for `%s'. - - An access control list is a list of (identifier . rights) elements. - - The identifier string specifies the corresponding user. The - identifier \"anyone\" is reserved to refer to the universal identity. - - Rights is a string listing a (possibly empty) set of alphanumeric - characters, each character listing a set of operations which is being - controlled. Letters are reserved for ``standard'' rights, listed - below. Digits are reserved for implementation or site defined rights. - - l - lookup (mailbox is visible to LIST/LSUB commands) - r - read (SELECT the mailbox, perform CHECK, FETCH, PARTIAL, - SEARCH, COPY from mailbox) - s - keep seen/unseen information across sessions (STORE \\SEEN flag) - w - write (STORE flags other than \\SEEN and \\DELETED) - i - insert (perform APPEND, COPY into mailbox) - p - post (send mail to submission address for mailbox, - not enforced by IMAP4 itself) - c - create and delete mailbox (CREATE new sub-mailboxes in any - implementation-defined hierarchy, RENAME or DELETE mailbox) - d - delete messages (STORE \\DELETED flag, perform EXPUNGE) - a - administer (perform SETACL)" group) - `(lambda (form) - (nnimap-acl-edit - ,mailbox ',method ',acl form))))) - -;; Group sorting commands -;; Suggested by Joe Hildebrand . - -(defun gnus-group-sort-groups (func &optional reverse) - "Sort the group buffer according to FUNC. -When used interactively, the sorting function used will be -determined by the `gnus-group-sort-function' variable. -If REVERSE (the prefix), reverse the sorting order." - (interactive (list gnus-group-sort-function current-prefix-arg)) - (funcall gnus-group-sort-alist-function - (gnus-make-sort-function func) reverse) - (gnus-group-unmark-all-groups) - (gnus-group-list-groups) - (gnus-dribble-touch)) - -(defun gnus-group-sort-flat (func reverse) - ;; We peel off the dummy group from the alist. - (when func - (when (equal (gnus-info-group (car gnus-newsrc-alist)) "dummy.group") - (pop gnus-newsrc-alist)) - ;; Do the sorting. - (setq gnus-newsrc-alist - (sort gnus-newsrc-alist func)) - (when reverse - (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist))) - ;; Regenerate the hash table. - (gnus-make-hashtable-from-newsrc-alist))) - -(defun gnus-group-sort-groups-by-alphabet (&optional reverse) - "Sort the group buffer alphabetically by group name. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-groups 'gnus-group-sort-by-alphabet reverse)) - -(defun gnus-group-sort-groups-by-real-name (&optional reverse) - "Sort the group buffer alphabetically by real (unprefixed) group name. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-groups 'gnus-group-sort-by-real-name reverse)) - -(defun gnus-group-sort-groups-by-unread (&optional reverse) - "Sort the group buffer by number of unread articles. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-groups 'gnus-group-sort-by-unread reverse)) - -(defun gnus-group-sort-groups-by-level (&optional reverse) - "Sort the group buffer by group level. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-groups 'gnus-group-sort-by-level reverse)) - -(defun gnus-group-sort-groups-by-score (&optional reverse) - "Sort the group buffer by group score. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-groups 'gnus-group-sort-by-score reverse)) - -(defun gnus-group-sort-groups-by-rank (&optional reverse) - "Sort the group buffer by group rank. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-groups 'gnus-group-sort-by-rank reverse)) - -(defun gnus-group-sort-groups-by-method (&optional reverse) - "Sort the group buffer alphabetically by back end name. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-groups 'gnus-group-sort-by-method reverse)) - -(defun gnus-group-sort-groups-by-server (&optional reverse) - "Sort the group buffer alphabetically by server name. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-groups 'gnus-group-sort-by-server reverse)) - -;;; Selected group sorting. - -(defun gnus-group-sort-selected-groups (n func &optional reverse) - "Sort the process/prefixed groups." - (interactive (list current-prefix-arg gnus-group-sort-function)) - (let ((groups (gnus-group-process-prefix n))) - (funcall gnus-group-sort-selected-function - groups (gnus-make-sort-function func) reverse) - (gnus-group-unmark-all-groups) - (gnus-group-list-groups) - (gnus-dribble-touch))) - -(defun gnus-group-sort-selected-flat (groups func reverse) - (let (entries infos) - ;; First find all the group entries for these groups. - (while groups - (push (nthcdr 2 (gnus-gethash (pop groups) gnus-newsrc-hashtb)) - entries)) - ;; Then sort the infos. - (setq infos - (sort - (mapcar - (lambda (entry) (car entry)) - (setq entries (nreverse entries))) - func)) - (when reverse - (setq infos (nreverse infos))) - ;; Go through all the infos and replace the old entries - ;; with the new infos. - (while infos - (setcar (car entries) (pop infos)) - (pop entries)) - ;; Update the hashtable. - (gnus-make-hashtable-from-newsrc-alist))) - -(defun gnus-group-sort-selected-groups-by-alphabet (&optional n reverse) - "Sort the group buffer alphabetically by group name. -Obeys the process/prefix convention. If REVERSE (the symbolic prefix), -sort in reverse order." - (interactive (gnus-interactive "P\ny")) - (gnus-group-sort-selected-groups n 'gnus-group-sort-by-alphabet reverse)) - -(defun gnus-group-sort-selected-groups-by-real-name (&optional n reverse) - "Sort the group buffer alphabetically by real group name. -Obeys the process/prefix convention. If REVERSE (the symbolic prefix), -sort in reverse order." - (interactive (gnus-interactive "P\ny")) - (gnus-group-sort-selected-groups n 'gnus-group-sort-by-real-name reverse)) - -(defun gnus-group-sort-selected-groups-by-unread (&optional n reverse) - "Sort the group buffer by number of unread articles. -Obeys the process/prefix convention. If REVERSE (the symbolic prefix), -sort in reverse order." - (interactive (gnus-interactive "P\ny")) - (gnus-group-sort-selected-groups n 'gnus-group-sort-by-unread reverse)) - -(defun gnus-group-sort-selected-groups-by-level (&optional n reverse) - "Sort the group buffer by group level. -Obeys the process/prefix convention. If REVERSE (the symbolic prefix), -sort in reverse order." - (interactive (gnus-interactive "P\ny")) - (gnus-group-sort-selected-groups n 'gnus-group-sort-by-level reverse)) - -(defun gnus-group-sort-selected-groups-by-score (&optional n reverse) - "Sort the group buffer by group score. -Obeys the process/prefix convention. If REVERSE (the symbolic prefix), -sort in reverse order." - (interactive (gnus-interactive "P\ny")) - (gnus-group-sort-selected-groups n 'gnus-group-sort-by-score reverse)) - -(defun gnus-group-sort-selected-groups-by-rank (&optional n reverse) - "Sort the group buffer by group rank. -Obeys the process/prefix convention. If REVERSE (the symbolic prefix), -sort in reverse order." - (interactive (gnus-interactive "P\ny")) - (gnus-group-sort-selected-groups n 'gnus-group-sort-by-rank reverse)) - -(defun gnus-group-sort-selected-groups-by-method (&optional n reverse) - "Sort the group buffer alphabetically by back end name. -Obeys the process/prefix convention. If REVERSE (the symbolic prefix), -sort in reverse order." - (interactive (gnus-interactive "P\ny")) - (gnus-group-sort-selected-groups n 'gnus-group-sort-by-method reverse)) - -;;; Sorting predicates. - -(defun gnus-group-sort-by-alphabet (info1 info2) - "Sort alphabetically." - (string< (gnus-info-group info1) (gnus-info-group info2))) - -(defun gnus-group-sort-by-real-name (info1 info2) - "Sort alphabetically on real (unprefixed) names." - (string< (gnus-group-real-name (gnus-info-group info1)) - (gnus-group-real-name (gnus-info-group info2)))) - -(defun gnus-group-sort-by-unread (info1 info2) - "Sort by number of unread articles." - (let ((n1 (car (gnus-gethash (gnus-info-group info1) gnus-newsrc-hashtb))) - (n2 (car (gnus-gethash (gnus-info-group info2) gnus-newsrc-hashtb)))) - (< (or (and (numberp n1) n1) 0) - (or (and (numberp n2) n2) 0)))) - -(defun gnus-group-sort-by-level (info1 info2) - "Sort by level." - (< (gnus-info-level info1) (gnus-info-level info2))) - -(defun gnus-group-sort-by-method (info1 info2) - "Sort alphabetically by back end name." - (string< (car (gnus-find-method-for-group - (gnus-info-group info1) info1)) - (car (gnus-find-method-for-group - (gnus-info-group info2) info2)))) - -(defun gnus-group-sort-by-server (info1 info2) - "Sort alphabetically by server name." - (string< (gnus-method-to-full-server-name - (gnus-find-method-for-group - (gnus-info-group info1) info1)) - (gnus-method-to-full-server-name - (gnus-find-method-for-group - (gnus-info-group info2) info2)))) - -(defun gnus-group-sort-by-score (info1 info2) - "Sort by group score." - (> (gnus-info-score info1) (gnus-info-score info2))) - -(defun gnus-group-sort-by-rank (info1 info2) - "Sort by level and score." - (let ((level1 (gnus-info-level info1)) - (level2 (gnus-info-level info2))) - (or (< level1 level2) - (and (= level1 level2) - (> (gnus-info-score info1) (gnus-info-score info2)))))) - -;;; Clearing data - -(defun gnus-group-clear-data (&optional arg) - "Clear all marks and read ranges from the current group. -Obeys the process/prefix convention." - (interactive "P") - (gnus-group-iterate arg - (lambda (group) - (let (info) - (gnus-info-clear-data (setq info (gnus-get-info group))) - (gnus-get-unread-articles-in-group info (gnus-active group) t) - (when (gnus-group-goto-group group) - (gnus-group-update-group-line)))))) - -(defun gnus-group-clear-data-on-native-groups () - "Clear all marks and read ranges from all native groups." - (interactive) - (when (gnus-yes-or-no-p "Really clear all data from almost all groups? ") - (let ((alist (cdr gnus-newsrc-alist)) - info) - (while (setq info (pop alist)) - (when (gnus-group-native-p (gnus-info-group info)) - (gnus-info-clear-data info))) - (gnus-get-unread-articles) - (gnus-dribble-touch) - (when (gnus-y-or-n-p - "Move the cache away to avoid problems in the future? ") - (call-interactively 'gnus-cache-move-cache))))) - -(defun gnus-info-clear-data (info) - "Clear all marks and read ranges from INFO." - (let ((group (gnus-info-group info)) - action) - (dolist (el (gnus-info-marks info)) - (push `(,(cdr el) add (,(car el))) action)) - (push `(,(gnus-info-read info) add (read)) action) - (gnus-undo-register - `(progn - (gnus-request-set-mark ,group ',action) - (gnus-info-set-marks ',info ',(gnus-info-marks info) t) - (gnus-info-set-read ',info ',(gnus-info-read info)) - (when (gnus-group-goto-group ,group) - (gnus-get-unread-articles-in-group ',info ',(gnus-active group) t) - (gnus-group-update-group-line)))) - (setq action (mapcar (lambda (el) (list (nth 0 el) 'del (nth 2 el))) - action)) - (gnus-request-set-mark group action) - (gnus-info-set-read info nil) - (when (gnus-info-marks info) - (gnus-info-set-marks info nil)))) - -;; Group catching up. - -(defun gnus-group-catchup-current (&optional n all) - "Mark all unread articles in the current newsgroup as read. -If prefix argument N is numeric, the next N newsgroups will be -caught up. If ALL is non-nil, marked articles will also be marked as -read. Cross references (Xref: header) of articles are ignored. -The number of newsgroups that this function was unable to catch -up is returned." - (interactive "P") - (let ((groups (gnus-group-process-prefix n)) - (ret 0) - group) - (unless groups (error "No groups selected")) - (if (not - (or (not gnus-interactive-catchup) ;Without confirmation? - gnus-expert-user - (gnus-y-or-n-p - (format - (if all - "Do you really want to mark all articles in %s as read? " - "Mark all unread articles in %s as read? ") - (if (= (length groups) 1) - (gnus-group-decoded-name (car groups)) - (format "these %d groups" (length groups))))))) - n - (while (setq group (pop groups)) - (gnus-group-remove-mark group) - ;; Virtual groups have to be given special treatment. - (let ((method (gnus-find-method-for-group group))) - (when (eq 'nnvirtual (car method)) - (nnvirtual-catchup-group - (gnus-group-real-name group) (nth 1 method) all))) - (if (>= (gnus-group-level group) gnus-level-zombie) - (gnus-message 2 "Dead groups can't be caught up") - (if (prog1 - (gnus-group-goto-group group) - (gnus-group-catchup group all)) - (gnus-group-update-group-line) - (setq ret (1+ ret))))) - (gnus-group-next-unread-group 1) - ret))) - -(defun gnus-group-catchup-current-all (&optional n) - "Mark all articles in current newsgroup as read. -Cross references (Xref: header) of articles are ignored." - (interactive "P") - (gnus-group-catchup-current n 'all)) - -(defun gnus-group-catchup (group &optional all) - "Mark all articles in GROUP as read. -If ALL is non-nil, all articles are marked as read. -The return value is the number of articles that were marked as read, -or nil if no action could be taken." - (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) - (num (car entry)) - (marks (nth 3 (nth 2 entry))) - (unread (gnus-sequence-of-unread-articles group))) - ;; Remove entries for this group. - (nnmail-purge-split-history (gnus-group-real-name group)) - ;; Do the updating only if the newsgroup isn't killed. - (if (not (numberp (car entry))) - (gnus-message 1 "Can't catch up %s; non-active group" group) - (gnus-update-read-articles group nil) - (when all - ;; Nix out the lists of marks and dormants. - (gnus-request-set-mark group (list (list (cdr (assq 'tick marks)) - 'del '(tick)) - (list (cdr (assq 'dormant marks)) - 'del '(dormant)))) - (setq unread (gnus-range-add (gnus-range-add - unread (cdr (assq 'dormant marks))) - (cdr (assq 'tick marks)))) - (gnus-add-marked-articles group 'tick nil nil 'force) - (gnus-add-marked-articles group 'dormant nil nil 'force)) - ;; Do auto-expirable marks if that's required. - (when (gnus-group-auto-expirable-p group) - (gnus-range-map (lambda (article) - (gnus-add-marked-articles group 'expire (list article)) - (gnus-request-set-mark group (list (list (list article) 'add '(expire))))) - unread)) - (let ((gnus-newsgroup-name group)) - (gnus-run-hooks 'gnus-group-catchup-group-hook)) - num))) - -(defun gnus-group-expire-articles (&optional n) - "Expire all expirable articles in the current newsgroup. -Uses the process/prefix convention." - (interactive "P") - (let ((groups (gnus-group-process-prefix n)) - group) - (unless groups - (error "No groups to expire")) - (while (setq group (pop groups)) - (gnus-group-remove-mark group) - (gnus-group-expire-articles-1 group) - (gnus-dribble-touch) - (gnus-group-position-point)))) - -(defun gnus-group-expire-articles-1 (group) - (when (gnus-check-backend-function 'request-expire-articles group) - (gnus-message 6 "Expiring articles in %s..." - (gnus-group-decoded-name group)) - (let* ((info (gnus-get-info group)) - (expirable (if (gnus-group-total-expirable-p group) - (cons nil (gnus-list-of-read-articles group)) - (assq 'expire (gnus-info-marks info)))) - (expiry-wait (gnus-group-find-parameter group 'expiry-wait)) - (nnmail-expiry-target - (or (gnus-group-find-parameter group 'expiry-target) - nnmail-expiry-target))) - (when expirable - (gnus-check-group group) - (setcdr - expirable - (gnus-compress-sequence - (if expiry-wait - ;; We set the expiry variables to the group - ;; parameter. - (let ((nnmail-expiry-wait-function nil) - (nnmail-expiry-wait expiry-wait)) - (gnus-request-expire-articles - (gnus-uncompress-sequence (cdr expirable)) group)) - ;; Just expire using the normal expiry values. - (gnus-request-expire-articles - (gnus-uncompress-sequence (cdr expirable)) group)))) - (gnus-close-group group)) - (gnus-message 6 "Expiring articles in %s...done" - (gnus-group-decoded-name group)) - ;; Return the list of un-expired articles. - (cdr expirable)))) - -(defun gnus-group-expire-all-groups () - "Expire all expirable articles in all newsgroups." - (interactive) - (save-excursion - (gnus-message 5 "Expiring...") - (let ((gnus-group-marked (mapcar (lambda (info) (gnus-info-group info)) - (cdr gnus-newsrc-alist)))) - (gnus-group-expire-articles nil))) - (gnus-group-position-point) - (gnus-message 5 "Expiring...done")) - -(defun gnus-group-set-current-level (n level) - "Set the level of the next N groups to LEVEL." - (interactive - (list - current-prefix-arg - (progn - (unless (gnus-group-process-prefix current-prefix-arg) - (error "No group on the current line")) - (string-to-number - (let ((s (read-string - (format "Level (default %s): " - (or (gnus-group-group-level) - gnus-level-default-subscribed))))) - (if (string-match "^\\s-*$" s) - (int-to-string (or (gnus-group-group-level) - gnus-level-default-subscribed)) - s)))))) - (unless (and (>= level 1) (<= level gnus-level-killed)) - (error "Invalid level: %d" level)) - (let ((groups (gnus-group-process-prefix n)) - group) - (while (setq group (pop groups)) - (gnus-group-remove-mark group) - (gnus-message 6 "Changed level of %s from %d to %d" - (gnus-group-decoded-name group) - (or (gnus-group-group-level) gnus-level-killed) - level) - (gnus-group-change-level - group level (or (gnus-group-group-level) gnus-level-killed)) - (gnus-group-update-group-line))) - (gnus-group-position-point)) - -(defun gnus-group-unsubscribe (&optional n) - "Unsubscribe the current group." - (interactive "P") - (gnus-group-unsubscribe-current-group n 'unsubscribe)) - -(defun gnus-group-subscribe (&optional n) - "Subscribe the current group." - (interactive "P") - (gnus-group-unsubscribe-current-group n 'subscribe)) - -(defun gnus-group-unsubscribe-current-group (&optional n do-sub) - "Toggle subscription of the current group. -If given numerical prefix, toggle the N next groups." - (interactive "P") - (dolist (group (gnus-group-process-prefix n)) - (gnus-group-remove-mark group) - (gnus-group-unsubscribe-group - group - (cond - ((eq do-sub 'unsubscribe) - gnus-level-default-unsubscribed) - ((eq do-sub 'subscribe) - gnus-level-default-subscribed) - ((<= (gnus-group-group-level) gnus-level-subscribed) - gnus-level-default-unsubscribed) - (t - gnus-level-default-subscribed)) - t) - (gnus-group-update-group-line)) - (gnus-group-next-group 1)) - -(defun gnus-group-unsubscribe-group (group &optional level silent) - "Toggle subscription to GROUP. -Killed newsgroups are subscribed. If SILENT, don't try to update the -group line." - (interactive - (list (completing-read - "Group: " gnus-active-hashtb nil - (gnus-read-active-file-p) - nil - 'gnus-group-history))) - (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb))) - (cond - ((string-match "^[ \t]*$" group) - (error "Empty group name")) - (newsrc - ;; Toggle subscription flag. - (gnus-group-change-level - newsrc (if level level (if (<= (gnus-info-level (nth 2 newsrc)) - gnus-level-subscribed) - (1+ gnus-level-subscribed) - gnus-level-default-subscribed))) - (unless silent - (gnus-group-update-group group))) - ((and (stringp group) - (or (not (gnus-read-active-file-p)) - (gnus-active group))) - ;; Add new newsgroup. - (gnus-group-change-level - group - (if level level gnus-level-default-subscribed) - (or (and (member group gnus-zombie-list) - gnus-level-zombie) - gnus-level-killed) - (when (gnus-group-group-name) - (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb))) - (unless silent - (gnus-group-update-group group))) - (t (error "No such newsgroup: %s" group))) - (gnus-group-position-point))) - -(defun gnus-group-transpose-groups (n) - "Move the current newsgroup up N places. -If given a negative prefix, move down instead. The difference between -N and the number of steps taken is returned." - (interactive "p") - (unless (gnus-group-group-name) - (error "No group on current line")) - (gnus-group-kill-group 1) - (prog1 - (forward-line (- n)) - (gnus-group-yank-group) - (gnus-group-position-point))) - -(defun gnus-group-kill-all-zombies (&optional dummy) - "Kill all zombie newsgroups. -The optional DUMMY should always be nil." - (interactive (list (not (gnus-yes-or-no-p "Really kill all zombies? ")))) - (unless dummy - (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list)) - (setq gnus-zombie-list nil) - (gnus-dribble-touch) - (gnus-group-list-groups))) - -(defun gnus-group-kill-region (begin end) - "Kill newsgroups in current region (excluding current point). -The killed newsgroups can be yanked by using \\[gnus-group-yank-group]." - (interactive "r") - (let ((lines - ;; Count lines. - (save-excursion - (count-lines - (progn - (goto-char begin) - (beginning-of-line) - (point)) - (progn - (goto-char end) - (beginning-of-line) - (point)))))) - (goto-char begin) - (beginning-of-line) ;Important when LINES < 1 - (gnus-group-kill-group lines))) - -(defun gnus-group-kill-group (&optional n discard) - "Kill the next N groups. -The killed newsgroups can be yanked by using \\[gnus-group-yank-group]. -However, only groups that were alive can be yanked; already killed -groups or zombie groups can't be yanked. -The return value is the name of the group that was killed, or a list -of groups killed." - (interactive "P") - (let ((buffer-read-only nil) - (groups (gnus-group-process-prefix n)) - group entry level out) - (if (< (length groups) 10) - ;; This is faster when there are few groups. - (while groups - (push (setq group (pop groups)) out) - (gnus-group-remove-mark group) - (setq level (gnus-group-group-level)) - (gnus-delete-line) - (when (and (not discard) - (setq entry (gnus-gethash group gnus-newsrc-hashtb))) - (gnus-undo-register - `(progn - (gnus-group-goto-group ,(gnus-group-group-name)) - (gnus-group-yank-group))) - (push (cons (car entry) (nth 2 entry)) - gnus-list-of-killed-groups)) - (gnus-group-change-level - (if entry entry group) gnus-level-killed (if entry nil level)) - (message "Killed group %s" (gnus-group-decoded-name group))) - ;; If there are lots and lots of groups to be killed, we use - ;; this thing instead. - (dolist (group (nreverse groups)) - (gnus-group-remove-mark group) - (gnus-delete-line) - (push group gnus-killed-list) - (setq gnus-newsrc-alist - (delq (assoc group gnus-newsrc-alist) - gnus-newsrc-alist)) - (when gnus-group-change-level-function - (funcall gnus-group-change-level-function - group gnus-level-killed 3)) - (cond - ((setq entry (gnus-gethash group gnus-newsrc-hashtb)) - (push (cons (car entry) (nth 2 entry)) - gnus-list-of-killed-groups) - (setcdr (cdr entry) (cdddr entry))) - ((member group gnus-zombie-list) - (setq gnus-zombie-list (delete group gnus-zombie-list)))) - ;; There may be more than one instance displayed. - (while (gnus-group-goto-group group) - (gnus-delete-line))) - (gnus-make-hashtable-from-newsrc-alist)) - - (gnus-group-position-point) - (if (< (length out) 2) (car out) (nreverse out)))) - -(defun gnus-group-yank-group (&optional arg) - "Yank the last newsgroups killed with \\[gnus-group-kill-group], inserting it before the current newsgroup. -The numeric ARG specifies how many newsgroups are to be yanked. The -name of the newsgroup yanked is returned, or (if several groups are -yanked) a list of yanked groups is returned." - (interactive "p") - (setq arg (or arg 1)) - (let (info group prev out) - (while (>= (decf arg) 0) - (when (not (setq info (pop gnus-list-of-killed-groups))) - (error "No more newsgroups to yank")) - (push (setq group (nth 1 info)) out) - ;; Find which newsgroup to insert this one before - search - ;; backward until something suitable is found. If there are no - ;; other newsgroups in this buffer, just make this newsgroup the - ;; first newsgroup. - (setq prev (gnus-group-group-name)) - (gnus-group-change-level - info (gnus-info-level (cdr info)) gnus-level-killed - (and prev (gnus-gethash prev gnus-newsrc-hashtb)) - t) - (gnus-group-insert-group-line-info group) - (gnus-undo-register - `(when (gnus-group-goto-group ,group) - (gnus-group-kill-group 1)))) - (forward-line -1) - (gnus-group-position-point) - (if (< (length out) 2) (car out) (nreverse out)))) - -(defun gnus-group-kill-level (level) - "Kill all groups that is on a certain LEVEL." - (interactive "nKill all groups on level: ") - (cond - ((= level gnus-level-zombie) - (setq gnus-killed-list - (nconc gnus-zombie-list gnus-killed-list)) - (setq gnus-zombie-list nil)) - ((and (< level gnus-level-zombie) - (> level 0) - (or gnus-expert-user - (gnus-yes-or-no-p - (format - "Do you really want to kill all groups on level %d? " - level)))) - (let* ((prev gnus-newsrc-alist) - (alist (cdr prev))) - (while alist - (if (= (gnus-info-level (car alist)) level) - (progn - (push (gnus-info-group (car alist)) gnus-killed-list) - (setcdr prev (cdr alist))) - (setq prev alist)) - (setq alist (cdr alist))) - (gnus-make-hashtable-from-newsrc-alist) - (gnus-group-list-groups))) - (t - (error "Can't kill; invalid level: %d" level)))) - -(defun gnus-group-list-all-groups (&optional arg) - "List all newsgroups with level ARG or lower. -Default is `gnus-level-unsubscribed', which lists all subscribed and most -unsubscribed groups." - (interactive "P") - (gnus-group-list-groups (or arg gnus-level-unsubscribed) t)) - -;; Redefine this to list ALL killed groups if prefix arg used. -;; Rewritten by engstrom@src.honeywell.com (Eric Engstrom). -(defun gnus-group-list-killed (&optional arg) - "List all killed newsgroups in the group buffer. -If ARG is non-nil, list ALL killed groups known to Gnus. This may -entail asking the server for the groups." - (interactive "P") - ;; Find all possible killed newsgroups if arg. - (when arg - (gnus-get-killed-groups)) - (if (not gnus-killed-list) - (gnus-message 6 "No killed groups") - (let (gnus-group-list-mode) - (funcall gnus-group-prepare-function - gnus-level-killed t gnus-level-killed)) - (goto-char (point-min))) - (gnus-group-position-point)) - -(defun gnus-group-list-zombies () - "List all zombie newsgroups in the group buffer." - (interactive) - (if (not gnus-zombie-list) - (gnus-message 6 "No zombie groups") - (let (gnus-group-list-mode) - (funcall gnus-group-prepare-function - gnus-level-zombie t gnus-level-zombie)) - (goto-char (point-min))) - (gnus-group-position-point)) - -(defun gnus-group-list-active () - "List all groups that are available from the server(s)." - (interactive) - ;; First we make sure that we have really read the active file. - (unless (gnus-read-active-file-p) - (let ((gnus-read-active-file t) - (gnus-agent gnus-plugged)); If we're actually plugged, store the active file in the agent. - (gnus-read-active-file))) - ;; Find all groups and sort them. - (let ((groups - (sort - (let (list) - (mapatoms - (lambda (sym) - (and (boundp sym) - (symbol-value sym) - (push (symbol-name sym) list))) - gnus-active-hashtb) - list) - 'string<)) - (buffer-read-only nil) - group) - (erase-buffer) - (while groups - (setq group (pop groups)) - (gnus-add-text-properties - (point) (prog1 (1+ (point)) - (insert " *: " - (gnus-group-decoded-name group) - "\n")) - (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) - 'gnus-unread t - 'gnus-level (inline (gnus-group-level group))))) - (goto-char (point-min)))) - -(defun gnus-activate-all-groups (level) - "Activate absolutely all groups." - (interactive (list gnus-level-unsubscribed)) - (let ((gnus-activate-level level) - (gnus-activate-foreign-newsgroups level)) - (gnus-group-get-new-news))) - -(defun gnus-group-get-new-news (&optional arg) - "Get newly arrived articles. -If ARG is a number, it specifies which levels you are interested in -re-scanning. If ARG is non-nil and not a number, this will force -\"hard\" re-reading of the active files from all servers." - (interactive "P") - (require 'nnmail) - (let ((gnus-inhibit-demon t) - ;; Binding this variable will inhibit multiple fetchings - ;; of the same mail source. - (nnmail-fetched-sources (list t))) - (gnus-run-hooks 'gnus-get-top-new-news-hook) - (gnus-run-hooks 'gnus-get-new-news-hook) - - ;; Read any slave files. - (unless gnus-slave - (gnus-master-read-slave-newsrc)) - - ;; We might read in new NoCeM messages here. - (when (and gnus-use-nocem - (or (and (numberp gnus-use-nocem) - (numberp arg) - (>= arg gnus-use-nocem)) - (not arg))) - (gnus-nocem-scan-groups)) - ;; If ARG is not a number, then we read the active file. - (when (and arg (not (numberp arg))) - (let ((gnus-read-active-file t)) - (gnus-read-active-file)) - (setq arg nil) - - ;; If the user wants it, we scan for new groups. - (when (eq gnus-check-new-newsgroups 'always) - (gnus-find-new-newsgroups))) - - (setq arg (gnus-group-default-level arg t)) - (if (and gnus-read-active-file (not arg)) - (progn - (gnus-read-active-file) - (gnus-get-unread-articles arg)) - (let ((gnus-read-active-file (if arg nil gnus-read-active-file))) - (gnus-get-unread-articles arg))) - (gnus-run-hooks 'gnus-after-getting-new-news-hook) - (gnus-group-list-groups (and (numberp arg) - (max (car gnus-group-list-mode) arg))))) - -(defun gnus-group-get-new-news-this-group (&optional n dont-scan) - "Check for newly arrived news in the current group (and the N-1 next groups). -The difference between N and the number of newsgroup checked is returned. -If N is negative, this group and the N-1 previous groups will be checked. -If DONT-SCAN is non-nil, scan non-activated groups as well." - (interactive "P") - (let* ((groups (gnus-group-process-prefix n)) - (ret (if (numberp n) (- n (length groups)) 0)) - (beg (unless n - (point))) - group method - (gnus-inhibit-demon t) - ;; Binding this variable will inhibit multiple fetchings - ;; of the same mail source. - (nnmail-fetched-sources (list t))) - (gnus-run-hooks 'gnus-get-new-news-hook) - (while (setq group (pop groups)) - (gnus-group-remove-mark group) - ;; Bypass any previous denials from the server. - (gnus-remove-denial (setq method (gnus-find-method-for-group group))) - (if (gnus-activate-group group (if dont-scan nil 'scan)) - (progn - (gnus-get-unread-articles-in-group - (gnus-get-info group) (gnus-active group) t) - (unless (gnus-virtual-group-p group) - (gnus-close-group group)) - (when gnus-agent - (gnus-agent-save-group-info - method (gnus-group-real-name group) (gnus-active group))) - (gnus-group-update-group group)) - (if (eq (gnus-server-status (gnus-find-method-for-group group)) - 'denied) - (gnus-error 3 "Server denied access") - (gnus-error 3 "%s error: %s" group (gnus-status-message group))))) - (when beg - (goto-char beg)) - (when gnus-goto-next-group-when-activating - (gnus-group-next-unread-group 1 t)) - (gnus-summary-position-point) - ret)) - -(defun gnus-group-fetch-faq (group &optional faq-dir) - "Fetch the FAQ for the current group. -If given a prefix argument, prompt for the FAQ dir -to use." - (interactive - (list - (gnus-group-group-name) - (when current-prefix-arg - (completing-read - "FAQ dir: " (and (listp gnus-group-faq-directory) - (mapcar #'list - gnus-group-faq-directory)))))) - (unless group - (error "No group name given")) - (let ((dirs (or faq-dir gnus-group-faq-directory)) - dir found file) - (unless (listp dirs) - (setq dirs (list dirs))) - (while (and (not found) - (setq dir (pop dirs))) - (let ((name (gnus-group-real-name group))) - (setq file (expand-file-name name dir))) - (if (not (file-exists-p file)) - (gnus-message 1 "No such file: %s" file) - (let ((enable-local-variables nil)) - (find-file file) - (setq found t)))))) - -(defun gnus-group-fetch-charter (group) - "Fetch the charter for the current group. -If given a prefix argument, prompt for a group." - (interactive - (list (or (when current-prefix-arg - (completing-read "Group: " gnus-active-hashtb)) - (gnus-group-group-name) - gnus-newsgroup-name))) - (unless group - (error "No group name given")) - (require 'mm-url) - (condition-case nil (require 'url-http) (error nil)) - (let ((name (mm-url-form-encode-xwfu (gnus-group-real-name group))) - url hierarchy) - (when (string-match "\\(^[^\\.]+\\)\\..*" name) - (setq hierarchy (match-string 1 name)) - (if (and (setq url (cdr (assoc hierarchy gnus-group-charter-alist))) - (if (fboundp 'url-http-file-exists-p) - (url-http-file-exists-p (eval url)) - t)) - (browse-url (eval url)) - (setq url (concat "http://" hierarchy - ".news-admin.org/charters/" name)) - (if (and (fboundp 'url-http-file-exists-p) - (url-http-file-exists-p url)) - (browse-url url) - (gnus-group-fetch-control group)))))) - -(defun gnus-group-fetch-control (group) - "Fetch the archived control messages for the current group. -If given a prefix argument, prompt for a group." - (interactive - (list (or (when current-prefix-arg - (completing-read "Group: " gnus-active-hashtb)) - (gnus-group-group-name) - gnus-newsgroup-name))) - (unless group - (error "No group name given")) - (let ((name (gnus-group-real-name group)) - hierarchy) - (when (string-match "\\(^[^\\.]+\\)\\..*" name) - (setq hierarchy (match-string 1 name)) - (if gnus-group-fetch-control-use-browse-url - (browse-url (concat "ftp://ftp.isc.org/usenet/control/" - hierarchy "/" name ".gz")) - (let ((enable-local-variables nil)) - (gnus-group-read-ephemeral-group - group - `(nndoc ,group (nndoc-address - ,(find-file-noselect - (concat "/ftp@ftp.isc.org:/usenet/control/" - hierarchy "/" name ".gz"))) - (nndoc-article-type mbox)) t nil nil)))))) - -(defun gnus-group-describe-group (force &optional group) - "Display a description of the current newsgroup." - (interactive (list current-prefix-arg (gnus-group-group-name))) - (let* ((method (gnus-find-method-for-group group)) - (mname (gnus-group-prefixed-name "" method)) - desc) - (when (and force - gnus-description-hashtb) - (gnus-sethash mname nil gnus-description-hashtb)) - (unless group - (error "No group name given")) - (when (or (and gnus-description-hashtb - ;; We check whether this group's method has been - ;; queried for a description file. - (gnus-gethash mname gnus-description-hashtb)) - (setq desc (gnus-group-get-description group)) - (gnus-read-descriptions-file method)) - (gnus-message 1 - (or desc (gnus-gethash group gnus-description-hashtb) - "No description available"))))) - -;; Suggested by Per Abrahamsen . -(defun gnus-group-describe-all-groups (&optional force) - "Pop up a buffer with descriptions of all newsgroups." - (interactive "P") - (when force - (setq gnus-description-hashtb nil)) - (when (not (or gnus-description-hashtb - (gnus-read-all-descriptions-files))) - (error "Couldn't request descriptions file")) - (let ((buffer-read-only nil) - b) - (erase-buffer) - (mapatoms - (lambda (group) - (setq b (point)) - (let ((charset (gnus-group-name-charset nil (symbol-name group)))) - (insert (format " *: %-20s %s\n" - (gnus-group-name-decode - (symbol-name group) charset) - (gnus-group-name-decode - (symbol-value group) charset)))) - (gnus-add-text-properties - b (1+ b) (list 'gnus-group group - 'gnus-unread t 'gnus-marked nil - 'gnus-level (1+ gnus-level-subscribed)))) - gnus-description-hashtb) - (goto-char (point-min)) - (gnus-group-position-point))) - -;; Suggested by Daniel Quinlan . -(defun gnus-group-apropos (regexp &optional search-description) - "List all newsgroups that have names that match a regexp." - (interactive "sGnus apropos (regexp): ") - (let ((prev "") - (obuf (current-buffer)) - groups des) - ;; Go through all newsgroups that are known to Gnus. - (mapatoms - (lambda (group) - (and (symbol-name group) - (string-match regexp (symbol-name group)) - (symbol-value group) - (push (symbol-name group) groups))) - gnus-active-hashtb) - ;; Also go through all descriptions that are known to Gnus. - (when search-description - (mapatoms - (lambda (group) - (and (string-match regexp (symbol-value group)) - (push (symbol-name group) groups))) - gnus-description-hashtb)) - (if (not groups) - (gnus-message 3 "No groups matched \"%s\"." regexp) - ;; Print out all the groups. - (save-excursion - (pop-to-buffer "*Gnus Help*") - (buffer-disable-undo) - (erase-buffer) - (setq groups (sort groups 'string<)) - (while groups - ;; Groups may be entered twice into the list of groups. - (when (not (string= (car groups) prev)) - (setq prev (car groups)) - (let ((charset (gnus-group-name-charset nil prev))) - (insert (gnus-group-name-decode prev charset) "\n") - (when (and gnus-description-hashtb - (setq des (gnus-gethash (car groups) - gnus-description-hashtb))) - (insert " " (gnus-group-name-decode des charset) "\n")))) - (setq groups (cdr groups))) - (goto-char (point-min)))) - (pop-to-buffer obuf))) - -(defun gnus-group-description-apropos (regexp) - "List all newsgroups that have names or descriptions that match REGEXP." - (interactive "sGnus description apropos (regexp): ") - (when (not (or gnus-description-hashtb - (gnus-read-all-descriptions-files))) - (error "Couldn't request descriptions file")) - (gnus-group-apropos regexp t)) - -;; Suggested by Per Abrahamsen . -(defun gnus-group-list-matching (level regexp &optional all lowest) - "List all groups with unread articles that match REGEXP. -If the prefix LEVEL is non-nil, it should be a number that says which -level to cut off listing groups. -If ALL, also list groups with no unread articles. -If LOWEST, don't list groups with level lower than LOWEST. - -This command may read the active file." - (interactive "P\nsList newsgroups matching: ") - ;; First make sure active file has been read. - (when (and level - (> (prefix-numeric-value level) gnus-level-killed)) - (gnus-get-killed-groups)) - (funcall gnus-group-prepare-function - (or level gnus-level-subscribed) (and all t) (or lowest 1) regexp) - (goto-char (point-min)) - (gnus-group-position-point)) - -(defun gnus-group-list-all-matching (level regexp &optional lowest) - "List all groups that match REGEXP. -If the prefix LEVEL is non-nil, it should be a number that says which -level to cut off listing groups. -If LOWEST, don't list groups with level lower than LOWEST." - (interactive "P\nsList newsgroups matching: ") - (when level - (setq level (prefix-numeric-value level))) - (gnus-group-list-matching (or level gnus-level-killed) regexp t lowest)) - -;; Suggested by Jack Vinson . -(defun gnus-group-save-newsrc (&optional force) - "Save the Gnus startup files. -If FORCE, force saving whether it is necessary or not." - (interactive "P") - (gnus-save-newsrc-file force)) - -(defun gnus-group-restart (&optional arg) - "Force Gnus to read the .newsrc file." - (interactive "P") - (when (gnus-yes-or-no-p - (format "Are you sure you want to restart Gnus? ")) - (gnus-save-newsrc-file) - (gnus-clear-system) - (gnus))) - -(defun gnus-group-read-init-file () - "Read the Gnus elisp init file." - (interactive) - (gnus-read-init-file) - (gnus-message 5 "Read %s" gnus-init-file)) - -(defun gnus-group-check-bogus-groups (&optional silent) - "Check bogus newsgroups. -If given a prefix, don't ask for confirmation before removing a bogus -group." - (interactive "P") - (gnus-check-bogus-newsgroups (and (not silent) (not gnus-expert-user))) - (gnus-group-list-groups)) - -(defun gnus-group-find-new-groups (&optional arg) - "Search for new groups and add them. -Each new group will be treated with `gnus-subscribe-newsgroup-method'. -With 1 C-u, use the `ask-server' method to query the server for new -groups. -With 2 C-u's, use most complete method possible to query the server -for new groups, and subscribe the new groups as zombies." - (interactive "p") - (gnus-find-new-newsgroups (or arg 1)) - (gnus-group-list-groups)) - -(defun gnus-group-edit-global-kill (&optional article group) - "Edit the global kill file. -If GROUP, edit that local kill file instead." - (interactive "P") - (setq gnus-current-kill-article article) - (gnus-kill-file-edit-file group) - (gnus-message - 6 - (substitute-command-keys - (format "Editing a %s kill file (Type \\[gnus-kill-file-exit] to exit)" - (if group "local" "global"))))) - -(defun gnus-group-edit-local-kill (article group) - "Edit a local kill file." - (interactive (list nil (gnus-group-group-name))) - (gnus-group-edit-global-kill article group)) - -(defun gnus-group-force-update () - "Update `.newsrc' file." - (interactive) - (gnus-save-newsrc-file)) - -(defvar gnus-backlog-articles) - -(defun gnus-group-suspend () - "Suspend the current Gnus session. -In fact, cleanup buffers except for group mode buffer. -The hook `gnus-suspend-gnus-hook' is called before actually suspending." - (interactive) - (gnus-run-hooks 'gnus-suspend-gnus-hook) - (gnus-offer-save-summaries) - ;; Kill Gnus buffers except for group mode buffer. - (let ((group-buf (get-buffer gnus-group-buffer))) - (mapcar (lambda (buf) - (unless (or (member buf (list group-buf gnus-dribble-buffer)) - (progn - (save-excursion - (set-buffer buf) - (eq major-mode 'message-mode)))) - (gnus-kill-buffer buf))) - (gnus-buffers)) - (setq gnus-backlog-articles nil) - (gnus-kill-gnus-frames) - (when group-buf - (bury-buffer group-buf) - (delete-windows-on group-buf t)))) - -(defun gnus-group-clear-dribble () - "Clear all information from the dribble buffer." - (interactive) - (gnus-dribble-clear) - (gnus-message 7 "Cleared dribble buffer")) - -(defun gnus-group-exit () - "Quit reading news after updating .newsrc.eld and .newsrc. -The hook `gnus-exit-gnus-hook' is called before actually exiting." - (interactive) - (when - (or noninteractive ;For gnus-batch-kill - (not gnus-interactive-exit) ;Without confirmation - gnus-expert-user - (gnus-y-or-n-p "Are you sure you want to quit reading news? ")) - (gnus-run-hooks 'gnus-exit-gnus-hook) - ;; Offer to save data from non-quitted summary buffers. - (gnus-offer-save-summaries) - ;; Save the newsrc file(s). - (gnus-save-newsrc-file) - ;; Kill-em-all. - (gnus-close-backends) - ;; Reset everything. - (gnus-clear-system) - ;; Allow the user to do things after cleaning up. - (gnus-run-hooks 'gnus-after-exiting-gnus-hook))) - -(defun gnus-group-quit () - "Quit reading news without updating .newsrc.eld or .newsrc. -The hook `gnus-exit-gnus-hook' is called before actually exiting." - (interactive) - (when (or noninteractive ;For gnus-batch-kill - (zerop (buffer-size)) - (not (gnus-server-opened gnus-select-method)) - gnus-expert-user - (not gnus-current-startup-file) - (gnus-yes-or-no-p - (format "Quit reading news without saving %s? " - (file-name-nondirectory gnus-current-startup-file)))) - (gnus-run-hooks 'gnus-exit-gnus-hook) - (gnus-configure-windows 'group t) - (when (and (gnus-buffer-live-p gnus-dribble-buffer) - (not (zerop (save-excursion - (set-buffer gnus-dribble-buffer) - (buffer-size))))) - (gnus-dribble-enter - ";;; Gnus was exited on purpose without saving the .newsrc files.")) - (gnus-dribble-save) - (gnus-close-backends) - (gnus-clear-system) - (gnus-kill-buffer gnus-group-buffer) - ;; Allow the user to do things after cleaning up. - (gnus-run-hooks 'gnus-after-exiting-gnus-hook))) - -(defun gnus-group-describe-briefly () - "Give a one line description of the group mode commands." - (interactive) - (gnus-message 7 (substitute-command-keys "\\\\[gnus-group-read-group]:Select \\[gnus-group-next-unread-group]:Forward \\[gnus-group-prev-unread-group]:Backward \\[gnus-group-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-group-describe-briefly]:This help"))) - -(defun gnus-group-browse-foreign-server (method) - "Browse a foreign news server. -If called interactively, this function will ask for a select method - (nntp, nnspool, etc.) and a server address (eg. nntp.some.where). -If not, METHOD should be a list where the first element is the method -and the second element is the address." - (interactive - (list (let ((how (completing-read - "Which back end: " - (append gnus-valid-select-methods gnus-server-alist) - nil t (cons "nntp" 0) 'gnus-method-history))) - ;; We either got a back end name or a virtual server name. - ;; If the first, we also need an address. - (if (assoc how gnus-valid-select-methods) - (list (intern how) - ;; Suggested by mapjph@bath.ac.uk. - (completing-read - "Address: " - (mapcar (lambda (server) (list server)) - gnus-secondary-servers))) - ;; We got a server name. - how)))) - (gnus-browse-foreign-server method)) - -(defun gnus-group-set-info (info &optional method-only-group part) - (when (or info part) - (let* ((entry (gnus-gethash - (or method-only-group (gnus-info-group info)) - gnus-newsrc-hashtb)) - (part-info info) - (info (if method-only-group (nth 2 entry) info)) - method) - (when method-only-group - (unless entry - (error "Trying to change non-existent group %s" method-only-group)) - ;; We have received parts of the actual group info - either the - ;; select method or the group parameters. We first check - ;; whether we have to extend the info, and if so, do that. - (let ((len (length info)) - (total (if (eq part 'method) 5 6))) - (when (< len total) - (setcdr (nthcdr (1- len) info) - (make-list (- total len) nil))) - ;; Then we enter the new info. - (setcar (nthcdr (1- total) info) part-info))) - (unless entry - ;; This is a new group, so we just create it. - (save-excursion - (set-buffer gnus-group-buffer) - (setq method (gnus-info-method info)) - (when (gnus-server-equal method "native") - (setq method nil)) - (save-excursion - (set-buffer gnus-group-buffer) - (if method - ;; It's a foreign group... - (gnus-group-make-group - (gnus-group-real-name (gnus-info-group info)) - (if (stringp method) method - (prin1-to-string (car method))) - (and (consp method) - (nth 1 (gnus-info-method info)))) - ;; It's a native group. - (gnus-group-make-group (gnus-info-group info)))) - (gnus-message 6 "Note: New group created") - (setq entry - (gnus-gethash (gnus-group-prefixed-name - (gnus-group-real-name (gnus-info-group info)) - (or (gnus-info-method info) gnus-select-method)) - gnus-newsrc-hashtb)))) - ;; Whether it was a new group or not, we now have the entry, so we - ;; can do the update. - (if entry - (progn - (setcar (nthcdr 2 entry) info) - (when (and (not (eq (car entry) t)) - (gnus-active (gnus-info-group info))) - (setcar entry (length - (gnus-list-of-unread-articles (car info)))))) - (error "No such group: %s" (gnus-info-group info)))))) - -(defun gnus-group-set-method-info (group select-method) - (gnus-group-set-info select-method group 'method)) - -(defun gnus-group-set-params-info (group params) - (gnus-group-set-info params group 'params)) - -(defun gnus-add-marked-articles (group type articles &optional info force) - ;; Add ARTICLES of TYPE to the info of GROUP. - ;; If INFO is non-nil, use that info. If FORCE is non-nil, don't - ;; add, but replace marked articles of TYPE with ARTICLES. - (let ((info (or info (gnus-get-info group))) - marked m) - (or (not info) - (and (not (setq marked (nthcdr 3 info))) - (or (null articles) - (setcdr (nthcdr 2 info) - (list (list (cons type (gnus-compress-sequence - articles t))))))) - (and (not (setq m (assq type (car marked)))) - (or (null articles) - (setcar marked - (cons (cons type (gnus-compress-sequence articles t) ) - (car marked))))) - (if force - (if (null articles) - (setcar (nthcdr 3 info) - (gnus-delete-alist type (car marked))) - (setcdr m (gnus-compress-sequence articles t))) - (setcdr m (gnus-compress-sequence - (sort (nconc (gnus-uncompress-range (cdr m)) - (copy-sequence articles)) '<) t)))))) - -(defun gnus-add-mark (group mark article) - "Mark ARTICLE in GROUP with MARK, whether the group is displayed or not." - (let ((buffer (gnus-summary-buffer-name group))) - (if (gnus-buffer-live-p buffer) - (save-excursion - (set-buffer (get-buffer buffer)) - (gnus-summary-add-mark article mark)) - (gnus-add-marked-articles group (cdr (assq mark gnus-article-mark-lists)) - (list article))))) - -;;; -;;; Group timestamps -;;; - -(defun gnus-group-set-timestamp () - "Change the timestamp of the current group to the current time. -This function can be used in hooks like `gnus-select-group-hook' -or `gnus-group-catchup-group-hook'." - (when gnus-newsgroup-name - (let ((time (current-time))) - (setcdr (cdr time) nil) - (gnus-group-set-parameter gnus-newsgroup-name 'timestamp time)))) - -(defsubst gnus-group-timestamp (group) - "Return the timestamp for GROUP." - (gnus-group-get-parameter group 'timestamp t)) - -(defun gnus-group-timestamp-delta (group) - "Return the offset in seconds from the timestamp for GROUP to the current time, as a floating point number." - (let* ((time (or (gnus-group-timestamp group) - (list 0 0))) - (delta (subtract-time (current-time) time))) - (+ (* (nth 0 delta) 65536.0) - (nth 1 delta)))) - -(defun gnus-group-timestamp-string (group) - "Return a string of the timestamp for GROUP." - (let ((time (gnus-group-timestamp group))) - (if (not time) - "" - (gnus-time-iso8601 time)))) - -(defun gnus-group-list-cached (level &optional lowest) - "List all groups with cached articles. -If the prefix LEVEL is non-nil, it should be a number that says which -level to cut off listing groups. -If LOWEST, don't list groups with level lower than LOWEST. - -This command may read the active file." - (interactive "P") - (when level - (setq level (prefix-numeric-value level))) - (when (or (not level) (>= level gnus-level-zombie)) - (gnus-cache-open)) - (funcall gnus-group-prepare-function - (or level gnus-level-subscribed) - #'(lambda (info) - (let ((marks (gnus-info-marks info))) - (assq 'cache marks))) - lowest - #'(lambda (group) - (or (gnus-gethash group - gnus-cache-active-hashtb) - ;; Cache active file might use "." - ;; instead of ":". - (gnus-gethash - (mapconcat 'identity - (split-string group ":") - ".") - gnus-cache-active-hashtb)))) - (goto-char (point-min)) - (gnus-group-position-point)) - -(defun gnus-group-list-dormant (level &optional lowest) - "List all groups with dormant articles. -If the prefix LEVEL is non-nil, it should be a number that says which -level to cut off listing groups. -If LOWEST, don't list groups with level lower than LOWEST. - -This command may read the active file." - (interactive "P") - (when level - (setq level (prefix-numeric-value level))) - (when (or (not level) (>= level gnus-level-zombie)) - (gnus-cache-open)) - (funcall gnus-group-prepare-function - (or level gnus-level-subscribed) - #'(lambda (info) - (let ((marks (gnus-info-marks info))) - (assq 'dormant marks))) - lowest - 'ignore) - (goto-char (point-min)) - (gnus-group-position-point)) - -(defun gnus-group-listed-groups () - "Return a list of listed groups." - (let (point groups) - (goto-char (point-min)) - (while (setq point (text-property-not-all (point) (point-max) - 'gnus-group nil)) - (goto-char point) - (push (symbol-name (get-text-property point 'gnus-group)) groups) - (forward-char 1)) - groups)) - -(defun gnus-group-list-plus (&optional args) - "List groups plus the current selection." - (interactive "P") - (let ((gnus-group-listed-groups (gnus-group-listed-groups)) - (gnus-group-list-mode gnus-group-list-mode) ;; Save it. - func) - (push last-command-event unread-command-events) - (if (featurep 'xemacs) - (push (make-event 'key-press '(key ?A)) unread-command-events) - (push ?A unread-command-events)) - (let (gnus-pick-mode keys) - (setq keys (if (featurep 'xemacs) - (events-to-keys (read-key-sequence nil)) - (read-key-sequence nil))) - (setq func (lookup-key (current-local-map) keys))) - (if (or (not func) - (numberp func)) - (ding) - (call-interactively func)))) - -(defun gnus-group-list-flush (&optional args) - "Flush groups from the current selection." - (interactive "P") - (let ((gnus-group-list-option 'flush)) - (gnus-group-list-plus args))) - -(defun gnus-group-list-limit (&optional args) - "List groups limited within the current selection." - (interactive "P") - (let ((gnus-group-list-option 'limit)) - (gnus-group-list-plus args))) - -(defun gnus-group-mark-article-read (group article) - "Mark ARTICLE read." - (let ((buffer (gnus-summary-buffer-name group)) - (mark gnus-read-mark) - active n) - (if (get-buffer buffer) - (with-current-buffer buffer - (setq active gnus-newsgroup-active) - (gnus-activate-group group) - (when gnus-newsgroup-prepared - (when (and gnus-newsgroup-auto-expire - (memq mark gnus-auto-expirable-marks)) - (setq mark gnus-expirable-mark)) - (setq mark (gnus-request-update-mark - group article mark)) - (gnus-mark-article-as-read article mark) - (setq gnus-newsgroup-active (gnus-active group)) - (when active - (setq n (1+ (cdr active))) - (while (<= n (cdr gnus-newsgroup-active)) - (unless (eq n article) - (push n gnus-newsgroup-unselected)) - (setq n (1+ n))) - (setq gnus-newsgroup-unselected - (nreverse gnus-newsgroup-unselected))))) - (gnus-activate-group group) - (gnus-group-make-articles-read group (list article)) - (when (gnus-group-auto-expirable-p group) - (gnus-add-marked-articles - group 'expire (list article)))))) - -(provide 'gnus-group) - -;;; arch-tag: 2eb5440f-0bca-4091-814c-e37817536af6 -;;; gnus-group.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-int.el b/xemacs-packages/gnus/lisp/gnus-int.el deleted file mode 100644 index 8ab628ed..00000000 --- a/xemacs-packages/gnus/lisp/gnus-int.el +++ /dev/null @@ -1,698 +0,0 @@ -;;; gnus-int.el --- backend interface functions for Gnus - -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) -(require 'message) -(require 'gnus-range) - -(autoload 'gnus-agent-expire "gnus-agent") -(autoload 'gnus-agent-regenerate-group "gnus-agent") -(autoload 'gnus-agent-read-servers-validate-native "gnus-agent") - -(defcustom gnus-open-server-hook nil - "Hook called just before opening connection to the news server." - :group 'gnus-start - :type 'hook) - -(defcustom gnus-server-unopen-status nil - "The default status if the server is not able to open. -If the server is covered by Gnus agent, the possible values are -`denied', set the server denied; `offline', set the server offline; -nil, ask user. If the server is not covered by Gnus agent, set the -server denied." - :version "22.1" - :group 'gnus-start - :type '(choice (const :tag "Ask" nil) - (const :tag "Deny server" denied) - (const :tag "Unplug Agent" offline))) - -(defvar gnus-internal-registry-spool-current-method nil - "The current method, for the registry.") - -;;; -;;; Server Communication -;;; - -(defun gnus-start-news-server (&optional confirm) - "Open a method for getting news. -If CONFIRM is non-nil, the user will be asked for an NNTP server." - (let (how) - (if gnus-current-select-method - ;; Stream is already opened. - nil - ;; Open NNTP server. - (unless gnus-nntp-service - (setq gnus-nntp-server nil)) - (when confirm - ;; Read server name with completion. - (setq gnus-nntp-server - (completing-read "NNTP server: " - (mapcar (lambda (server) (list server)) - (cons (list gnus-nntp-server) - gnus-secondary-servers)) - nil nil gnus-nntp-server))) - - (when (and gnus-nntp-server - (stringp gnus-nntp-server) - (not (string= gnus-nntp-server ""))) - (setq gnus-select-method - (cond ((or (string= gnus-nntp-server "") - (string= gnus-nntp-server "::")) - (list 'nnspool (system-name))) - ((string-match "^:" gnus-nntp-server) - (list 'nnmh gnus-nntp-server - (list 'nnmh-directory - (file-name-as-directory - (expand-file-name - (substring gnus-nntp-server 1) "~/"))) - (list 'nnmh-get-new-mail nil))) - (t - (list 'nntp gnus-nntp-server))))) - - (setq how (car gnus-select-method)) - (cond - ((eq how 'nnspool) - (require 'nnspool) - (gnus-message 5 "Looking up local news spool...")) - ((eq how 'nnmh) - (require 'nnmh) - (gnus-message 5 "Looking up mh spool...")) - (t - (require 'nntp))) - (setq gnus-current-select-method gnus-select-method) - (gnus-run-hooks 'gnus-open-server-hook) - - ;; Partially validate agent covered methods now that the - ;; gnus-select-method is known. - - (if gnus-agent - ;; NOTE: This is here for one purpose only. By validating - ;; the current select method, it converts the old 5.10.3, - ;; and earlier, format to the current format. That enables - ;; the agent code within gnus-open-server to function - ;; correctly. - (gnus-agent-read-servers-validate-native gnus-select-method)) - - (or - ;; gnus-open-server-hook might have opened it - (gnus-server-opened gnus-select-method) - (gnus-open-server gnus-select-method) - gnus-batch-mode - (gnus-y-or-n-p - (format - "%s (%s) open error: '%s'. Continue? " - (car gnus-select-method) (cadr gnus-select-method) - (gnus-status-message gnus-select-method))) - (gnus-error 1 "Couldn't open server on %s" - (nth 1 gnus-select-method)))))) - -(defun gnus-check-group (group) - "Try to make sure that the server where GROUP exists is alive." - (let ((method (gnus-find-method-for-group group))) - (or (gnus-server-opened method) - (gnus-open-server method)))) - -(defun gnus-check-server (&optional method silent) - "Check whether the connection to METHOD is down. -If METHOD is nil, use `gnus-select-method'. -If it is down, start it up (again)." - (let ((method (or method gnus-select-method)) - result) - ;; Transform virtual server names into select methods. - (when (stringp method) - (setq method (gnus-server-to-method method))) - (if (gnus-server-opened method) - ;; The stream is already opened. - t - ;; Open the server. - (unless silent - (gnus-message 5 "Opening %s server%s..." (car method) - (if (equal (nth 1 method) "") "" - (format " on %s" (nth 1 method))))) - (gnus-run-hooks 'gnus-open-server-hook) - (prog1 - (condition-case () - (setq result (gnus-open-server method)) - (quit (message "Quit gnus-check-server") - nil)) - (unless silent - (gnus-message 5 "Opening %s server%s...%s" (car method) - (if (equal (nth 1 method) "") "" - (format " on %s" (nth 1 method))) - (if result "done" "failed"))))))) - -(defun gnus-get-function (method function &optional noerror) - "Return a function symbol based on METHOD and FUNCTION." - ;; Translate server names into methods. - (unless method - (error "Attempted use of a nil select method")) - (when (stringp method) - (setq method (gnus-server-to-method method))) - ;; Check cache of constructed names. - (let* ((method-sym (if gnus-agent - (inline (gnus-agent-get-function method)) - (car method))) - (method-fns (get method-sym 'gnus-method-functions)) - (func (let ((method-fnlist-elt (assq function method-fns))) - (unless method-fnlist-elt - (setq method-fnlist-elt - (cons function - (intern (format "%s-%s" method-sym function)))) - (put method-sym 'gnus-method-functions - (cons method-fnlist-elt method-fns))) - (cdr method-fnlist-elt)))) - ;; Maybe complain if there is no function. - (unless (fboundp func) - (unless (car method) - (error "Trying to require a method that doesn't exist")) - (require (car method)) - (when (not (fboundp func)) - (if noerror - (setq func nil) - (error "No such function: %s" func)))) - func)) - - -;;; -;;; Interface functions to the backends. -;;; - -(defun gnus-open-server (gnus-command-method) - "Open a connection to GNUS-COMMAND-METHOD." - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (let ((elem (assoc gnus-command-method gnus-opened-servers))) - ;; If this method was previously denied, we just return nil. - (if (eq (nth 1 elem) 'denied) - (progn - (gnus-message 1 "Denied server") - nil) - ;; Open the server. - (let* ((open-server-function (gnus-get-function gnus-command-method 'open-server)) - (result - (condition-case err - (funcall open-server-function - (nth 1 gnus-command-method) - (nthcdr 2 gnus-command-method)) - (error - (gnus-message 1 (format - "Unable to open server due to: %s" - (error-message-string err))) - nil) - (quit - (gnus-message 1 "Quit trying to open server") - nil))) - open-offline) - ;; If this hasn't been opened before, we add it to the list. - (unless elem - (setq elem (list gnus-command-method nil) - gnus-opened-servers (cons elem gnus-opened-servers))) - ;; Set the status of this server. - (setcar (cdr elem) - (cond (result - (if (eq open-server-function #'nnagent-open-server) - ;; The agent's backend has a "special" status - 'offline - 'ok)) - ((and gnus-agent - (gnus-agent-method-p gnus-command-method)) - (cond (gnus-server-unopen-status - ;; Set the server's status to the unopen - ;; status. If that status is offline, - ;; recurse to open the agent's backend. - (setq open-offline (eq gnus-server-unopen-status 'offline)) - gnus-server-unopen-status) - ((and - (not gnus-batch-mode) - (gnus-y-or-n-p - (format "Unable to open %s:%s, go offline? " - (car gnus-command-method) - (cadr gnus-command-method)))) - (setq open-offline t) - 'offline) - (t - ;; This agentized server was still denied - 'denied))) - (t - ;; This unagentized server must be denied - 'denied))) - - ;; NOTE: I MUST set the server's status to offline before this - ;; recursive call as this status will drive the - ;; gnus-get-function (called above) to return the agent's - ;; backend. - (if open-offline - ;; Recursively open this offline server to perform the - ;; open-server function of the agent's backend. - (let ((gnus-server-unopen-status 'denied)) - ;; Bind gnus-server-unopen-status to avoid recursively - ;; prompting with "go offline?". This is only a concern - ;; when the agent's backend fails to open the server. - (gnus-open-server gnus-command-method)) - result))))) - -(defun gnus-close-server (gnus-command-method) - "Close the connection to GNUS-COMMAND-METHOD." - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (funcall (gnus-get-function gnus-command-method 'close-server) - (nth 1 gnus-command-method))) - -(defun gnus-request-list (gnus-command-method) - "Request the active file from GNUS-COMMAND-METHOD." - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (funcall (gnus-get-function gnus-command-method 'request-list) - (nth 1 gnus-command-method))) - -(defun gnus-request-list-newsgroups (gnus-command-method) - "Request the newsgroups file from GNUS-COMMAND-METHOD." - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (funcall (gnus-get-function gnus-command-method 'request-list-newsgroups) - (nth 1 gnus-command-method))) - -(defun gnus-request-newgroups (date gnus-command-method) - "Request all new groups since DATE from GNUS-COMMAND-METHOD." - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (let ((func (gnus-get-function gnus-command-method 'request-newgroups t))) - (when func - (funcall func date (nth 1 gnus-command-method))))) - -(defun gnus-server-opened (gnus-command-method) - "Check whether a connection to GNUS-COMMAND-METHOD has been opened." - (unless (eq (gnus-server-status gnus-command-method) - 'denied) - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (funcall (inline (gnus-get-function gnus-command-method 'server-opened)) - (nth 1 gnus-command-method)))) - -(defun gnus-status-message (gnus-command-method) - "Return the status message from GNUS-COMMAND-METHOD. -If GNUS-COMMAND-METHOD is a string, it is interpreted as a group -name. The method this group uses will be queried." - (let ((gnus-command-method - (if (stringp gnus-command-method) - (gnus-find-method-for-group gnus-command-method) - gnus-command-method))) - (funcall (gnus-get-function gnus-command-method 'status-message) - (nth 1 gnus-command-method)))) - -(defun gnus-request-regenerate (gnus-command-method) - "Request a data generation from GNUS-COMMAND-METHOD." - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (funcall (gnus-get-function gnus-command-method 'request-regenerate) - (nth 1 gnus-command-method))) - -(defun gnus-request-group (group &optional dont-check gnus-command-method) - "Request GROUP. If DONT-CHECK, no information is required." - (let ((gnus-command-method - (or gnus-command-method (inline (gnus-find-method-for-group group))))) - (when (stringp gnus-command-method) - (setq gnus-command-method - (inline (gnus-server-to-method gnus-command-method)))) - (funcall (inline (gnus-get-function gnus-command-method 'request-group)) - (gnus-group-real-name group) (nth 1 gnus-command-method) - dont-check))) - -(defun gnus-list-active-group (group) - "Request active information on GROUP." - (let ((gnus-command-method (gnus-find-method-for-group group)) - (func 'list-active-group)) - (when (gnus-check-backend-function func group) - (funcall (gnus-get-function gnus-command-method func) - (gnus-group-real-name group) (nth 1 gnus-command-method))))) - -(defun gnus-request-group-description (group) - "Request a description of GROUP." - (let ((gnus-command-method (gnus-find-method-for-group group)) - (func 'request-group-description)) - (when (gnus-check-backend-function func group) - (funcall (gnus-get-function gnus-command-method func) - (gnus-group-real-name group) (nth 1 gnus-command-method))))) - -(defun gnus-request-group-articles (group) - "Request a list of existing articles in GROUP." - (let ((gnus-command-method (gnus-find-method-for-group group)) - (func 'request-group-articles)) - (when (gnus-check-backend-function func group) - (funcall (gnus-get-function gnus-command-method func) - (gnus-group-real-name group) (nth 1 gnus-command-method))))) - -(defun gnus-close-group (group) - "Request the GROUP be closed." - (let ((gnus-command-method (inline (gnus-find-method-for-group group)))) - (funcall (gnus-get-function gnus-command-method 'close-group) - (gnus-group-real-name group) (nth 1 gnus-command-method)))) - -(defun gnus-retrieve-headers (articles group &optional fetch-old) - "Request headers for ARTICLES in GROUP. -If FETCH-OLD, retrieve all headers (or some subset thereof) in the group." - (let ((gnus-command-method (gnus-find-method-for-group group))) - (cond - ((and gnus-use-cache (numberp (car articles))) - (gnus-cache-retrieve-headers articles group fetch-old)) - ((and gnus-agent (gnus-online gnus-command-method) - (gnus-agent-method-p gnus-command-method)) - (gnus-agent-retrieve-headers articles group fetch-old)) - (t - (funcall (gnus-get-function gnus-command-method 'retrieve-headers) - articles (gnus-group-real-name group) - (nth 1 gnus-command-method) fetch-old))))) - -(defun gnus-retrieve-articles (articles group) - "Request ARTICLES in GROUP." - (let ((gnus-command-method (gnus-find-method-for-group group))) - (funcall (gnus-get-function gnus-command-method 'retrieve-articles) - articles (gnus-group-real-name group) - (nth 1 gnus-command-method)))) - -(defun gnus-retrieve-groups (groups gnus-command-method) - "Request active information on GROUPS from GNUS-COMMAND-METHOD." - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (funcall (gnus-get-function gnus-command-method 'retrieve-groups) - groups (nth 1 gnus-command-method))) - -(defun gnus-request-type (group &optional article) - "Return the type (`post' or `mail') of GROUP (and ARTICLE)." - (let ((gnus-command-method (gnus-find-method-for-group group))) - (if (not (gnus-check-backend-function - 'request-type (car gnus-command-method))) - 'unknown - (funcall (gnus-get-function gnus-command-method 'request-type) - (gnus-group-real-name group) article)))) - -(defun gnus-request-set-mark (group action) - "Set marks on articles in the back end." - (let ((gnus-command-method (gnus-find-method-for-group group))) - (if (not (gnus-check-backend-function - 'request-set-mark (car gnus-command-method))) - action - (funcall (gnus-get-function gnus-command-method 'request-set-mark) - (gnus-group-real-name group) action - (nth 1 gnus-command-method))))) - -(defun gnus-request-update-mark (group article mark) - "Allow the back end to change the mark the user tries to put on an article." - (let ((gnus-command-method (gnus-find-method-for-group group))) - (if (not (gnus-check-backend-function - 'request-update-mark (car gnus-command-method))) - mark - (funcall (gnus-get-function gnus-command-method 'request-update-mark) - (gnus-group-real-name group) article mark)))) - -(defun gnus-request-article (article group &optional buffer) - "Request the ARTICLE in GROUP. -ARTICLE can either be an article number or an article Message-ID. -If BUFFER, insert the article in that group." - (let ((gnus-command-method (gnus-find-method-for-group group))) - (funcall (gnus-get-function gnus-command-method 'request-article) - article (gnus-group-real-name group) - (nth 1 gnus-command-method) buffer))) - -(defun gnus-request-head (article group) - "Request the head of ARTICLE in GROUP." - (let* ((gnus-command-method (gnus-find-method-for-group group)) - (head (gnus-get-function gnus-command-method 'request-head t)) - res clean-up) - (cond - ;; Check the cache. - ((and gnus-use-cache - (numberp article) - (gnus-cache-request-article article group)) - (setq res (cons group article) - clean-up t)) - ;; Check the agent cache. - ((gnus-agent-request-article article group) - (setq res (cons group article) - clean-up t)) - ;; Use `head' function. - ((fboundp head) - (setq res (funcall head article (gnus-group-real-name group) - (nth 1 gnus-command-method)))) - ;; Use `article' function. - (t - (setq res (gnus-request-article article group) - clean-up t))) - (when clean-up - (save-excursion - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (delete-region (1- (point)) (point-max))) - (nnheader-fold-continuation-lines))) - res)) - -(defun gnus-request-body (article group) - "Request the body of ARTICLE in GROUP." - (let* ((gnus-command-method (gnus-find-method-for-group group)) - (head (gnus-get-function gnus-command-method 'request-body t)) - res clean-up) - (cond - ;; Check the cache. - ((and gnus-use-cache - (numberp article) - (gnus-cache-request-article article group)) - (setq res (cons group article) - clean-up t)) - ;; Check the agent cache. - ((gnus-agent-request-article article group) - (setq res (cons group article) - clean-up t)) - ;; Use `head' function. - ((fboundp head) - (setq res (funcall head article (gnus-group-real-name group) - (nth 1 gnus-command-method)))) - ;; Use `article' function. - (t - (setq res (gnus-request-article article group) - clean-up t))) - (when clean-up - (save-excursion - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (delete-region (point-min) (1- (point)))))) - res)) - -(defun gnus-request-post (gnus-command-method) - "Post the current buffer using GNUS-COMMAND-METHOD." - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (funcall (gnus-get-function gnus-command-method 'request-post) - (nth 1 gnus-command-method))) - -(defun gnus-request-scan (group gnus-command-method) - "Request a SCAN being performed in GROUP from GNUS-COMMAND-METHOD. -If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned." - (let ((gnus-command-method - (if group (gnus-find-method-for-group group) gnus-command-method)) - (gnus-inhibit-demon t) - (mail-source-plugged gnus-plugged)) - (if (or gnus-plugged (not (gnus-agent-method-p gnus-command-method))) - (progn - (setq gnus-internal-registry-spool-current-method gnus-command-method) - (funcall (gnus-get-function gnus-command-method 'request-scan) - (and group (gnus-group-real-name group)) - (nth 1 gnus-command-method)))))) - -(defsubst gnus-request-update-info (info gnus-command-method) - "Request that GNUS-COMMAND-METHOD update INFO." - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (when (gnus-check-backend-function - 'request-update-info (car gnus-command-method)) - (let ((group (gnus-info-group info))) - (and (funcall (gnus-get-function gnus-command-method - 'request-update-info) - (gnus-group-real-name group) - info (nth 1 gnus-command-method)) - ;; If the minimum article number is greater than 1, then all - ;; smaller article numbers are known not to exist; we'll - ;; artificially add those to the 'read range. - (let* ((active (gnus-active group)) - (min (car active))) - (when (> min 1) - (let* ((range (if (= min 2) 1 (cons 1 (1- min)))) - (read (gnus-info-read info)) - (new-read (gnus-range-add read (list range)))) - (gnus-info-set-read info new-read))) - info))))) - -(defun gnus-request-expire-articles (articles group &optional force) - (let* ((gnus-command-method (gnus-find-method-for-group group)) - (not-deleted - (funcall - (gnus-get-function gnus-command-method 'request-expire-articles) - articles (gnus-group-real-name group) (nth 1 gnus-command-method) - force))) - (when (and gnus-agent - (gnus-agent-method-p gnus-command-method)) - (let ((expired-articles (gnus-sorted-difference articles not-deleted))) - (when expired-articles - (gnus-agent-expire expired-articles group 'force)))) - not-deleted)) - -(defun gnus-request-move-article (article group server accept-function - &optional last) - (let* ((gnus-command-method (gnus-find-method-for-group group)) - (result (funcall (gnus-get-function gnus-command-method - 'request-move-article) - article (gnus-group-real-name group) - (nth 1 gnus-command-method) accept-function last))) - (when (and result gnus-agent - (gnus-agent-method-p gnus-command-method)) - (gnus-agent-unfetch-articles group (list article))) - result)) - -(defun gnus-request-accept-article (group &optional gnus-command-method last - no-encode) - ;; Make sure there's a newline at the end of the article. - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (when (and (not gnus-command-method) - (stringp group)) - (setq gnus-command-method (or (gnus-find-method-for-group group) - (gnus-group-name-to-method group)))) - (goto-char (point-max)) - (unless (bolp) - (insert "\n")) - (unless no-encode - (let ((message-options message-options)) - (message-options-set-recipient) - (save-restriction - (message-narrow-to-head) - (let ((mail-parse-charset message-default-charset)) - (mail-encode-encoded-word-buffer))) - (message-encode-message-body))) -(let ((gnus-command-method (or gnus-command-method - (gnus-find-method-for-group group))) - (result - (funcall - (gnus-get-function gnus-command-method 'request-accept-article) - (if (stringp group) (gnus-group-real-name group) group) - (cadr gnus-command-method) - last))) - (when (and gnus-agent (gnus-agent-method-p gnus-command-method)) - (gnus-agent-regenerate-group group (list (cdr result)))) - result)) - -(defun gnus-request-replace-article (article group buffer &optional no-encode) - (unless no-encode - (let ((message-options message-options)) - (message-options-set-recipient) - (save-restriction - (message-narrow-to-head) - (let ((mail-parse-charset message-default-charset)) - (mail-encode-encoded-word-buffer))) - (message-encode-message-body))) - (let* ((func (car (gnus-group-name-to-method group))) - (result (funcall (intern (format "%s-request-replace-article" func)) - article (gnus-group-real-name group) buffer))) - (when (and gnus-agent (gnus-agent-method-p gnus-command-method)) - (gnus-agent-regenerate-group group (list article))) - result)) - -(defun gnus-request-associate-buffer (group) - (let ((gnus-command-method (gnus-find-method-for-group group))) - (funcall (gnus-get-function gnus-command-method 'request-associate-buffer) - (gnus-group-real-name group)))) - -(defun gnus-request-restore-buffer (article group) - "Request a new buffer restored to the state of ARTICLE." - (let ((gnus-command-method (gnus-find-method-for-group group))) - (funcall (gnus-get-function gnus-command-method 'request-restore-buffer) - article (gnus-group-real-name group) - (nth 1 gnus-command-method)))) - -(defun gnus-request-create-group (group &optional gnus-command-method args) - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (let ((gnus-command-method - (or gnus-command-method (gnus-find-method-for-group group)))) - (funcall (gnus-get-function gnus-command-method 'request-create-group) - (gnus-group-real-name group) (nth 1 gnus-command-method) args))) - -(defun gnus-request-delete-group (group &optional force) - (let* ((gnus-command-method (gnus-find-method-for-group group)) - (result - (funcall (gnus-get-function gnus-command-method 'request-delete-group) - (gnus-group-real-name group) force (nth 1 gnus-command-method)))) - (when result - (gnus-cache-delete-group group) - (gnus-agent-delete-group group)) - result)) - -(defun gnus-request-rename-group (group new-name) - (let* ((gnus-command-method (gnus-find-method-for-group group)) - (result - (funcall (gnus-get-function gnus-command-method 'request-rename-group) - (gnus-group-real-name group) - (gnus-group-real-name new-name) (nth 1 gnus-command-method)))) - (when result - (gnus-cache-rename-group group new-name) - (gnus-agent-rename-group group new-name)) - result)) - -(defun gnus-close-backends () - ;; Send a close request to all backends that support such a request. - (let ((methods gnus-valid-select-methods) - (gnus-inhibit-demon t) - func gnus-command-method) - (while (setq gnus-command-method (pop methods)) - (when (fboundp (setq func (intern - (concat (car gnus-command-method) - "-request-close")))) - (funcall func))))) - -(defun gnus-asynchronous-p (gnus-command-method) - (let ((func (gnus-get-function gnus-command-method 'asynchronous-p t))) - (when (fboundp func) - (funcall func)))) - -(defun gnus-remove-denial (gnus-command-method) - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (let* ((elem (assoc gnus-command-method gnus-opened-servers)) - (status (cadr elem))) - ;; If this hasn't been opened before, we add it to the list. - (when (eq status 'denied) - ;; Set the status of this server. - (setcar (cdr elem) 'closed)))) - -(provide 'gnus-int) - -;;; arch-tag: bbc90087-9b7f-4017-a92c-3abf180ac86d -;;; gnus-int.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-kill.el b/xemacs-packages/gnus/lisp/gnus-kill.el deleted file mode 100644 index 5b38e081..00000000 --- a/xemacs-packages/gnus/lisp/gnus-kill.el +++ /dev/null @@ -1,722 +0,0 @@ -;;; gnus-kill.el --- kill commands for Gnus - -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Masanobu UMEDA -;; Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) -(require 'gnus-art) -(require 'gnus-range) - -(defcustom gnus-kill-file-mode-hook nil - "Hook for Gnus kill file mode." - :group 'gnus-score-kill - :type 'hook) - -(defcustom gnus-kill-expiry-days 7 - "*Number of days before expiring unused kill file entries." - :group 'gnus-score-kill - :group 'gnus-score-expire - :type 'integer) - -(defcustom gnus-kill-save-kill-file nil - "*If non-nil, will save kill files after processing them." - :group 'gnus-score-kill - :type 'boolean) - -(defcustom gnus-winconf-kill-file nil - "What does this do, Lars? -I don't know, Per." - :group 'gnus-score-kill - :type 'sexp) - -(defcustom gnus-kill-killed t - "*If non-nil, Gnus will apply kill files to already killed articles. -If it is nil, Gnus will never apply kill files to articles that have -already been through the scoring process, which might very well save lots -of time." - :group 'gnus-score-kill - :type 'boolean) - - - -(defmacro gnus-raise (field expression level) - `(gnus-kill ,field ,expression - (function (gnus-summary-raise-score ,level)) t)) - -(defmacro gnus-lower (field expression level) - `(gnus-kill ,field ,expression - (function (gnus-summary-raise-score (- ,level))) t)) - -;;; -;;; Gnus Kill File Mode -;;; - -(defvar gnus-kill-file-mode-map nil) - -(unless gnus-kill-file-mode-map - (gnus-define-keymap (setq gnus-kill-file-mode-map - (copy-keymap emacs-lisp-mode-map)) - "\C-c\C-k\C-s" gnus-kill-file-kill-by-subject - "\C-c\C-k\C-a" gnus-kill-file-kill-by-author - "\C-c\C-k\C-t" gnus-kill-file-kill-by-thread - "\C-c\C-k\C-x" gnus-kill-file-kill-by-xref - "\C-c\C-a" gnus-kill-file-apply-buffer - "\C-c\C-e" gnus-kill-file-apply-last-sexp - "\C-c\C-c" gnus-kill-file-exit)) - -(defun gnus-kill-file-mode () - "Major mode for editing kill files. - -If you are using this mode - you probably shouldn't. Kill files -perform badly and paint with a pretty broad brush. Score files, on -the other hand, are vastly faster (40x speedup) and give you more -control over what to do. - -In addition to Emacs-Lisp Mode, the following commands are available: - -\\{gnus-kill-file-mode-map} - - A kill file contains Lisp expressions to be applied to a selected -newsgroup. The purpose is to mark articles as read on the basis of -some set of regexps. A global kill file is applied to every newsgroup, -and a local kill file is applied to a specified newsgroup. Since a -global kill file is applied to every newsgroup, for better performance -use a local one. - - A kill file can contain any kind of Emacs Lisp expressions expected -to be evaluated in the Summary buffer. Writing Lisp programs for this -purpose is not so easy because the internal working of Gnus must be -well-known. For this reason, Gnus provides a general function which -does this easily for non-Lisp programmers. - - The `gnus-kill' function executes commands available in Summary Mode -by their key sequences. `gnus-kill' should be called with FIELD, -REGEXP and optional COMMAND and ALL. FIELD is a string representing -the header field or an empty string. If FIELD is an empty string, the -entire article body is searched for. REGEXP is a string which is -compared with FIELD value. COMMAND is a string representing a valid -key sequence in Summary mode or Lisp expression. COMMAND defaults to -'(gnus-summary-mark-as-read nil \"X\"). Make sure that COMMAND is -executed in the Summary buffer. If the second optional argument ALL -is non-nil, the COMMAND is applied to articles which are already -marked as read or unread. Articles which are marked are skipped over -by default. - - For example, if you want to mark articles of which subjects contain -the string `AI' as read, a possible kill file may look like: - - (gnus-kill \"Subject\" \"AI\") - - If you want to mark articles with `D' instead of `X', you can use -the following expression: - - (gnus-kill \"Subject\" \"AI\" \"d\") - -In this example it is assumed that the command -`gnus-summary-mark-as-read-forward' is assigned to `d' in Summary Mode. - - It is possible to delete unnecessary headers which are marked with -`X' in a kill file as follows: - - (gnus-expunge \"X\") - - If the Summary buffer is empty after applying kill files, Gnus will -exit the selected newsgroup normally. If headers which are marked -with `D' are deleted in a kill file, it is impossible to read articles -which are marked as read in the previous Gnus sessions. Marks other -than `D' should be used for articles which should really be deleted. - -Entry to this mode calls emacs-lisp-mode-hook and -gnus-kill-file-mode-hook with no arguments, if that value is non-nil." - (interactive) - (kill-all-local-variables) - (use-local-map gnus-kill-file-mode-map) - (set-syntax-table emacs-lisp-mode-syntax-table) - (setq major-mode 'gnus-kill-file-mode) - (setq mode-name "Kill") - (lisp-mode-variables nil) - (gnus-run-mode-hooks 'emacs-lisp-mode-hook 'gnus-kill-file-mode-hook)) - -(defun gnus-kill-file-edit-file (newsgroup) - "Begin editing a kill file for NEWSGROUP. -If NEWSGROUP is nil, the global kill file is selected." - (interactive "sNewsgroup: ") - (let ((file (gnus-newsgroup-kill-file newsgroup))) - (gnus-make-directory (file-name-directory file)) - ;; Save current window configuration if this is first invocation. - (or (and (get-file-buffer file) - (get-buffer-window (get-file-buffer file))) - (setq gnus-winconf-kill-file (current-window-configuration))) - ;; Hack windows. - (let ((buffer (find-file-noselect file))) - (cond ((get-buffer-window buffer) - (pop-to-buffer buffer)) - ((eq major-mode 'gnus-group-mode) - (gnus-configure-windows 'group) ;Take all windows. - (pop-to-buffer buffer)) - ((eq major-mode 'gnus-summary-mode) - (gnus-configure-windows 'article) - (pop-to-buffer gnus-article-buffer) - (bury-buffer gnus-article-buffer) - (switch-to-buffer buffer)) - (t ;No good rules. - (find-file-other-window file)))) - (gnus-kill-file-mode))) - -;; Fix by Sudish Joseph . -(defun gnus-kill-set-kill-buffer () - (let* ((file (gnus-newsgroup-kill-file gnus-newsgroup-name)) - (buffer (find-file-noselect file))) - (set-buffer buffer) - (gnus-kill-file-mode) - (bury-buffer buffer))) - -(defun gnus-kill-file-enter-kill (field regexp &optional dont-move) - ;; Enter kill file entry. - ;; FIELD: String containing the name of the header field to kill. - ;; REGEXP: The string to kill. - (save-excursion - (let (string) - (unless (eq major-mode 'gnus-kill-file-mode) - (gnus-kill-set-kill-buffer)) - (unless dont-move - (goto-char (point-max))) - (insert (setq string (format "(gnus-kill %S %S)\n" field regexp))) - (gnus-kill-file-apply-string string)))) - -(defun gnus-kill-file-kill-by-subject () - "Kill by subject." - (interactive) - (gnus-kill-file-enter-kill - "Subject" - (if (vectorp gnus-current-headers) - (regexp-quote - (gnus-simplify-subject (mail-header-subject gnus-current-headers))) - "") - t)) - -(defun gnus-kill-file-kill-by-author () - "Kill by author." - (interactive) - (gnus-kill-file-enter-kill - "From" - (if (vectorp gnus-current-headers) - (regexp-quote (mail-header-from gnus-current-headers)) - "") t)) - -(defun gnus-kill-file-kill-by-thread () - "Kill by author." - (interactive) - (gnus-kill-file-enter-kill - "References" - (if (vectorp gnus-current-headers) - (regexp-quote (mail-header-id gnus-current-headers)) - ""))) - -(defun gnus-kill-file-kill-by-xref () - "Kill by Xref." - (interactive) - (let ((xref (and (vectorp gnus-current-headers) - (mail-header-xref gnus-current-headers))) - (start 0) - group) - (if xref - (while (string-match " \\([^ \t]+\\):" xref start) - (setq start (match-end 0)) - (when (not (string= - (setq group - (substring xref (match-beginning 1) (match-end 1))) - gnus-newsgroup-name)) - (gnus-kill-file-enter-kill - "Xref" (concat " " (regexp-quote group) ":") t))) - (gnus-kill-file-enter-kill "Xref" "" t)))) - -(defun gnus-kill-file-raise-followups-to-author (level) - "Raise score for all followups to the current author." - (interactive "p") - (let ((name (mail-header-from gnus-current-headers)) - string) - (save-excursion - (gnus-kill-set-kill-buffer) - (goto-char (point-min)) - (setq name (read-string (concat "Add " level - " to followup articles to: ") - (regexp-quote name))) - (setq - string - (format - "(gnus-kill %S %S '(gnus-summary-temporarily-raise-by-thread %S))\n" - "From" name level)) - (insert string) - (gnus-kill-file-apply-string string)) - (gnus-message - 6 "Added temporary score file entry for followups to %s." name))) - -(defun gnus-kill-file-apply-buffer () - "Apply current buffer to current newsgroup." - (interactive) - (if (and gnus-current-kill-article - (get-buffer gnus-summary-buffer)) - ;; Assume newsgroup is selected. - (gnus-kill-file-apply-string (buffer-string)) - (ding) (gnus-message 2 "No newsgroup is selected."))) - -(defun gnus-kill-file-apply-string (string) - "Apply STRING to current newsgroup." - (interactive) - (let ((string (concat "(progn \n" string "\n)"))) - (save-excursion - (save-window-excursion - (pop-to-buffer gnus-summary-buffer) - (eval (car (read-from-string string))))))) - -(defun gnus-kill-file-apply-last-sexp () - "Apply sexp before point in current buffer to current newsgroup." - (interactive) - (if (and gnus-current-kill-article - (get-buffer gnus-summary-buffer)) - ;; Assume newsgroup is selected. - (let ((string - (buffer-substring - (save-excursion (forward-sexp -1) (point)) (point)))) - (save-excursion - (save-window-excursion - (pop-to-buffer gnus-summary-buffer) - (eval (car (read-from-string string)))))) - (ding) (gnus-message 2 "No newsgroup is selected."))) - -(defun gnus-kill-file-exit () - "Save a kill file, then return to the previous buffer." - (interactive) - (save-buffer) - (let ((killbuf (current-buffer))) - ;; We don't want to return to article buffer. - (when (get-buffer gnus-article-buffer) - (bury-buffer gnus-article-buffer)) - ;; Delete the KILL file windows. - (delete-windows-on killbuf) - ;; Restore last window configuration if available. - (when gnus-winconf-kill-file - (set-window-configuration gnus-winconf-kill-file)) - (setq gnus-winconf-kill-file nil) - ;; Kill the KILL file buffer. Suggested by tale@pawl.rpi.edu. - (kill-buffer killbuf))) - -;; For kill files - -(defun gnus-Newsgroup-kill-file (newsgroup) - "Return the name of a kill file for NEWSGROUP. -If NEWSGROUP is nil, return the global kill file instead." - (cond ((or (null newsgroup) - (string-equal newsgroup "")) - ;; The global kill file is placed at top of the directory. - (expand-file-name gnus-kill-file-name gnus-kill-files-directory)) - (gnus-use-long-file-name - ;; Append ".KILL" to capitalized newsgroup name. - (expand-file-name (concat (gnus-capitalize-newsgroup newsgroup) - "." gnus-kill-file-name) - gnus-kill-files-directory)) - (t - ;; Place "KILL" under the hierarchical directory. - (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup) - "/" gnus-kill-file-name) - gnus-kill-files-directory)))) - -(defun gnus-expunge (marks) - "Remove lines marked with MARKS." - (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-summary-limit-to-marks marks 'reverse))) - -(defun gnus-apply-kill-file-unless-scored () - "Apply .KILL file, unless a .SCORE file for the same newsgroup exists." - (cond ((file-exists-p (gnus-score-file-name gnus-newsgroup-name)) - ;; Ignores global KILL. - (when (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)) - (gnus-message 3 "Note: Ignoring %s.KILL; preferring .SCORE" - gnus-newsgroup-name)) - 0) - ((or (file-exists-p (gnus-newsgroup-kill-file nil)) - (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name))) - (gnus-apply-kill-file-internal)) - (t - 0))) - -(defun gnus-apply-kill-file-internal () - "Apply a kill file to the current newsgroup. -Returns the number of articles marked as read." - (let* ((kill-files (list (gnus-newsgroup-kill-file nil) - (gnus-newsgroup-kill-file gnus-newsgroup-name))) - (unreads (length gnus-newsgroup-unreads)) - (gnus-summary-inhibit-highlight t) - beg) - (setq gnus-newsgroup-kill-headers nil) - ;; If there are any previously scored articles, we remove these - ;; from the `gnus-newsgroup-headers' list that the score functions - ;; will see. This is probably pretty wasteful when it comes to - ;; conses, but is, I think, faster than having to assq in every - ;; single score function. - (let ((files kill-files)) - (while files - (if (file-exists-p (car files)) - (let ((headers gnus-newsgroup-headers)) - (if gnus-kill-killed - (setq gnus-newsgroup-kill-headers - (mapcar (lambda (header) (mail-header-number header)) - headers)) - (while headers - (unless (gnus-member-of-range - (mail-header-number (car headers)) - gnus-newsgroup-killed) - (push (mail-header-number (car headers)) - gnus-newsgroup-kill-headers)) - (setq headers (cdr headers)))) - (setq files nil)) - (setq files (cdr files))))) - (if (not gnus-newsgroup-kill-headers) - () - (save-window-excursion - (save-excursion - (while kill-files - (if (not (file-exists-p (car kill-files))) - () - (gnus-message 6 "Processing kill file %s..." (car kill-files)) - (find-file (car kill-files)) - (goto-char (point-min)) - - (if (consp (ignore-errors (read (current-buffer)))) - (gnus-kill-parse-gnus-kill-file) - (gnus-kill-parse-rn-kill-file)) - - (gnus-message - 6 "Processing kill file %s...done" (car kill-files))) - (setq kill-files (cdr kill-files))))) - - (gnus-set-mode-line 'summary) - - (if beg - (let ((nunreads (- unreads (length gnus-newsgroup-unreads)))) - (or (eq nunreads 0) - (gnus-message 6 "Marked %d articles as read" nunreads)) - nunreads) - 0)))) - -;; Parse a Gnus killfile. -(defun gnus-kill-parse-gnus-kill-file () - (goto-char (point-min)) - (gnus-kill-file-mode) - (let (beg form) - (while (progn - (setq beg (point)) - (setq form (ignore-errors (read (current-buffer))))) - (unless (listp form) - (error "Invalid kill entry (possibly rn kill file?): %s" form)) - (if (or (eq (car form) 'gnus-kill) - (eq (car form) 'gnus-raise) - (eq (car form) 'gnus-lower)) - (progn - (delete-region beg (point)) - (insert (or (eval form) ""))) - (save-excursion - (set-buffer gnus-summary-buffer) - (ignore-errors (eval form))))) - (and (buffer-modified-p) - gnus-kill-save-kill-file - (save-buffer)) - (set-buffer-modified-p nil))) - -;; Parse an rn killfile. -(defun gnus-kill-parse-rn-kill-file () - (goto-char (point-min)) - (gnus-kill-file-mode) - (let ((mod-to-header - '((?a . "") - (?h . "") - (?f . "from") - (?: . "subject"))) - ;;(com-to-com - ;; '((?m . " ") - ;; (?j . "X"))) - pattern modifier commands) - (while (not (eobp)) - (if (not (looking-at "[ \t]*/\\([^/]*\\)/\\([ahfcH]\\)?:\\([a-z=:]*\\)")) - () - (setq pattern (buffer-substring (match-beginning 1) (match-end 1))) - (setq modifier (if (match-beginning 2) (char-after (match-beginning 2)) - ?s)) - (setq commands (buffer-substring (match-beginning 3) (match-end 3))) - - ;; The "f:+" command marks everything *but* the matches as read, - ;; so we simply first match everything as read, and then unmark - ;; PATTERN later. - (when (string-match "\\+" commands) - (gnus-kill "from" ".") - (setq commands "m")) - - (gnus-kill - (or (cdr (assq modifier mod-to-header)) "subject") - pattern - (if (string-match "m" commands) - '(gnus-summary-mark-as-unread nil " ") - '(gnus-summary-mark-as-read nil "X")) - nil t)) - (forward-line 1)))) - -;; Kill changes and new format by suggested by JWZ and Sudish Joseph -;; . -(defun gnus-kill (field regexp &optional exe-command all silent) - "If FIELD of an article matches REGEXP, execute COMMAND. -Optional 1st argument COMMAND is default to - (gnus-summary-mark-as-read nil \"X\"). -If optional 2nd argument ALL is non-nil, articles marked are also applied to. -If FIELD is an empty string (or nil), entire article body is searched for. -COMMAND must be a lisp expression or a string representing a key sequence." - ;; We don't want to change current point nor window configuration. - (let ((old-buffer (current-buffer))) - (save-excursion - (save-window-excursion - ;; Selected window must be summary buffer to execute keyboard - ;; macros correctly. See command_loop_1. - (switch-to-buffer gnus-summary-buffer 'norecord) - (goto-char (point-min)) ;From the beginning. - (let ((kill-list regexp) - (date (current-time-string)) - (command (or exe-command '(gnus-summary-mark-as-read - nil gnus-kill-file-mark))) - kill kdate prev) - (if (listp kill-list) - ;; It is a list. - (if (not (consp (cdr kill-list))) - ;; It's of the form (regexp . date). - (if (zerop (gnus-execute field (car kill-list) - command nil (not all))) - (when (> (days-between date (cdr kill-list)) - gnus-kill-expiry-days) - (setq regexp nil)) - (setcdr kill-list date)) - (while (setq kill (car kill-list)) - (if (consp kill) - ;; It's a temporary kill. - (progn - (setq kdate (cdr kill)) - (if (zerop (gnus-execute - field (car kill) command nil (not all))) - (when (> (days-between date kdate) - gnus-kill-expiry-days) - ;; Time limit has been exceeded, so we - ;; remove the match. - (if prev - (setcdr prev (cdr kill-list)) - (setq regexp (cdr regexp)))) - ;; Successful kill. Set the date to today. - (setcdr kill date))) - ;; It's a permanent kill. - (gnus-execute field kill command nil (not all))) - (setq prev kill-list) - (setq kill-list (cdr kill-list)))) - (gnus-execute field kill-list command nil (not all)))))) - (switch-to-buffer old-buffer) - (when (and (eq major-mode 'gnus-kill-file-mode) regexp (not silent)) - (gnus-pp-gnus-kill - (nconc (list 'gnus-kill field - (if (consp regexp) (list 'quote regexp) regexp)) - (when (or exe-command all) - (list (list 'quote exe-command))) - (if all (list t) nil)))))) - -(defun gnus-pp-gnus-kill (object) - (if (or (not (consp (nth 2 object))) - (not (consp (cdr (nth 2 object)))) - (and (eq 'quote (car (nth 2 object))) - (not (consp (cdadr (nth 2 object)))))) - (concat "\n" (gnus-prin1-to-string object)) - (save-excursion - (set-buffer (gnus-get-buffer-create "*Gnus PP*")) - (buffer-disable-undo) - (erase-buffer) - (insert (format "\n(%S %S\n '(" (nth 0 object) (nth 1 object))) - (let ((klist (cadr (nth 2 object))) - (first t)) - (while klist - (insert (if first (progn (setq first nil) "") "\n ") - (gnus-prin1-to-string (car klist))) - (setq klist (cdr klist)))) - (insert ")") - (and (nth 3 object) - (insert "\n " - (if (and (consp (nth 3 object)) - (not (eq 'quote (car (nth 3 object))))) - "'" "") - (gnus-prin1-to-string (nth 3 object)))) - (when (nth 4 object) - (insert "\n t")) - (insert ")") - (prog1 - (buffer-string) - (kill-buffer (current-buffer)))))) - -(defun gnus-execute-1 (function regexp form header) - (save-excursion - (let (did-kill) - (if (null header) - nil ;Nothing to do. - (if function - ;; Compare with header field. - (let (value) - (and header - (progn - (setq value (funcall function header)) - ;; Number (Lines:) or symbol must be converted to string. - (unless (stringp value) - (setq value (gnus-prin1-to-string value))) - (setq did-kill (string-match regexp value))) - (cond ((stringp form) ;Keyboard macro. - (execute-kbd-macro form)) - ((functionp form) - (funcall form)) - (t - (eval form))))) - ;; Search article body. - (let ((gnus-current-article nil) ;Save article pointer. - (gnus-last-article nil) - (gnus-break-pages nil) ;No need to break pages. - (gnus-mark-article-hook nil)) ;Inhibit marking as read. - (gnus-message - 6 "Searching for article: %d..." (mail-header-number header)) - (gnus-article-setup-buffer) - (gnus-article-prepare (mail-header-number header) t) - (when (save-excursion - (set-buffer gnus-article-buffer) - (goto-char (point-min)) - (setq did-kill (re-search-forward regexp nil t))) - (cond ((stringp form) ;Keyboard macro. - (execute-kbd-macro form)) - ((functionp form) - (funcall form)) - (t - (eval form))))))) - did-kill))) - -(defun gnus-execute (field regexp form &optional backward unread) - "If FIELD of article header matches REGEXP, execute lisp FORM (or a string). -If FIELD is an empty string (or nil), entire article body is searched for. -If optional 1st argument BACKWARD is non-nil, do backward instead. -If optional 2nd argument UNREAD is non-nil, articles which are -marked as read or ticked are ignored." - (save-excursion - (let ((killed-no 0) - function article header extras) - (cond - ;; Search body. - ((or (null field) - (string-equal field "")) - (setq function nil)) - ;; Get access function of header field. - ((cond ((fboundp - (setq function - (intern-soft - (concat "mail-header-" (downcase field))))) - (setq function `(lambda (h) (,function h)))) - ((when (setq extras - (member (downcase field) - (mapcar (lambda (header) - (downcase (symbol-name header))) - gnus-extra-headers))) - (setq function - `(lambda (h) - (gnus-extra-header - (quote ,(nth (- (length gnus-extra-headers) - (length extras)) - gnus-extra-headers)) - h))))))) - ;; Signal error. - (t - (error "Unknown header field: \"%s\"" field))) - ;; Starting from the current article. - (while (or - ;; First article. - (and (not article) - (setq article (gnus-summary-article-number))) - ;; Find later articles. - (setq article - (gnus-summary-search-forward unread nil backward))) - (and (or (null gnus-newsgroup-kill-headers) - (memq article gnus-newsgroup-kill-headers)) - (vectorp (setq header (gnus-summary-article-header article))) - (gnus-execute-1 function regexp form header) - (setq killed-no (1+ killed-no)))) - ;; Return the number of killed articles. - killed-no))) - -;;;###autoload -(defalias 'gnus-batch-kill 'gnus-batch-score) -;;;###autoload -(defun gnus-batch-score () - "Run batched scoring. -Usage: emacs -batch -l ~/.emacs -l gnus -f gnus-batch-score" - (interactive) - (let* ((gnus-newsrc-options-n - (gnus-newsrc-parse-options - (concat "options -n " - (mapconcat 'identity command-line-args-left " ")))) - (gnus-expert-user t) - (nnmail-spool-file nil) - (mail-sources nil) - (gnus-use-dribble-file nil) - (gnus-batch-mode t) - info group newsrc entry - ;; Disable verbose message. - gnus-novice-user gnus-large-newsgroup - gnus-options-subscribe gnus-auto-subscribed-groups - gnus-options-not-subscribe) - ;; Eat all arguments. - (setq command-line-args-left nil) - (gnus-slave) - ;; Apply kills to specified newsgroups in command line arguments. - (setq newsrc (cdr gnus-newsrc-alist)) - (while (setq info (pop newsrc)) - (setq group (gnus-info-group info) - entry (gnus-gethash group gnus-newsrc-hashtb)) - (when (and (<= (gnus-info-level info) gnus-level-subscribed) - (and (car entry) - (or (eq (car entry) t) - (not (zerop (car entry)))))) - (ignore-errors - (gnus-summary-read-group group nil t nil t)) - (when (eq (current-buffer) (get-buffer gnus-summary-buffer)) - (gnus-summary-exit)))) - ;; Exit Emacs. - (switch-to-buffer gnus-group-buffer) - (gnus-group-save-newsrc))) - -(provide 'gnus-kill) - -;;; arch-tag: b30c0f53-df1a-490b-b81e-17b13474f395 -;;; gnus-kill.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-load.el b/xemacs-packages/gnus/lisp/gnus-load.el deleted file mode 100644 index 88517e03..00000000 --- a/xemacs-packages/gnus/lisp/gnus-load.el +++ /dev/null @@ -1,9 +0,0 @@ - -(provide 'gnus-load) - -;;; Local Variables: -;;; version-control: never -;;; no-byte-compile: t -;;; no-update-autoloads: t -;;; End: -;;; gnus-load.el ends here \ No newline at end of file diff --git a/xemacs-packages/gnus/lisp/gnus-logic.el b/xemacs-packages/gnus/lisp/gnus-logic.el deleted file mode 100644 index 78ced8e4..00000000 --- a/xemacs-packages/gnus/lisp/gnus-logic.el +++ /dev/null @@ -1,232 +0,0 @@ -;;; gnus-logic.el --- advanced scoring code for Gnus - -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) -(require 'gnus-score) -(require 'gnus-util) - -;;; Internal variables. - -(defvar gnus-advanced-headers nil) - -;; To avoid having 8-bit characters in the source file. -(defvar gnus-advanced-not (intern (format "%c" 172))) - -(defconst gnus-advanced-index - ;; Name to index alist. - '(("number" 0 gnus-advanced-integer) - ("subject" 1 gnus-advanced-string) - ("from" 2 gnus-advanced-string) - ("date" 3 gnus-advanced-date) - ("message-id" 4 gnus-advanced-string) - ("references" 5 gnus-advanced-string) - ("chars" 6 gnus-advanced-integer) - ("lines" 7 gnus-advanced-integer) - ("xref" 8 gnus-advanced-string) - ("head" nil gnus-advanced-body) - ("body" nil gnus-advanced-body) - ("all" nil gnus-advanced-body))) - -(eval-and-compile - (autoload 'parse-time-string "parse-time")) - -(defun gnus-score-advanced (rule &optional trace) - "Apply advanced scoring RULE to all the articles in the current group." - (let (new-score score multiple) - (dolist (gnus-advanced-headers gnus-newsgroup-headers) - (when (setq multiple (gnus-advanced-score-rule (car rule))) - (setq new-score (or (nth 1 rule) - gnus-score-interactive-default-score)) - (when (numberp multiple) - (setq new-score (* multiple new-score))) - ;; This rule was successful, so we add the score to this - ;; article. - (if (setq score (assq (mail-header-number gnus-advanced-headers) - gnus-newsgroup-scored)) - (setcdr score - (+ (cdr score) new-score)) - (push (cons (mail-header-number gnus-advanced-headers) - new-score) - gnus-newsgroup-scored) - (when trace - (push (cons "A file" rule) - ;; Must be synced with `gnus-score-edit-file-at-point'. - gnus-score-trace))))))) - -(defun gnus-advanced-score-rule (rule) - "Apply RULE to `gnus-advanced-headers'." - (let ((type (car rule))) - (cond - ;; "And" rule. - ((or (eq type '&) (eq type 'and)) - (pop rule) - (if (not rule) - t ; Empty rule is true. - (while (and rule - (gnus-advanced-score-rule (car rule))) - (pop rule)) - ;; If all the rules were true, then `rule' should be nil. - (not rule))) - ;; "Or" rule. - ((or (eq type '|) (eq type 'or)) - (pop rule) - (if (not rule) - nil - (while (and rule - (not (gnus-advanced-score-rule (car rule)))) - (pop rule)) - ;; If one of the rules returned true, then `rule' should be non-nil. - rule)) - ;; "Not" rule. - ((or (eq type '!) (eq type 'not) (eq type gnus-advanced-not)) - (not (gnus-advanced-score-rule (nth 1 rule)))) - ;; This is a `1-'-type redirection rule. - ((and (symbolp type) - (string-match "^[0-9]+-$\\|^\\^+$" (symbol-name type))) - (let ((gnus-advanced-headers - (gnus-parent-headers - gnus-advanced-headers - (if (string-match "^\\([0-9]+\\)-$" (symbol-name type)) - ;; 1- type redirection. - (string-to-number - (substring (symbol-name type) - (match-beginning 1) (match-end 1))) - ;; ^^^ type redirection. - (length (symbol-name type)))))) - (when gnus-advanced-headers - (gnus-advanced-score-rule (nth 1 rule))))) - ;; Plain scoring rule. - ((stringp type) - (gnus-advanced-score-article rule)) - ;; Bug-out time! - (t - (error "Unknown advanced score type: %s" rule))))) - -(defun gnus-advanced-score-article (rule) - ;; `rule' is a semi-normal score rule, so we find out what function - ;; that's supposed to do the actual processing. - (let* ((header (car rule)) - (func (assoc (downcase header) gnus-advanced-index))) - (if (not func) - (error "No such header: %s" rule) - ;; Call the score function. - (funcall (caddr func) (or (cadr func) header) - (cadr rule) (caddr rule))))) - -(defun gnus-advanced-string (index match type) - "See whether string MATCH of TYPE matches `gnus-advanced-headers' in INDEX." - (let* ((type (or type 's)) - (case-fold-search (not (eq (downcase (symbol-name type)) - (symbol-name type)))) - (header (or (aref gnus-advanced-headers index) ""))) - (cond - ((memq type '(r R regexp Regexp)) - (string-match match header)) - ((memq type '(s S string String)) - (string-match (regexp-quote match) header)) - ((memq type '(e E exact Exact)) - (string= match header)) - ((memq type '(f F fuzzy Fuzzy)) - (string-match (regexp-quote (gnus-simplify-subject-fuzzy match)) - header)) - (t - (error "No such string match type: %s" type))))) - -(defun gnus-advanced-integer (index match type) - (if (not (memq type '(< > <= >= =))) - (error "No such integer score type: %s" type) - (funcall type (or (aref gnus-advanced-headers index) 0) match))) - -(defun gnus-advanced-date (index match type) - (let ((date (apply 'encode-time (parse-time-string - (aref gnus-advanced-headers index)))) - (match (apply 'encode-time (parse-time-string match)))) - (cond - ((eq type 'at) - (equal date match)) - ((eq type 'before) - (time-less-p match date)) - ((eq type 'after) - (time-less-p date match)) - (t - (error "No such date score type: %s" type))))) - -(defun gnus-advanced-body (header match type) - (when (string= header "all") - (setq header "article")) - (save-excursion - (set-buffer nntp-server-buffer) - (let* ((request-func (cond ((string= "head" header) - 'gnus-request-head) - ((string= "body" header) - 'gnus-request-body) - (t 'gnus-request-article))) - ofunc article) - ;; Not all backends support partial fetching. In that case, we - ;; just fetch the entire article. - (unless (gnus-check-backend-function - (intern (concat "request-" header)) - gnus-newsgroup-name) - (setq ofunc request-func) - (setq request-func 'gnus-request-article)) - (setq article (mail-header-number gnus-advanced-headers)) - (gnus-message 7 "Scoring article %s..." article) - (when (funcall request-func article gnus-newsgroup-name) - (goto-char (point-min)) - ;; If just parts of the article is to be searched and the - ;; backend didn't support partial fetching, we just narrow to - ;; the relevant parts. - (when ofunc - (if (eq ofunc 'gnus-request-head) - (narrow-to-region - (point) - (or (search-forward "\n\n" nil t) (point-max))) - (narrow-to-region - (or (search-forward "\n\n" nil t) (point)) - (point-max)))) - (let* ((case-fold-search (not (eq (downcase (symbol-name type)) - (symbol-name type)))) - (search-func - (cond ((memq type '(r R regexp Regexp)) - 're-search-forward) - ((memq type '(s S string String)) - 'search-forward) - (t - (error "Invalid match type: %s" type))))) - (goto-char (point-min)) - (prog1 - (funcall search-func match nil t) - (widen))))))) - -(provide 'gnus-logic) - -;;; arch-tag: 9651a100-4a59-4b69-a55b-e511e67c0f8d -;;; gnus-logic.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-mh.el b/xemacs-packages/gnus/lisp/gnus-mh.el deleted file mode 100644 index 468e0544..00000000 --- a/xemacs-packages/gnus/lisp/gnus-mh.el +++ /dev/null @@ -1,116 +0,0 @@ -;;; gnus-mh.el --- mh-e interface for Gnus - -;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Masanobu UMEDA -;; Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Send mail using mh-e. - -;; The following mh-e interface is all cooperative works of -;; tanaka@flab.fujitsu.CO.JP (TANAKA Hiroshi), kawabe@sra.CO.JP -;; (Yoshikatsu Kawabe), and shingu@casund.cpr.canon.co.jp (Toshiaki -;; SHINGU). - -;;; Code: - -(require 'gnus) -(require 'mh-e) -(require 'mh-comp) -(require 'gnus-msg) -(require 'gnus-sum) - -(eval-when-compile - (defvar mh-lib-progs)) - -(defun gnus-summary-save-article-folder (&optional arg) - "Append the current article to an mh folder. -If N is a positive number, save the N next articles. -If N is a negative number, save the N previous articles. -If N is nil and any articles have been marked with the process mark, -save those articles instead." - (interactive "P") - (require 'gnus-art) - (let ((gnus-default-article-saver 'gnus-summary-save-in-folder)) - (gnus-summary-save-article arg))) - -(defun gnus-summary-save-in-folder (&optional folder) - "Save this article to MH folder (using `rcvstore' in MH library). -Optional argument FOLDER specifies folder name." - ;; Thanks to yuki@flab.Fujitsu.JUNET and ohm@kaba.junet. - (mh-find-path) - (let ((folder - (cond ((and (eq folder 'default) - gnus-newsgroup-last-folder) - gnus-newsgroup-last-folder) - (folder folder) - (t (mh-prompt-for-folder - "Save article in" - (funcall gnus-folder-save-name gnus-newsgroup-name - gnus-current-headers gnus-newsgroup-last-folder) - t)))) - (errbuf (gnus-get-buffer-create " *Gnus rcvstore*")) - ;; Find the rcvstore program. - (exec-path (cond - ((and (boundp 'mh-lib-progs) mh-lib-progs) - (cons mh-lib-progs exec-path)) - (mh-lib (cons mh-lib exec-path)) - (t exec-path)))) - (with-current-buffer gnus-original-article-buffer - (save-restriction - (widen) - (unwind-protect - (call-process-region - (point-min) (point-max) "rcvstore" nil errbuf nil folder) - (set-buffer errbuf) - (if (zerop (buffer-size)) - (message "Article saved in folder: %s" folder) - (message "%s" (buffer-string))) - (kill-buffer errbuf)))) - (setq gnus-newsgroup-last-folder folder))) - -(defun gnus-Folder-save-name (newsgroup headers &optional last-folder) - "Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER. -If variable `gnus-use-long-file-name' is nil, it is +News.group. -Otherwise, it is like +news/group." - (or last-folder - (concat "+" - (if gnus-use-long-file-name - (gnus-capitalize-newsgroup newsgroup) - (gnus-newsgroup-directory-form newsgroup))))) - -(defun gnus-folder-save-name (newsgroup headers &optional last-folder) - "Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER. -If variable `gnus-use-long-file-name' is nil, it is +news.group. -Otherwise, it is like +news/group." - (or last-folder - (concat "+" - (if gnus-use-long-file-name - newsgroup - (gnus-newsgroup-directory-form newsgroup))))) - -(provide 'gnus-mh) - -;;; arch-tag: 2d5696d3-b363-48e5-8749-c256be56acca -;;; gnus-mh.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-ml.el b/xemacs-packages/gnus/lisp/gnus-ml.el deleted file mode 100644 index 5ad89c06..00000000 --- a/xemacs-packages/gnus/lisp/gnus-ml.el +++ /dev/null @@ -1,184 +0,0 @@ -;;; gnus-ml.el --- Mailing list minor mode for Gnus - -;; Copyright (C) 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Julien Gilles -;; Keywords: news, mail - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; implement (small subset of) RFC 2369 - -;;; Code: - -(require 'gnus) -(require 'gnus-msg) -(eval-when-compile (require 'cl)) - -;;; Mailing list minor mode - -(defvar gnus-mailing-list-mode nil - "Minor mode for providing mailing-list commands.") - -(defvar gnus-mailing-list-mode-map nil) - -(defvar gnus-mailing-list-menu) - -(unless gnus-mailing-list-mode-map - (setq gnus-mailing-list-mode-map (make-sparse-keymap)) - - (gnus-define-keys gnus-mailing-list-mode-map - "\C-c\C-nh" gnus-mailing-list-help - "\C-c\C-ns" gnus-mailing-list-subscribe - "\C-c\C-nu" gnus-mailing-list-unsubscribe - "\C-c\C-np" gnus-mailing-list-post - "\C-c\C-no" gnus-mailing-list-owner - "\C-c\C-na" gnus-mailing-list-archive)) - -(defun gnus-mailing-list-make-menu-bar () - (unless (boundp 'gnus-mailing-list-menu) - (easy-menu-define - gnus-mailing-list-menu gnus-mailing-list-mode-map "" - '("Mailing-Lists" - ["Get help" gnus-mailing-list-help t] - ["Subscribe" gnus-mailing-list-subscribe t] - ["Unsubscribe" gnus-mailing-list-unsubscribe t] - ["Post a message" gnus-mailing-list-post t] - ["Mail to owner" gnus-mailing-list-owner t] - ["Browse archive" gnus-mailing-list-archive t])))) - -;;;###autoload -(defun turn-on-gnus-mailing-list-mode () - (when (gnus-group-find-parameter gnus-newsgroup-name 'to-list) - (gnus-mailing-list-mode 1))) - -;;;###autoload -(defun gnus-mailing-list-insinuate (&optional force) - "Setup group parameters from List-Post header. -If FORCE is non-nil, replace the old ones." - (interactive "P") - (let ((list-post - (with-current-buffer gnus-original-article-buffer - (gnus-fetch-field "list-post")))) - (if list-post - (if (and (not force) - (gnus-group-get-parameter gnus-newsgroup-name 'to-list)) - (gnus-message 1 "to-list is non-nil.") - (if (string-match "]*\\)>" list-post) - (setq list-post (match-string 1 list-post))) - (gnus-group-add-parameter gnus-newsgroup-name - (cons 'to-list list-post)) - (gnus-mailing-list-mode 1)) - (gnus-message 1 "no list-post in this message.")))) - -;;;###autoload -(defun gnus-mailing-list-mode (&optional arg) - "Minor mode for providing mailing-list commands. - -\\{gnus-mailing-list-mode-map}" - (interactive "P") - (when (eq major-mode 'gnus-summary-mode) - (when (set (make-local-variable 'gnus-mailing-list-mode) - (if (null arg) (not gnus-mailing-list-mode) - (> (prefix-numeric-value arg) 0))) - ;; Set up the menu. - (when (gnus-visual-p 'mailing-list-menu 'menu) - (gnus-mailing-list-make-menu-bar)) - (gnus-add-minor-mode 'gnus-mailing-list-mode " Mailing-List" - gnus-mailing-list-mode-map) - (gnus-run-hooks 'gnus-mailing-list-mode-hook)))) - -;;; Commands - -(defun gnus-mailing-list-help () - "Get help from mailing list server." - (interactive) - (let ((list-help - (with-current-buffer gnus-original-article-buffer - (gnus-fetch-field "list-help")))) - (cond (list-help (gnus-mailing-list-message list-help)) - (t (gnus-message 1 "no list-help in this group"))))) - -(defun gnus-mailing-list-subscribe () - "Subscribe to mailing list." - (interactive) - (let ((list-subscribe - (with-current-buffer gnus-original-article-buffer - (gnus-fetch-field "list-subscribe")))) - (cond (list-subscribe (gnus-mailing-list-message list-subscribe)) - (t (gnus-message 1 "no list-subscribe in this group"))))) - -(defun gnus-mailing-list-unsubscribe () - "Unsubscribe from mailing list." - (interactive) - (let ((list-unsubscribe - (with-current-buffer gnus-original-article-buffer - (gnus-fetch-field "list-unsubscribe")))) - (cond (list-unsubscribe (gnus-mailing-list-message list-unsubscribe)) - (t (gnus-message 1 "no list-unsubscribe in this group"))))) - -(defun gnus-mailing-list-post () - "Post message (really useful ?)" - (interactive) - (let ((list-post - (with-current-buffer gnus-original-article-buffer - (gnus-fetch-field "list-post")))) - (cond (list-post (gnus-mailing-list-message list-post)) - (t (gnus-message 1 "no list-post in this group"))))) - -(defun gnus-mailing-list-owner () - "Mail to the mailing list owner." - (interactive) - (let ((list-owner - (with-current-buffer gnus-original-article-buffer - (gnus-fetch-field "list-owner")))) - (cond (list-owner (gnus-mailing-list-message list-owner)) - (t (gnus-message 1 "no list-owner in this group"))))) - -(defun gnus-mailing-list-archive () - "Browse archive." - (interactive) - (require 'browse-url) - (let ((list-archive - (with-current-buffer gnus-original-article-buffer - (gnus-fetch-field "list-archive")))) - (cond (list-archive - (if (string-match "<\\(http:[^>]*\\)>" list-archive) - (browse-url (match-string 1 list-archive)) - (browse-url list-archive))) - (t (gnus-message 1 "no list-archive in this group"))))) - -;;; Utility functions - -(defun gnus-mailing-list-message (address) - "Send message to ADDRESS. -ADDRESS is specified by a \"mailto:\" URL." - (cond - ((string-match "<\\(mailto:[^>]*\\)>" address) - (require 'gnus-art) - (gnus-url-mailto (match-string 1 address))) - ;; other case to be done. - (t nil))) - -(provide 'gnus-ml) - -;;; arch-tag: 936c0fe6-acce-4c16-87d0-eded88078896 -;;; gnus-ml.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-mlspl.el b/xemacs-packages/gnus/lisp/gnus-mlspl.el deleted file mode 100644 index e78b1bae..00000000 --- a/xemacs-packages/gnus/lisp/gnus-mlspl.el +++ /dev/null @@ -1,233 +0,0 @@ -;;; gnus-mlspl.el --- a group params-based mail splitting mechanism - -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Alexandre Oliva -;; Keywords: news, mail - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published -;; by the Free Software Foundation; either version 3, or (at your -;; option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) -(require 'gnus) -(require 'gnus-sum) -(require 'gnus-group) -(require 'nnmail) - -(defvar gnus-group-split-updated-hook nil - "Hook called just after nnmail-split-fancy is updated by -gnus-group-split-update.") - -(defvar gnus-group-split-default-catch-all-group "mail.misc" - "Group name (or arbitrary fancy split) with default splitting rules. -Used by gnus-group-split and gnus-group-split-update as a fallback -split, in case none of the group-based splits matches.") - -;;;###autoload -(defun gnus-group-split-setup (&optional auto-update catch-all) - "Set up the split for nnmail-split-fancy. -Sets things up so that nnmail-split-fancy is used for mail -splitting, and defines the variable nnmail-split-fancy according with -group parameters. - -If AUTO-UPDATE is non-nil (prefix argument accepted, if called -interactively), it makes sure nnmail-split-fancy is re-computed before -getting new mail, by adding gnus-group-split-update to -nnmail-pre-get-new-mail-hook. - -A non-nil CATCH-ALL replaces the current value of -gnus-group-split-default-catch-all-group. This variable is only used -by gnus-group-split-update, and only when its CATCH-ALL argument is -nil. This argument may contain any fancy split, that will be added as -the last split in a `|' split produced by gnus-group-split-fancy, -unless overridden by any group marked as a catch-all group. Typical -uses are as simple as the name of a default mail group, but more -elaborate fancy splits may also be useful to split mail that doesn't -match any of the group-specified splitting rules. See -`gnus-group-split-fancy' for details." - (interactive "P") - (setq nnmail-split-methods 'nnmail-split-fancy) - (when catch-all - (setq gnus-group-split-default-catch-all-group catch-all)) - (gnus-group-split-update) - (when auto-update - (add-hook 'nnmail-pre-get-new-mail-hook 'gnus-group-split-update))) - -;;;###autoload -(defun gnus-group-split-update (&optional catch-all) - "Computes nnmail-split-fancy from group params and CATCH-ALL. -It does this by calling by calling (gnus-group-split-fancy nil -nil CATCH-ALL). - -If CATCH-ALL is nil, gnus-group-split-default-catch-all-group is used -instead. This variable is set by gnus-group-split-setup." - (interactive) - (setq nnmail-split-fancy - (gnus-group-split-fancy - nil (null nnmail-crosspost) - (or catch-all gnus-group-split-default-catch-all-group))) - (run-hooks 'gnus-group-split-updated-hook)) - -;;;###autoload -(defun gnus-group-split () - "Uses information from group parameters in order to split mail. -See `gnus-group-split-fancy' for more information. - -gnus-group-split is a valid value for nnmail-split-methods." - (let (nnmail-split-fancy) - (gnus-group-split-update) - (nnmail-split-fancy))) - -;;;###autoload -(defun gnus-group-split-fancy - (&optional groups no-crosspost catch-all) - "Uses information from group parameters in order to split mail. -It can be embedded into `nnmail-split-fancy' lists with the SPLIT - -\(: gnus-group-split-fancy GROUPS NO-CROSSPOST CATCH-ALL\) - -GROUPS may be a regular expression or a list of group names, that will -be used to select candidate groups. If it is omitted or nil, all -existing groups are considered. - -if NO-CROSSPOST is omitted or nil, a & split will be returned, -otherwise, a | split, that does not allow crossposting, will be -returned. - -For each selected group, a SPLIT is composed like this: if SPLIT-SPEC -is specified, this split is returned as-is (unless it is nil: in this -case, the group is ignored). Otherwise, if TO-ADDRESS, TO-LIST and/or -EXTRA-ALIASES are specified, a regexp that matches any of them is -constructed (extra-aliases may be a list). Additionally, if -SPLIT-REGEXP is specified, the regexp will be extended so that it -matches this regexp too, and if SPLIT-EXCLUDE is specified, RESTRICT -clauses will be generated. - -If CATCH-ALL is nil, no catch-all handling is performed, regardless of -catch-all marks in group parameters. Otherwise, if there is no -selected group whose SPLIT-REGEXP matches the empty string, nor is -there a selected group whose SPLIT-SPEC is 'catch-all, this fancy -split (say, a group name) will be appended to the returned SPLIT list, -as the last element of a '| SPLIT. - -For example, given the following group parameters: - -nnml:mail.bar: -\((to-address . \"bar@femail.com\") - (split-regexp . \".*@femail\\\\.com\")) -nnml:mail.foo: -\((to-list . \"foo@nowhere.gov\") - (extra-aliases \"foo@localhost\" \"foo-redist@home\") - (split-exclude \"bugs-foo\" \"rambling-foo\") - (admin-address . \"foo-request@nowhere.gov\")) -nnml:mail.others: -\((split-spec . catch-all)) - -Calling (gnus-group-split-fancy nil nil \"mail.others\") returns: - -\(| (& (any \"\\\\(bar@femail\\\\.com\\\\|.*@femail\\\\.com\\\\)\" - \"mail.bar\") - (any \"\\\\(foo@nowhere\\\\.gov\\\\|foo@localhost\\\\|foo-redist@home\\\\)\" - - \"bugs-foo\" - \"rambling-foo\" \"mail.foo\")) - \"mail.others\")" - (let* ((newsrc (cdr gnus-newsrc-alist)) - split) - (dolist (info newsrc) - (let ((group (gnus-info-group info)) - (params (gnus-info-params info))) - ;; For all GROUPs that match the specified GROUPS - (when (or (not groups) - (and (listp groups) - (memq group groups)) - (and (stringp groups) - (string-match groups group))) - (let ((split-spec (assoc 'split-spec params)) group-clean) - ;; Remove backend from group name - (setq group-clean (string-match ":" group)) - (setq group-clean - (if group-clean - (substring group (1+ group-clean)) - group)) - (if split-spec - (when (setq split-spec (cdr split-spec)) - (if (eq split-spec 'catch-all) - ;; Emit catch-all only when requested - (when catch-all - (setq catch-all group-clean)) - ;; Append split-spec to the main split - (push split-spec split))) - ;; Let's deduce split-spec from other params - (let ((to-address (cdr (assoc 'to-address params))) - (to-list (cdr (assoc 'to-list params))) - (extra-aliases (cdr (assoc 'extra-aliases params))) - (split-regexp (cdr (assoc 'split-regexp params))) - (split-exclude (cdr (assoc 'split-exclude params)))) - (when (or to-address to-list extra-aliases split-regexp) - ;; regexp-quote to-address, to-list and extra-aliases - ;; and add them all to split-regexp - (setq split-regexp - (concat - "\\(" - (mapconcat - 'identity - (append - (and to-address (list (regexp-quote to-address))) - (and to-list (list (regexp-quote to-list))) - (and extra-aliases - (if (listp extra-aliases) - (mapcar 'regexp-quote extra-aliases) - (list extra-aliases))) - (and split-regexp (list split-regexp))) - "\\|") - "\\)")) - ;; Now create the new SPLIT - (push (append - (list 'any split-regexp) - ;; Generate RESTRICTs for SPLIT-EXCLUDEs. - (if (listp split-exclude) - (apply #'append - (mapcar (lambda (arg) (list '- arg)) - split-exclude)) - (list '- split-exclude)) - (list group-clean)) - split) - ;; If it matches the empty string, it is a catch-all - (when (string-match split-regexp "") - (setq catch-all nil))))))))) - ;; Add catch-all if not crossposting - (if (and catch-all no-crosspost) - (push catch-all split)) - ;; Move it to the tail, while arranging that SPLITs appear in the - ;; same order as groups. - (setq split (reverse split)) - ;; Decide whether to accept cross-postings or not. - (push (if no-crosspost '| '&) split) - ;; Even if we can cross-post, catch-all should not get - ;; cross-posts. - (if (and catch-all (not no-crosspost)) - (setq split (list '| split catch-all))) - split)) - -(provide 'gnus-mlspl) - -;;; arch-tag: 62b3381f-1e45-4b61-be1a-29fb27703322 -;;; gnus-mlspl.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-move.el b/xemacs-packages/gnus/lisp/gnus-move.el deleted file mode 100644 index d251c6c4..00000000 --- a/xemacs-packages/gnus/lisp/gnus-move.el +++ /dev/null @@ -1,187 +0,0 @@ -;;; gnus-move.el --- commands for moving Gnus from one server to another - -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) -(require 'gnus-start) -(require 'gnus-int) -(require 'gnus-range) - -;;; -;;; Moving by comparing Message-ID's. -;;; - -;;;###autoload -(defun gnus-change-server (from-server to-server) - "Move from FROM-SERVER to TO-SERVER. -Update the .newsrc.eld file to reflect the change of nntp server." - (interactive - (list gnus-select-method (gnus-read-method "Move to method: "))) - - ;; First start Gnus. - (let ((gnus-activate-level 0) - (mail-sources nil) - (nnmail-spool-file nil)) - (gnus)) - - (save-excursion - ;; Go through all groups and translate. - (let ((newsrc gnus-newsrc-alist) - (nntp-nov-gap nil) - info) - (while (setq info (pop newsrc)) - (when (gnus-group-native-p (gnus-info-group info)) - (gnus-move-group-to-server info from-server to-server)))))) - -(defun gnus-move-group-to-server (info from-server to-server) - "Move group INFO from FROM-SERVER to TO-SERVER." - (let ((group (gnus-info-group info)) - to-active hashtb type mark marks - to-article to-reads to-marks article - act-articles) - (gnus-message 7 "Translating %s..." group) - (when (gnus-request-group group nil to-server) - (setq to-active (gnus-parse-active) - hashtb (gnus-make-hashtable 1024) - act-articles (gnus-uncompress-range to-active)) - ;; Fetch the headers from the `to-server'. - (when (and to-active - act-articles - (setq type (gnus-retrieve-headers - act-articles - group to-server))) - ;; Convert HEAD headers. I don't care. - (when (eq type 'headers) - (nnvirtual-convert-headers)) - ;; Create a mapping from Message-ID to article number. - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (while (looking-at - "^[0-9]+\t[^\t]*\t[^\t]*\t[^\t]*\t\\([^\t]*\\)\t") - (gnus-sethash - (buffer-substring (match-beginning 1) (match-end 1)) - (read (current-buffer)) - hashtb) - (forward-line 1)) - ;; Then we read the headers from the `from-server'. - (when (and (gnus-request-group group nil from-server) - (gnus-active group) - (gnus-uncompress-range - (gnus-active group)) - (setq type (gnus-retrieve-headers - (gnus-uncompress-range - (gnus-active group)) - group from-server))) - ;; Make it easier to map marks. - (let ((mark-lists (gnus-info-marks info)) - ms type m) - (while mark-lists - (setq type (caar mark-lists) - ms (gnus-uncompress-range (cdr (pop mark-lists)))) - (while ms - (if (setq m (assq (car ms) marks)) - (setcdr m (cons type (cdr m))) - (push (list (car ms) type) marks)) - (pop ms)))) - ;; Convert. - (when (eq type 'headers) - (nnvirtual-convert-headers)) - ;; Go through the headers and map away. - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (while (looking-at - "^[0-9]+\t[^\t]*\t[^\t]*\t[^\t]*\t\\([^\t]*\\)\t") - (when (setq to-article - (gnus-gethash - (buffer-substring (match-beginning 1) (match-end 1)) - hashtb)) - ;; Add this article to the list of read articles. - (push to-article to-reads) - ;; See if there are any marks and then add them. - (when (setq mark (assq (read (current-buffer)) marks)) - (setq marks (delq mark marks)) - (setcar mark to-article) - (push mark to-marks)) - (forward-line 1))) - ;; Now we know what the read articles are and what the - ;; article marks are. We transform the information - ;; into the Gnus info format. - (setq to-reads - (gnus-range-add - (gnus-compress-sequence - (and (setq to-reads (delq nil to-reads)) - (sort to-reads '<)) - t) - (cons 1 (1- (car to-active))))) - (gnus-info-set-read info to-reads) - ;; Do the marks. I'm sure y'all understand what's - ;; going on down below, so I won't bother with any - ;; further comments. - (let ((mlists gnus-article-mark-lists) - lists ms a) - (while mlists - (push (list (cdr (pop mlists))) lists)) - (while (setq ms (pop marks)) - (setq article (pop ms)) - (while ms - (setcdr (setq a (assq (pop ms) lists)) - (cons article (cdr a))))) - (setq a lists) - (while a - (setcdr (car a) (gnus-compress-sequence - (and (cdar a) (sort (cdar a) '<)))) - (pop a)) - (gnus-info-set-marks info lists t))))) - (gnus-message 7 "Translating %s...done" group))) - -(defun gnus-group-move-group-to-server (info from-server to-server) - "Move the group on the current line from FROM-SERVER to TO-SERVER." - (interactive - (let ((info (gnus-get-info (gnus-group-group-name)))) - (list info (gnus-find-method-for-group (gnus-info-group info)) - (gnus-read-method (format "Move group %s to method: " - (gnus-info-group info)))))) - (save-excursion - (gnus-move-group-to-server info from-server to-server) - ;; We have to update the group info to point use the right server. - (gnus-info-set-method info to-server t) - ;; We also have to change the name of the group and stuff. - (let* ((group (gnus-info-group info)) - (new-name (gnus-group-prefixed-name - (gnus-group-real-name group) to-server))) - (gnus-info-set-group info new-name) - (gnus-sethash new-name (gnus-gethash group gnus-newsrc-hashtb) - gnus-newsrc-hashtb) - (gnus-sethash group nil gnus-newsrc-hashtb)))) - -(provide 'gnus-move) - -;;; arch-tag: 503742b8-7d66-4d79-bb31-4a698070707b -;;; gnus-move.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-msg.el b/xemacs-packages/gnus/lisp/gnus-msg.el deleted file mode 100644 index f60cbf2c..00000000 --- a/xemacs-packages/gnus/lisp/gnus-msg.el +++ /dev/null @@ -1,1971 +0,0 @@ -;;; gnus-msg.el --- mail and post interface for Gnus - -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Masanobu UMEDA -;; Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) -(require 'gnus-ems) -(require 'message) -(require 'gnus-art) -(require 'gnus-util) - -(defcustom gnus-post-method 'current - "*Preferred method for posting USENET news. - -If this variable is `current' (which is the default), Gnus will use -the \"current\" select method when posting. If it is `native', Gnus -will use the native select method when posting. - -This method will not be used in mail groups and the like, only in -\"real\" newsgroups. - -If not `native' nor `current', the value must be a valid method as discussed -in the documentation of `gnus-select-method'. It can also be a list of -methods. If that is the case, the user will be queried for what select -method to use when posting." - :group 'gnus-group-foreign - :link '(custom-manual "(gnus)Posting Server") - :type `(choice (const native) - (const current) - (sexp :tag "Methods" ,gnus-select-method))) - -(defcustom gnus-outgoing-message-group nil - "*All outgoing messages will be put in this group. -If you want to store all your outgoing mail and articles in the group -\"nnml:archive\", you set this variable to that value. This variable -can also be a list of group names. - -If you want to have greater control over what group to put each -message in, you can set this variable to a function that checks the -current newsgroup name and then returns a suitable group name (or list -of names)." - :group 'gnus-message - :type '(choice (const nil) - (function) - (string :tag "Group") - (repeat :tag "List of groups" (string :tag "Group")))) - -(defcustom gnus-mailing-list-groups nil - "*If non-nil a regexp matching groups that are really mailing lists. -This is useful when you're reading a mailing list that has been -gatewayed to a newsgroup, and you want to followup to an article in -the group." - :group 'gnus-message - :type '(choice (regexp) - (const nil))) - -(defcustom gnus-add-to-list nil - "*If non-nil, add a `to-list' parameter automatically." - :group 'gnus-message - :type 'boolean) - -(defcustom gnus-crosspost-complaint - "Hi, - -You posted the article below with the following Newsgroups header: - -Newsgroups: %s - -The %s group, at least, was an inappropriate recipient -of this message. Please trim your Newsgroups header to exclude this -group before posting in the future. - -Thank you. - -" - "Format string to be inserted when complaining about crossposts. -The first %s will be replaced by the Newsgroups header; -the second with the current group name." - :group 'gnus-message - :type 'string) - -(defcustom gnus-message-setup-hook nil - "Hook run after setting up a message buffer." - :group 'gnus-message - :type 'hook) - -(defcustom gnus-bug-create-help-buffer t - "*Should we create the *Gnus Help Bug* buffer?" - :group 'gnus-message - :type 'boolean) - -(defcustom gnus-posting-styles nil - "*Alist of styles to use when posting. -See Info node `(gnus)Posting Styles'." - :group 'gnus-message - :link '(custom-manual "(gnus)Posting Styles") - :type '(repeat (cons (choice (regexp) - (variable) - (list (const header) - (string :tag "Header") - (regexp :tag "Regexp")) - (function) - (sexp)) - (repeat (list - (choice (const signature) - (const signature-file) - (const organization) - (const address) - (const x-face-file) - (const name) - (const body) - (symbol) - (string :tag "Header")) - (choice (string) - (function) - (variable) - (sexp))))))) - -(defcustom gnus-gcc-mark-as-read nil - "If non-nil, automatically mark Gcc articles as read." - :version "22.1" - :group 'gnus-message - :type 'boolean) - -(make-obsolete-variable 'gnus-inews-mark-gcc-as-read - 'gnus-gcc-mark-as-read) - -(defcustom gnus-gcc-externalize-attachments nil - "Should local-file attachments be included as external parts in Gcc copies? -If it is `all', attach files as external parts; -if a regexp and matches the Gcc group name, attach files as external parts; -if nil, attach files as normal parts." - :version "22.1" - :group 'gnus-message - :type '(choice (const nil :tag "None") - (const all :tag "Any") - (string :tag "Regexp"))) - -(gnus-define-group-parameter - posting-charset-alist - :type list - :function-document - "Return the permitted unencoded charsets for posting of GROUP." - :variable gnus-group-posting-charset-alist - :variable-default - '(("^\\(no\\|fr\\)\\.[^,]*\\(,[ \t\n]*\\(no\\|fr\\)\\.[^,]*\\)*$" iso-8859-1 (iso-8859-1)) - ("^\\(fido7\\|relcom\\)\\.[^,]*\\(,[ \t\n]*\\(fido7\\|relcom\\)\\.[^,]*\\)*$" koi8-r (koi8-r)) - (message-this-is-mail nil nil) - (message-this-is-news nil t)) - :variable-document - "Alist of regexps and permitted unencoded charsets for posting. -Each element of the alist has the form (TEST HEADER BODY-LIST), where -TEST is either a regular expression matching the newsgroup header or a -variable to query, -HEADER is the charset which may be left unencoded in the header (nil -means encode all charsets), -BODY-LIST is a list of charsets which may be encoded using 8bit -content-transfer encoding in the body, or one of the special values -nil (always encode using quoted-printable) or t (always use 8bit). - -Note that any value other than nil for HEADER infringes some RFCs, so -use this option with care." - :variable-group gnus-charset - :variable-type - '(repeat (list :tag "Permitted unencoded charsets" - (choice :tag "Where" - (regexp :tag "Group") - (const :tag "Mail message" :value message-this-is-mail) - (const :tag "News article" :value message-this-is-news)) - (choice :tag "Header" - (const :tag "None" nil) - (symbol :tag "Charset")) - (choice :tag "Body" - (const :tag "Any" :value t) - (const :tag "None" :value nil) - (repeat :tag "Charsets" - (symbol :tag "Charset"))))) - :parameter-type '(choice :tag "Permitted unencoded charsets" - :value nil - (repeat (symbol))) - :parameter-document "\ -List of charsets that are permitted to be unencoded.") - -(defcustom gnus-debug-files - '("gnus.el" "gnus-sum.el" "gnus-group.el" - "gnus-art.el" "gnus-start.el" "gnus-async.el" - "gnus-msg.el" "gnus-score.el" "gnus-win.el" "gnus-topic.el" - "gnus-agent.el" "gnus-cache.el" "gnus-srvr.el" - "mm-util.el" "mm-decode.el" "nnmail.el" "message.el") - "Files whose variables will be reported in `gnus-bug'." - :version "22.1" - :group 'gnus-message - :type '(repeat (string :tag "File"))) - -(defcustom gnus-debug-exclude-variables - '(mm-mime-mule-charset-alist - nnmail-split-fancy message-minibuffer-local-map) - "Variables that should not be reported in `gnus-bug'." - :version "22.1" - :group 'gnus-message - :type '(repeat (symbol :tag "Variable"))) - -(defcustom gnus-discouraged-post-methods - '(nndraft nnml nnimap nnmaildir nnmh nnfolder nndir) - "A list of back ends that are not used in \"real\" newsgroups. -This variable is used only when `gnus-post-method' is `current'." - :version "22.1" - :group 'gnus-group-foreign - :type '(repeat (symbol :tag "Back end"))) - -(defcustom gnus-message-replysign - nil - "Automatically sign replies to signed messages. -See also the `mml-default-sign-method' variable." - :group 'gnus-message - :type 'boolean) - -(defcustom gnus-message-replyencrypt - nil - "Automatically encrypt replies to encrypted messages. -See also the `mml-default-encrypt-method' variable." - :group 'gnus-message - :type 'boolean) - -(defcustom gnus-message-replysignencrypted - t - "Setting this causes automatically encrypted messages to also be signed." - :group 'gnus-message - :type 'boolean) - -(defcustom gnus-confirm-mail-reply-to-news nil - "If non-nil, Gnus requests confirmation when replying to news. -This is done because new users often reply by mistake when reading -news. -This can also be a function receiving the group name as the only -parameter, which should return non-nil if a confirmation is needed; or -a regexp, in which case a confirmation is asked for if the group name -matches the regexp." - :version "22.1" - :group 'gnus-message - :type '(choice (const :tag "No" nil) - (const :tag "Yes" t) - (regexp :tag "If group matches regexp") - (function :tag "If function evaluates to non-nil"))) - -(defcustom gnus-confirm-treat-mail-like-news - nil - "If non-nil, Gnus will treat mail like news with regard to confirmation -when replying by mail. See the `gnus-confirm-mail-reply-to-news' variable -for fine-tuning this. -If nil, Gnus will never ask for confirmation if replying to mail." - :version "22.1" - :group 'gnus-message - :type 'boolean) - -(defcustom gnus-summary-resend-default-address t - "If non-nil, Gnus tries to suggest a default address to resend to. -If nil, the address field will always be empty after invoking -`gnus-summary-resend-message'." - :version "22.1" - :group 'gnus-message - :type 'boolean) - -;;; Internal variables. - -(defvar gnus-inhibit-posting-styles nil - "Inhibit the use of posting styles.") - -(defvar gnus-article-yanked-articles nil) -(defvar gnus-message-buffer "*Mail Gnus*") -(defvar gnus-article-copy nil) -(defvar gnus-check-before-posting nil) -(defvar gnus-last-posting-server nil) -(defvar gnus-message-group-art nil) - -(defvar gnus-msg-force-broken-reply-to nil) - -(defconst gnus-bug-message - "Sending a bug report to the Gnus Towers. -======================================== - -The buffer below is a mail buffer. When you press `C-c C-c', it will -be sent to the Gnus Bug Exterminators. - -The thing near the bottom of the buffer is how the environment -settings will be included in the mail. Please do not delete that. -They will tell the Bug People what your environment is, so that it -will be easier to locate the bugs. - -If you have found a bug that makes Emacs go \"beep\", set -debug-on-error to t (`M-x set-variable RET debug-on-error RET t RET') -and include the backtrace in your bug report. - -Please describe the bug in annoying, painstaking detail. - -Thank you for your help in stamping out bugs. -") - -(eval-and-compile - (autoload 'gnus-uu-post-news "gnus-uu" nil t) - (autoload 'news-setup "rnewspost") - (autoload 'news-reply-mode "rnewspost") - (autoload 'rmail-dont-reply-to "mail-utils") - (autoload 'rmail-output "rmailout")) - - -;;; -;;; Gnus Posting Functions -;;; - -(gnus-define-keys (gnus-summary-send-map "S" gnus-summary-mode-map) - "p" gnus-summary-post-news - "i" gnus-summary-news-other-window - "f" gnus-summary-followup - "F" gnus-summary-followup-with-original - "c" gnus-summary-cancel-article - "s" gnus-summary-supersede-article - "r" gnus-summary-reply - "y" gnus-summary-yank-message - "R" gnus-summary-reply-with-original - "w" gnus-summary-wide-reply - "W" gnus-summary-wide-reply-with-original - "v" gnus-summary-very-wide-reply - "V" gnus-summary-very-wide-reply-with-original - "n" gnus-summary-followup-to-mail - "N" gnus-summary-followup-to-mail-with-original - "m" gnus-summary-mail-other-window - "u" gnus-uu-post-news - "\M-c" gnus-summary-mail-crosspost-complaint - "Br" gnus-summary-reply-broken-reply-to - "BR" gnus-summary-reply-broken-reply-to-with-original - "om" gnus-summary-mail-forward - "op" gnus-summary-post-forward - "Om" gnus-uu-digest-mail-forward - "Op" gnus-uu-digest-post-forward) - -(gnus-define-keys (gnus-send-bounce-map "D" gnus-summary-send-map) - "b" gnus-summary-resend-bounced-mail - ;; "c" gnus-summary-send-draft - "r" gnus-summary-resend-message - "e" gnus-summary-resend-message-edit) - -;;; Internal functions. - -(defun gnus-inews-make-draft () - `(lambda () - (gnus-inews-make-draft-meta-information - ,gnus-newsgroup-name ',gnus-article-reply))) - -(defvar gnus-article-reply nil) -(defmacro gnus-setup-message (config &rest forms) - (let ((winconf (make-symbol "gnus-setup-message-winconf")) - (buffer (make-symbol "gnus-setup-message-buffer")) - (article (make-symbol "gnus-setup-message-article")) - (yanked (make-symbol "gnus-setup-yanked-articles")) - (group (make-symbol "gnus-setup-message-group"))) - `(let ((,winconf (current-window-configuration)) - (,buffer (buffer-name (current-buffer))) - (,article gnus-article-reply) - (,yanked gnus-article-yanked-articles) - (,group gnus-newsgroup-name) - (message-header-setup-hook - (copy-sequence message-header-setup-hook)) - (mbl mml-buffer-list) - (message-mode-hook (copy-sequence message-mode-hook))) - (setq mml-buffer-list nil) - (add-hook 'message-header-setup-hook 'gnus-inews-insert-gcc) - (add-hook 'message-header-setup-hook 'gnus-inews-insert-archive-gcc) - ;; message-newsreader and message-mailer were formerly set in - ;; gnus-inews-add-send-actions, but this is too late when - ;; message-generate-headers-first is used. --ansel - (add-hook 'message-mode-hook - (lambda nil - (setq message-newsreader - (setq message-mailer (gnus-extended-version))))) - ;; #### FIXME: for a reason that I did not manage to identify yet, - ;; the variable `gnus-newsgroup-name' does not honor a dynamically - ;; scoped or setq'ed value from a caller like `C-u gnus-summary-mail'. - ;; After evaluation of @forms below, it gets the value we actually want - ;; to override, and the posting styles are used. For that reason, I've - ;; added an optional argument to `gnus-configure-posting-styles' to - ;; make sure that the correct value for the group name is used. -- drv - (add-hook 'message-mode-hook - (if (memq ,config '(reply-yank reply)) - (lambda () - (gnus-configure-posting-styles ,group)) - (lambda () - ;; There may be an old " *gnus article copy*" buffer. - (let (gnus-article-copy) - (gnus-configure-posting-styles ,group))))) - (gnus-pull ',(intern gnus-draft-meta-information-header) - message-required-headers) - (when (and ,group - (not (string= ,group ""))) - (push (cons - (intern gnus-draft-meta-information-header) - (gnus-inews-make-draft)) - message-required-headers)) - (unwind-protect - (progn - ,@forms) - (gnus-inews-add-send-actions ,winconf ,buffer ,article ,config - ,yanked) - (setq gnus-message-buffer (current-buffer)) - (set (make-local-variable 'gnus-message-group-art) - (cons ,group ,article)) - (set (make-local-variable 'gnus-newsgroup-name) ,group) - (gnus-run-hooks 'gnus-message-setup-hook) - (if (eq major-mode 'message-mode) - (let ((mbl1 mml-buffer-list)) - (setq mml-buffer-list mbl) ;; Global value - (set (make-local-variable 'mml-buffer-list) mbl1);; Local value - (gnus-make-local-hook 'kill-buffer-hook) - (gnus-make-local-hook 'change-major-mode-hook) - (add-hook 'change-major-mode-hook 'mml-destroy-buffers nil t) - (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)) - (mml-destroy-buffers) - (setq mml-buffer-list mbl))) - (message-hide-headers) - (gnus-add-buffer) - (gnus-configure-windows ,config t) - (run-hooks 'post-command-hook) - (set-buffer-modified-p nil)))) - -(defun gnus-inews-make-draft-meta-information (group article) - (concat "(\"" group "\" " - (if article (number-to-string - (if (listp article) - (car article) - article)) "\"\"") - ")")) - -;;;###autoload -(defun gnus-msg-mail (&optional to subject other-headers continue - switch-action yank-action send-actions) - "Start editing a mail message to be sent. -Like `message-mail', but with Gnus paraphernalia, particularly the -Gcc: header for archiving purposes." - (interactive) - (let ((buf (current-buffer)) - mail-buf) - (gnus-setup-message 'message - (message-mail to subject other-headers continue - nil yank-action send-actions)) - (when switch-action - (setq mail-buf (current-buffer)) - (switch-to-buffer buf) - (apply switch-action mail-buf nil))) - ;; COMPOSEFUNC should return t if succeed. Undocumented ??? - t) - -;;;###autoload -(defun gnus-button-mailto (address) - "Mail to ADDRESS." - (set-buffer (gnus-copy-article-buffer)) - (gnus-setup-message 'message - (message-reply address))) - -;;;###autoload -(defun gnus-button-reply (&optional to-address wide) - "Like `message-reply'." - (interactive) - (gnus-setup-message 'message - (message-reply to-address wide))) - -;;;###autoload -(define-mail-user-agent 'gnus-user-agent - 'gnus-msg-mail 'message-send-and-exit - 'message-kill-buffer 'message-send-hook) - -(defun gnus-setup-posting-charset (group) - (let ((alist gnus-group-posting-charset-alist) - (group (or group "")) - elem) - (when group - (catch 'found - (while (setq elem (pop alist)) - (when (or (and (stringp (car elem)) - (string-match (car elem) group)) - (and (functionp (car elem)) - (funcall (car elem) group)) - (and (symbolp (car elem)) - (symbol-value (car elem)))) - (throw 'found (cons (cadr elem) (caddr elem))))))))) - -(defun gnus-inews-add-send-actions (winconf buffer article - &optional config yanked) - (gnus-make-local-hook 'message-sent-hook) - (add-hook 'message-sent-hook (if gnus-agent 'gnus-agent-possibly-do-gcc - 'gnus-inews-do-gcc) nil t) - (when gnus-agent - (gnus-make-local-hook 'message-header-hook) - (add-hook 'message-header-hook 'gnus-agent-possibly-save-gcc nil t)) - (setq message-post-method - `(lambda (arg) - (gnus-post-method arg ,gnus-newsgroup-name))) - (message-add-action - `(when (gnus-buffer-exists-p ,buffer) - (set-window-configuration ,winconf)) - 'exit 'postpone 'kill) - (let ((to-be-marked (cond - (yanked - (mapcar - (lambda (x) (if (listp x) (car x) x)) yanked)) - (article (if (listp article) article (list article))) - (t nil)))) - (message-add-action - `(when (gnus-buffer-exists-p ,buffer) - (save-excursion - (set-buffer ,buffer) - ,(when to-be-marked - (if (eq config 'forward) - `(gnus-summary-mark-article-as-forwarded ',to-be-marked) - `(gnus-summary-mark-article-as-replied ',to-be-marked))))) - 'send))) - -(put 'gnus-setup-message 'lisp-indent-function 1) -(put 'gnus-setup-message 'edebug-form-spec '(form body)) - -;;; Post news commands of Gnus group mode and summary mode - -(defun gnus-group-mail (&optional arg) - "Start composing a mail. -If ARG, use the group under the point to find a posting style. -If ARG is 1, prompt for a group name to find the posting style." - (interactive "P") - ;; We can't `let' gnus-newsgroup-name here, since that leads - ;; to local variables leaking. - (let ((group gnus-newsgroup-name) - ;; make sure last viewed article doesn't affect posting styles: - (gnus-article-copy) - (buffer (current-buffer))) - (unwind-protect - (progn - (setq gnus-newsgroup-name - (if arg - (if (= 1 (prefix-numeric-value arg)) - (completing-read "Use posting style of group: " - gnus-active-hashtb nil - (gnus-read-active-file-p)) - (gnus-group-group-name)) - "")) - ;; #### see comment in gnus-setup-message -- drv - (gnus-setup-message 'message (message-mail))) - (save-excursion - (set-buffer buffer) - (setq gnus-newsgroup-name group))))) - -(defun gnus-group-news (&optional arg) - "Start composing a news. -If ARG, post to group under point. -If ARG is 1, prompt for group name to post to. - -This function prepares a news even when using mail groups. This is useful -for posting messages to mail groups without actually sending them over the -network. The corresponding back end must have a 'request-post method." - (interactive "P") - ;; We can't `let' gnus-newsgroup-name here, since that leads - ;; to local variables leaking. - (let ((group gnus-newsgroup-name) - ;; make sure last viewed article doesn't affect posting styles: - (gnus-article-copy) - (buffer (current-buffer))) - (unwind-protect - (progn - (setq gnus-newsgroup-name - (if arg - (if (= 1 (prefix-numeric-value arg)) - (completing-read "Use group: " - gnus-active-hashtb nil - (gnus-read-active-file-p)) - (gnus-group-group-name)) - "")) - ;; #### see comment in gnus-setup-message -- drv - (gnus-setup-message 'message - (message-news (gnus-group-real-name gnus-newsgroup-name)))) - (save-excursion - (set-buffer buffer) - (setq gnus-newsgroup-name group))))) - -(defun gnus-group-post-news (&optional arg) - "Start composing a message (a news by default). -If ARG, post to group under point. If ARG is 1, prompt for group name. -Depending on the selected group, the message might be either a mail or -a news." - (interactive "P") - ;; Bind this variable here to make message mode hooks work ok. - (let ((gnus-newsgroup-name - (if arg - (if (= 1 (prefix-numeric-value arg)) - (completing-read "Newsgroup: " gnus-active-hashtb nil - (gnus-read-active-file-p)) - (gnus-group-group-name)) - "")) - ;; make sure last viewed article doesn't affect posting styles: - (gnus-article-copy)) - (gnus-post-news 'post gnus-newsgroup-name nil nil nil nil - (string= gnus-newsgroup-name "")))) - -(defun gnus-summary-mail-other-window (&optional arg) - "Start composing a mail in another window. -Use the posting of the current group by default. -If ARG, don't do that. If ARG is 1, prompt for group name to find the -posting style." - (interactive "P") - ;; We can't `let' gnus-newsgroup-name here, since that leads - ;; to local variables leaking. - (let ((group gnus-newsgroup-name) - ;; make sure last viewed article doesn't affect posting styles: - (gnus-article-copy) - (buffer (current-buffer))) - (unwind-protect - (progn - (setq gnus-newsgroup-name - (if arg - (if (= 1 (prefix-numeric-value arg)) - (completing-read "Use group: " - gnus-active-hashtb nil - (gnus-read-active-file-p)) - "") - gnus-newsgroup-name)) - ;; #### see comment in gnus-setup-message -- drv - (gnus-setup-message 'message (message-mail))) - (save-excursion - (set-buffer buffer) - (setq gnus-newsgroup-name group))))) - -(defun gnus-summary-news-other-window (&optional arg) - "Start composing a news in another window. -Post to the current group by default. -If ARG, don't do that. If ARG is 1, prompt for group name to post to. - -This function prepares a news even when using mail groups. This is useful -for posting messages to mail groups without actually sending them over the -network. The corresponding back end must have a 'request-post method." - (interactive "P") - ;; We can't `let' gnus-newsgroup-name here, since that leads - ;; to local variables leaking. - (let ((group gnus-newsgroup-name) - ;; make sure last viewed article doesn't affect posting styles: - (gnus-article-copy) - (buffer (current-buffer))) - (unwind-protect - (progn - (setq gnus-newsgroup-name - (if arg - (if (= 1 (prefix-numeric-value arg)) - (completing-read "Use group: " - gnus-active-hashtb nil - (gnus-read-active-file-p)) - "") - gnus-newsgroup-name)) - ;; #### see comment in gnus-setup-message -- drv - (gnus-setup-message 'message - (progn - (message-news (gnus-group-real-name gnus-newsgroup-name)) - (set (make-local-variable 'gnus-discouraged-post-methods) - (delq - (car (gnus-find-method-for-group gnus-newsgroup-name)) - (copy-sequence gnus-discouraged-post-methods)))))) - (save-excursion - (set-buffer buffer) - (setq gnus-newsgroup-name group))))) - -(defun gnus-summary-post-news (&optional arg) - "Start composing a message. Post to the current group by default. -If ARG, don't do that. If ARG is 1, prompt for a group name to post to. -Depending on the selected group, the message might be either a mail or -a news." - (interactive "P") - ;; Bind this variable here to make message mode hooks work ok. - (let ((gnus-newsgroup-name - (if arg - (if (= 1 (prefix-numeric-value arg)) - (completing-read "Newsgroup: " gnus-active-hashtb nil - (gnus-read-active-file-p)) - "") - gnus-newsgroup-name)) - ;; make sure last viewed article doesn't affect posting styles: - (gnus-article-copy)) - (gnus-post-news 'post gnus-newsgroup-name))) - - -(defun gnus-summary-followup (yank &optional force-news) - "Compose a followup to an article. -If prefix argument YANK is non-nil, the original article is yanked -automatically. -YANK is a list of elements, where the car of each element is the -article number, and the cdr is the string to be yanked." - (interactive - (list (and current-prefix-arg - (gnus-summary-work-articles 1)))) - (when yank - (gnus-summary-goto-subject - (if (listp (car yank)) - (caar yank) - (car yank)))) - (save-window-excursion - (gnus-summary-select-article)) - (let ((headers (gnus-summary-article-header (gnus-summary-article-number))) - (gnus-newsgroup-name gnus-newsgroup-name)) - ;; Send a followup. - (gnus-post-news nil gnus-newsgroup-name - headers gnus-article-buffer - yank nil force-news) - (gnus-summary-handle-replysign))) - -(defun gnus-summary-followup-with-original (n &optional force-news) - "Compose a followup to an article and include the original article. -The text in the region will be yanked. If the region isn't -active, the entire article will be yanked." - (interactive "P") - (gnus-summary-followup (gnus-summary-work-articles n) force-news)) - -(defun gnus-summary-followup-to-mail (&optional arg) - "Followup to the current mail message via news." - (interactive - (list (and current-prefix-arg - (gnus-summary-work-articles 1)))) - (gnus-summary-followup arg t)) - -(defun gnus-summary-followup-to-mail-with-original (&optional arg) - "Followup to the current mail message via news." - (interactive "P") - (gnus-summary-followup (gnus-summary-work-articles arg) t)) - -(defun gnus-inews-yank-articles (articles) - (let (beg article yank-string) - (message-goto-body) - (while (setq article (pop articles)) - (when (listp article) - (setq yank-string (nth 1 article) - article (nth 0 article))) - (save-window-excursion - (set-buffer gnus-summary-buffer) - (gnus-summary-select-article nil nil nil article) - (gnus-summary-remove-process-mark article)) - (gnus-copy-article-buffer nil yank-string) - (let ((message-reply-buffer gnus-article-copy) - (message-reply-headers - ;; The headers are decoded. - (with-current-buffer gnus-article-copy - (save-restriction - (nnheader-narrow-to-headers) - (nnheader-parse-naked-head))))) - (message-yank-original) - (message-exchange-point-and-mark) - (setq beg (or beg (mark t)))) - (when articles - (insert "\n"))) - (push-mark) - (goto-char beg))) - -(defun gnus-summary-cancel-article (&optional n symp) - "Cancel an article you posted. -Uses the process-prefix convention. If given the symbolic -prefix `a', cancel using the standard posting method; if not -post using the current select method." - (interactive (gnus-interactive "P\ny")) - (let ((articles (gnus-summary-work-articles n)) - (message-post-method - `(lambda (arg) - (gnus-post-method (eq ',symp 'a) ,gnus-newsgroup-name))) - article) - (while (setq article (pop articles)) - (when (gnus-summary-select-article t nil nil article) - (when (gnus-eval-in-buffer-window gnus-original-article-buffer - (message-cancel-news)) - (gnus-summary-mark-as-read article gnus-canceled-mark) - (gnus-cache-remove-article 1)) - (gnus-article-hide-headers-if-wanted)) - (gnus-summary-remove-process-mark article)))) - -(defun gnus-summary-supersede-article () - "Compose an article that will supersede a previous article. -This is done simply by taking the old article and adding a Supersedes -header line with the old Message-ID." - (interactive) - (let ((article (gnus-summary-article-number))) - (gnus-setup-message 'reply-yank - (gnus-summary-select-article t) - (set-buffer gnus-original-article-buffer) - (message-supersede) - (push - `((lambda () - (when (gnus-buffer-exists-p ,gnus-summary-buffer) - (save-excursion - (set-buffer ,gnus-summary-buffer) - (gnus-cache-possibly-remove-article ,article nil nil nil t) - (gnus-summary-mark-as-read ,article gnus-canceled-mark))))) - message-send-actions) - ;; Add Gcc header. - (gnus-inews-insert-archive-gcc) - (gnus-inews-insert-gcc)))) - - - -(defun gnus-copy-article-buffer (&optional article-buffer yank-string) - ;; make a copy of the article buffer with all text properties removed - ;; this copy is in the buffer gnus-article-copy. - ;; if ARTICLE-BUFFER is nil, gnus-article-buffer is used - ;; this buffer should be passed to all mail/news reply/post routines. - (setq gnus-article-copy (gnus-get-buffer-create " *gnus article copy*")) - (save-excursion - (set-buffer gnus-article-copy) - (mm-enable-multibyte)) - (let ((article-buffer (or article-buffer gnus-article-buffer)) - end beg) - (if (not (and (get-buffer article-buffer) - (gnus-buffer-exists-p article-buffer))) - (error "Can't find any article buffer") - (save-excursion - (set-buffer article-buffer) - (let ((gnus-newsgroup-charset (or gnus-article-charset - gnus-newsgroup-charset)) - (gnus-newsgroup-ignored-charsets - (or gnus-article-ignored-charsets - gnus-newsgroup-ignored-charsets))) - (save-restriction - ;; Copy over the (displayed) article buffer, delete - ;; hidden text and remove text properties. - (widen) - (copy-to-buffer gnus-article-copy (point-min) (point-max)) - (set-buffer gnus-article-copy) - (when yank-string - (message-goto-body) - (delete-region (point) (point-max)) - (insert yank-string)) - (gnus-article-delete-text-of-type 'annotation) - (gnus-article-delete-text-of-type 'multipart) - (gnus-remove-text-with-property 'gnus-prev) - (gnus-remove-text-with-property 'gnus-next) - (gnus-remove-text-with-property 'gnus-decoration) - (insert - (prog1 - (buffer-substring-no-properties (point-min) (point-max)) - (erase-buffer))) - ;; Find the original headers. - (set-buffer gnus-original-article-buffer) - (goto-char (point-min)) - (while (looking-at message-unix-mail-delimiter) - (forward-line 1)) - (let ((mail-header-separator "")) - (setq beg (point) - end (or (message-goto-body) - ;; There may be just a header. - (point-max)))) - ;; Delete the headers from the displayed articles. - (set-buffer gnus-article-copy) - (let ((mail-header-separator "")) - (delete-region (goto-char (point-min)) - (or (message-goto-body) (point-max)))) - ;; Insert the original article headers. - (insert-buffer-substring gnus-original-article-buffer beg end) - ;; Decode charsets. - (let ((gnus-article-decode-hook - (delq 'article-decode-charset - (copy-sequence gnus-article-decode-hook))) - (rfc2047-quote-decoded-words-containing-tspecials t)) - (run-hooks 'gnus-article-decode-hook))))) - gnus-article-copy))) - -(defun gnus-post-news (post &optional group header article-buffer yank subject - force-news) - (when article-buffer - (gnus-copy-article-buffer)) - (let ((gnus-article-reply (and article-buffer (gnus-summary-article-number))) - (gnus-article-yanked-articles yank) - (add-to-list gnus-add-to-list)) - (gnus-setup-message (cond (yank 'reply-yank) - (article-buffer 'reply) - (t 'message)) - (let* ((group (or group gnus-newsgroup-name)) - (charset (gnus-group-name-charset nil group)) - (pgroup group) - to-address to-group mailing-list to-list - newsgroup-p) - (when group - (setq to-address (gnus-parameter-to-address group) - to-group (gnus-group-find-parameter group 'to-group) - to-list (gnus-parameter-to-list group) - newsgroup-p (gnus-group-find-parameter group 'newsgroup) - mailing-list (when gnus-mailing-list-groups - (string-match gnus-mailing-list-groups group)) - group (gnus-group-name-decode (gnus-group-real-name group) - charset))) - (if (or (and to-group - (gnus-news-group-p to-group)) - newsgroup-p - force-news - (and (gnus-news-group-p - (or pgroup gnus-newsgroup-name) - (or header gnus-current-article)) - (not mailing-list) - (not to-list) - (not to-address))) - ;; This is news. - (if post - (message-news - (or to-group - (and (not (gnus-virtual-group-p pgroup)) group))) - (set-buffer gnus-article-copy) - (gnus-msg-treat-broken-reply-to) - (message-followup (if (or newsgroup-p force-news) - (if (save-restriction - (article-narrow-to-head) - (message-fetch-field "newsgroups")) - nil - "") - to-group))) - ;; The is mail. - (if post - (progn - (message-mail (or to-address to-list)) - ;; Arrange for mail groups that have no `to-address' to - ;; get that when the user sends off the mail. - (when (and (not to-list) - (not to-address) - add-to-list) - (push (list 'gnus-inews-add-to-address pgroup) - message-send-actions))) - (set-buffer gnus-article-copy) - (gnus-msg-treat-broken-reply-to) - (message-wide-reply to-address))) - (when yank - (gnus-inews-yank-articles yank)))))) - -(defun gnus-msg-treat-broken-reply-to (&optional force) - "Remove the Reply-to header if broken-reply-to." - (when (or force - (gnus-group-find-parameter - gnus-newsgroup-name 'broken-reply-to)) - (save-restriction - (message-narrow-to-head) - (message-remove-header "reply-to")))) - -(defun gnus-post-method (arg group &optional silent) - "Return the posting method based on GROUP and ARG. -If SILENT, don't prompt the user." - (let ((gnus-post-method (or (gnus-parameter-post-method group) - gnus-post-method)) - (group-method (gnus-find-method-for-group group))) - (cond - ;; If the group-method is nil (which shouldn't happen) we use - ;; the default method. - ((null group-method) - (or (and (listp gnus-post-method) ;If not current/native/nil - (not (listp (car gnus-post-method))) ; and not a list of methods - gnus-post-method) ;then use it. - gnus-select-method - message-post-method)) - ;; We want the inverse of the default - ((and arg (not (eq arg 0))) - (if (eq gnus-post-method 'current) - gnus-select-method - group-method)) - ;; We query the user for a post method. - ((or arg - (and (listp gnus-post-method) - (listp (car gnus-post-method)))) - (let* ((methods - ;; Collect all methods we know about. - (append - (when (listp gnus-post-method) - (if (listp (car gnus-post-method)) - gnus-post-method - (list gnus-post-method))) - gnus-secondary-select-methods - (mapcar 'cdr gnus-server-alist) - (mapcar 'car gnus-opened-servers) - (list gnus-select-method) - (list group-method))) - method-alist post-methods method) - ;; Weed out all mail methods. - (while methods - (setq method (gnus-server-get-method "" (pop methods))) - (when (and (or (gnus-method-option-p method 'post) - (gnus-method-option-p method 'post-mail)) - (not (member method post-methods))) - (push method post-methods))) - ;; Create a name-method alist. - (setq method-alist - (mapcar - (lambda (m) - (if (equal (cadr m) "") - (list (symbol-name (car m)) m) - (list (concat (cadr m) " (" (symbol-name (car m)) ")") m))) - post-methods)) - ;; Query the user. - (cadr - (assoc - (setq gnus-last-posting-server - (if (and silent - gnus-last-posting-server) - ;; Just use the last value. - gnus-last-posting-server - (completing-read - "Posting method: " method-alist nil t - (cons (or gnus-last-posting-server "") 0)))) - method-alist)))) - ;; Override normal method. - ((and (eq gnus-post-method 'current) - (not (memq (car group-method) gnus-discouraged-post-methods)) - (gnus-get-function group-method 'request-post t)) - (assert (not arg)) - group-method) - ;; Use gnus-post-method. - ((listp gnus-post-method) ;A method... - (assert (not (listp (car gnus-post-method)))) ;... not a list of methods. - gnus-post-method) - ;; Use the normal select method (nil or native). - (t gnus-select-method)))) - - - -(defun gnus-extended-version () - "Stringified Gnus version and Emacs version. -See the variable `gnus-user-agent'." - (interactive) - (if (stringp gnus-user-agent) - gnus-user-agent - ;; `gnus-user-agent' is a list: - (let* ((float-output-format nil) - (gnus-v - (when (memq 'gnus gnus-user-agent) - (concat "Gnus/" - (prin1-to-string (gnus-continuum-version gnus-version) t) - " (" gnus-version ")"))) - (emacs-v (gnus-emacs-version))) - (concat gnus-v (when (and gnus-v emacs-v) " ") - emacs-v)))) - - -;;; -;;; Gnus Mail Functions -;;; - -;;; Mail reply commands of Gnus summary mode - -(defun gnus-summary-reply (&optional yank wide very-wide) - "Start composing a mail reply to the current message. -If prefix argument YANK is non-nil, the original article is yanked -automatically. -If WIDE, make a wide reply. -If VERY-WIDE, make a very wide reply." - (interactive - (list (and current-prefix-arg - (gnus-summary-work-articles 1)))) - ;; Allow user to require confirmation before replying by mail to the - ;; author of a news article (or mail message). - (when (or - (not (or (gnus-news-group-p gnus-newsgroup-name) - gnus-confirm-treat-mail-like-news)) - (not (cond ((stringp gnus-confirm-mail-reply-to-news) - (string-match gnus-confirm-mail-reply-to-news - gnus-newsgroup-name)) - ((functionp gnus-confirm-mail-reply-to-news) - (funcall gnus-confirm-mail-reply-to-news gnus-newsgroup-name)) - (t gnus-confirm-mail-reply-to-news))) - (y-or-n-p "Really reply by mail to article author? ")) - (let* ((article - (if (listp (car yank)) - (caar yank) - (car yank))) - (gnus-article-reply (or article (gnus-summary-article-number))) - (gnus-article-yanked-articles yank) - (headers "")) - ;; Stripping headers should be specified with mail-yank-ignored-headers. - (when yank - (gnus-summary-goto-subject article)) - (gnus-setup-message (if yank 'reply-yank 'reply) - (if (not very-wide) - (gnus-summary-select-article) - (dolist (article very-wide) - (gnus-summary-select-article nil nil nil article) - (save-excursion - (set-buffer (gnus-copy-article-buffer)) - (gnus-msg-treat-broken-reply-to) - (save-restriction - (message-narrow-to-head) - (setq headers (concat headers (buffer-string))))))) - (set-buffer (gnus-copy-article-buffer)) - (gnus-msg-treat-broken-reply-to gnus-msg-force-broken-reply-to) - (save-restriction - (message-narrow-to-head) - (when very-wide - (erase-buffer) - (insert headers)) - (goto-char (point-max))) - (mml-quote-region (point) (point-max)) - (message-reply nil wide) - (when yank - (gnus-inews-yank-articles yank)) - (gnus-summary-handle-replysign))))) - -(defun gnus-summary-handle-replysign () - "Check the various replysign variables and take action accordingly." - (when (or gnus-message-replysign gnus-message-replyencrypt) - (let (signed encrypted) - (save-excursion - (set-buffer gnus-article-buffer) - (setq signed (memq 'signed gnus-article-wash-types)) - (setq encrypted (memq 'encrypted gnus-article-wash-types))) - (cond ((and gnus-message-replyencrypt encrypted) - (mml-secure-message mml-default-encrypt-method - (if gnus-message-replysignencrypted - 'signencrypt - 'encrypt))) - ((and gnus-message-replysign signed) - (mml-secure-message mml-default-sign-method 'sign)))))) - -(defun gnus-summary-reply-with-original (n &optional wide) - "Start composing a reply mail to the current message. -The original article will be yanked." - (interactive "P") - (gnus-summary-reply (gnus-summary-work-articles n) wide)) - -(defun gnus-summary-reply-broken-reply-to (&optional yank wide very-wide) - "Like `gnus-summary-reply' except removing reply-to field. -If prefix argument YANK is non-nil, the original article is yanked -automatically. -If WIDE, make a wide reply. -If VERY-WIDE, make a very wide reply." - (interactive - (list (and current-prefix-arg - (gnus-summary-work-articles 1)))) - (let ((gnus-msg-force-broken-reply-to t)) - (gnus-summary-reply yank wide very-wide))) - -(defun gnus-summary-reply-broken-reply-to-with-original (n &optional wide) - "Like `gnus-summary-reply-with-original' except removing reply-to field. -The original article will be yanked." - (interactive "P") - (gnus-summary-reply-broken-reply-to (gnus-summary-work-articles n) wide)) - -(defun gnus-summary-wide-reply (&optional yank) - "Start composing a wide reply mail to the current message. -If prefix argument YANK is non-nil, the original article is yanked -automatically." - (interactive - (list (and current-prefix-arg - (gnus-summary-work-articles 1)))) - (gnus-summary-reply yank t)) - -(defun gnus-summary-wide-reply-with-original (n) - "Start composing a wide reply mail to the current message. -The original article will be yanked. -Uses the process/prefix convention." - (interactive "P") - (gnus-summary-reply-with-original n t)) - -(defun gnus-summary-very-wide-reply (&optional yank) - "Start composing a very wide reply mail to the current message. -If prefix argument YANK is non-nil, the original article is yanked -automatically." - (interactive - (list (and current-prefix-arg - (gnus-summary-work-articles 1)))) - (gnus-summary-reply yank t (gnus-summary-work-articles yank))) - -(defun gnus-summary-very-wide-reply-with-original (n) - "Start composing a very wide reply mail to the current message. -The original article will be yanked." - (interactive "P") - (gnus-summary-reply - (gnus-summary-work-articles n) t (gnus-summary-work-articles n))) - -(defun gnus-summary-mail-forward (&optional arg post) - "Forward the current message(s) to another user. -If process marks exist, forward all marked messages; -if ARG is nil, see `message-forward-as-mime' and `message-forward-show-mml'; -if ARG is 1, decode the message and forward directly inline; -if ARG is 2, forward message as an rfc822 MIME section; -if ARG is 3, decode message and forward as an rfc822 MIME section; -if ARG is 4, forward message directly inline; -otherwise, use flipped `message-forward-as-mime'. -If POST, post instead of mail. -For the `inline' alternatives, also see the variable -`message-forward-ignored-headers'." - (interactive "P") - (if (cdr (gnus-summary-work-articles nil)) - ;; Process marks are given. - (gnus-uu-digest-mail-forward arg post) - ;; No process marks. - (let ((message-forward-as-mime message-forward-as-mime) - (message-forward-show-mml message-forward-show-mml)) - (cond - ((null arg)) - ((eq arg 1) - (setq message-forward-as-mime nil - message-forward-show-mml t)) - ((eq arg 2) - (setq message-forward-as-mime t - message-forward-show-mml nil)) - ((eq arg 3) - (setq message-forward-as-mime t - message-forward-show-mml t)) - ((eq arg 4) - (setq message-forward-as-mime nil - message-forward-show-mml nil)) - (t - (setq message-forward-as-mime (not message-forward-as-mime)))) - (let* ((gnus-article-reply (gnus-summary-article-number)) - (gnus-article-yanked-articles (list gnus-article-reply))) - (gnus-setup-message 'forward - (gnus-summary-select-article) - (let ((mail-parse-charset - (or (and (gnus-buffer-live-p gnus-article-buffer) - (with-current-buffer gnus-article-buffer - gnus-article-charset)) - gnus-newsgroup-charset)) - (mail-parse-ignored-charsets - gnus-newsgroup-ignored-charsets)) - (set-buffer gnus-original-article-buffer) - (message-forward post))))))) - -(defun gnus-summary-resend-message (address n) - "Resend the current article to ADDRESS." - (interactive - (list (message-read-from-minibuffer - "Resend message(s) to: " - (when (and gnus-summary-resend-default-address - (gnus-buffer-live-p gnus-original-article-buffer)) - ;; If some other article is currently selected, the - ;; initial-contents is wrong. Whatever, it is just the - ;; initial-contents. - (with-current-buffer gnus-original-article-buffer - (nnmail-fetch-field "to")))) - current-prefix-arg)) - (let ((articles (gnus-summary-work-articles n)) - article) - (while (setq article (pop articles)) - (gnus-summary-select-article nil nil nil article) - (save-excursion - (set-buffer gnus-original-article-buffer) - (message-resend address)) - (gnus-summary-mark-article-as-forwarded article)))) - -;; From: Matthieu Moy -(defun gnus-summary-resend-message-edit () - "Resend an article that has already been sent. -A new buffer will be created to allow the user to modify body and -contents of the message, and then, everything will happen as when -composing a new message." - (interactive) - (let ((article (gnus-summary-article-number))) - (gnus-setup-message 'reply-yank - (gnus-summary-select-article t) - (set-buffer gnus-original-article-buffer) - (let ((cur (current-buffer)) - (to (message-fetch-field "to"))) - ;; Get a normal message buffer. - (message-pop-to-buffer (message-buffer-name "Resend" to)) - (insert-buffer-substring cur) - (mime-to-mml) - (message-narrow-to-head-1) - ;; Gnus will generate a new one when sending. - (message-remove-header "Message-ID") - ;; Remove unwanted headers. - (message-remove-header message-ignored-resent-headers t) - (goto-char (point-max)) - (insert mail-header-separator) - ;; Add Gcc header. - (gnus-inews-insert-archive-gcc) - (gnus-inews-insert-gcc) - (goto-char (point-min)) - (when (re-search-forward "^To:\\|^Newsgroups:" nil 'move) - (forward-char 1)) - (widen))))) - -(defun gnus-summary-post-forward (&optional arg) - "Forward the current article to a newsgroup. -See `gnus-summary-mail-forward' for ARG." - (interactive "P") - (gnus-summary-mail-forward arg t)) - -(defvar gnus-nastygram-message - "The following article was inappropriately posted to %s.\n\n" - "Format string to insert in nastygrams. -The current group name will be inserted at \"%s\".") - -(defun gnus-summary-mail-nastygram (n) - "Send a nastygram to the author of the current article." - (interactive "P") - (when (or gnus-expert-user - (gnus-y-or-n-p - "Really send a nastygram to the author of the current article? ")) - (let ((group gnus-newsgroup-name)) - (gnus-summary-reply-with-original n) - (set-buffer gnus-message-buffer) - (message-goto-body) - (insert (format gnus-nastygram-message group)) - (message-send-and-exit)))) - -(defun gnus-summary-mail-crosspost-complaint (n) - "Send a complaint about crossposting to the current article(s)." - (interactive "P") - (let ((articles (gnus-summary-work-articles n)) - article) - (while (setq article (pop articles)) - (set-buffer gnus-summary-buffer) - (gnus-summary-goto-subject article) - (let ((group (gnus-group-real-name gnus-newsgroup-name)) - newsgroups followup-to) - (gnus-summary-select-article) - (set-buffer gnus-original-article-buffer) - (if (and (<= (length (message-tokenize-header - (setq newsgroups - (mail-fetch-field "newsgroups")) - ", ")) - 1) - (or (not (setq followup-to (mail-fetch-field "followup-to"))) - (not (member group (message-tokenize-header - followup-to ", "))))) - (if followup-to - (gnus-message 1 "Followup-to restricted") - (gnus-message 1 "Not a crossposted article")) - (set-buffer gnus-summary-buffer) - (gnus-summary-reply-with-original 1) - (set-buffer gnus-message-buffer) - (message-goto-body) - (insert (format gnus-crosspost-complaint newsgroups group)) - (message-goto-subject) - (re-search-forward " *$") - (replace-match " (crosspost notification)" t t) - (gnus-deactivate-mark) - (when (gnus-y-or-n-p "Send this complaint? ") - (message-send-and-exit))))))) - -(defun gnus-mail-parse-comma-list () - (let (accumulated - beg) - (skip-chars-forward " ") - (while (not (eobp)) - (setq beg (point)) - (skip-chars-forward "^,") - (while (zerop - (save-excursion - (save-restriction - (let ((i 0)) - (narrow-to-region beg (point)) - (goto-char beg) - (logand (progn - (while (search-forward "\"" nil t) - (incf i)) - (if (zerop i) 2 i)) - 2))))) - (skip-chars-forward ",") - (skip-chars-forward "^,")) - (skip-chars-backward " ") - (push (buffer-substring beg (point)) - accumulated) - (skip-chars-forward "^,") - (skip-chars-forward ", ")) - accumulated)) - -(defun gnus-inews-add-to-address (group) - (let ((to-address (mail-fetch-field "to"))) - (when (and to-address - (gnus-alive-p)) - ;; This mail group doesn't have a `to-list', so we add one - ;; here. Magic! - (when (gnus-y-or-n-p - (format "Do you want to add this as `to-list': %s? " to-address)) - (gnus-group-add-parameter group (cons 'to-list to-address)))))) - -(defun gnus-put-message () - "Put the current message in some group and return to Gnus." - (interactive) - (let ((reply gnus-article-reply) - (winconf gnus-prev-winconf) - (group gnus-newsgroup-name)) - (unless (and group - (not (gnus-group-read-only-p group))) - (setq group (read-string "Put in group: " nil (gnus-writable-groups)))) - - (when (gnus-gethash group gnus-newsrc-hashtb) - (error "No such group: %s" group)) - (save-excursion - (save-restriction - (widen) - (message-narrow-to-headers) - (let ((gnus-deletable-headers nil)) - (message-generate-headers - (if (message-news-p) - message-required-news-headers - message-required-mail-headers))) - (goto-char (point-max)) - (if (string-match " " group) - (insert "Gcc: \"" group "\"\n") - (insert "Gcc: " group "\n")) - (widen))) - (gnus-inews-do-gcc) - (when (and (get-buffer gnus-group-buffer) - (gnus-buffer-exists-p (car-safe reply)) - (cdr reply)) - (set-buffer (car reply)) - (gnus-summary-mark-article-as-replied (cdr reply))) - (when winconf - (set-window-configuration winconf)))) - -(defun gnus-article-mail (yank) - "Send a reply to the address near point. -If YANK is non-nil, include the original article." - (interactive "P") - (let ((address - (buffer-substring - (save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point))) - (save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point)))))) - (when address - (gnus-msg-mail address) - (when yank - (gnus-inews-yank-articles (list (cdr gnus-article-current))))))) - -(defvar nntp-server-type) -(defun gnus-bug () - "Send a bug report to the Gnus maintainers." - (interactive) - (unless (gnus-alive-p) - (error "Gnus has been shut down")) - (gnus-setup-message (if (message-mail-user-agent) 'message 'bug) - (unless (message-mail-user-agent) - (delete-other-windows) - (when gnus-bug-create-help-buffer - (switch-to-buffer "*Gnus Help Bug*") - (erase-buffer) - (insert gnus-bug-message) - (goto-char (point-min))) - (message-pop-to-buffer "*Gnus Bug*")) - (let ((message-this-is-mail t)) - (message-setup `((To . ,gnus-maintainer) (Subject . "")))) - (when gnus-bug-create-help-buffer - (push `(gnus-bug-kill-buffer) message-send-actions)) - (goto-char (point-min)) - (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) - (forward-line 1) - (insert (gnus-version) "\n" - (emacs-version) "\n") - (when (and (boundp 'nntp-server-type) - (stringp nntp-server-type)) - (insert nntp-server-type)) - (insert "\n\n\n\n\n") - (let (text) - (save-excursion - (set-buffer (gnus-get-buffer-create " *gnus environment info*")) - (erase-buffer) - (gnus-debug) - (setq text (buffer-string))) - (insert "<#part type=application/emacs-lisp disposition=inline description=\"User settings\">\n" text "\n<#/part>")) - (goto-char (point-min)) - (search-forward "Subject: " nil t) - (message ""))) - -(defun gnus-bug-kill-buffer () - (when (get-buffer "*Gnus Help Bug*") - (kill-buffer "*Gnus Help Bug*"))) - -(defun gnus-summary-yank-message (buffer n) - "Yank the current article into a composed message." - (interactive - (list (completing-read "Buffer: " (mapcar 'list (message-buffers)) nil t) - current-prefix-arg)) - (gnus-summary-iterate n - (let ((gnus-inhibit-treatment t)) - (gnus-summary-select-article)) - (save-excursion - (set-buffer buffer) - (message-yank-buffer gnus-article-buffer)))) - -(defun gnus-debug () - "Attempts to go through the Gnus source file and report what variables have been changed. -The source file has to be in the Emacs load path." - (interactive) - (let ((files gnus-debug-files) - (point (point)) - file expr olist sym) - (gnus-message 4 "Please wait while we snoop your variables...") - (sit-for 0) - ;; Go through all the files looking for non-default values for variables. - (save-excursion - (set-buffer (gnus-get-buffer-create " *gnus bug info*")) - (while files - (erase-buffer) - (when (and (setq file (locate-library (pop files))) - (file-exists-p file)) - (insert-file-contents file) - (goto-char (point-min)) - (if (not (re-search-forward "^;;* *Internal variables" nil t)) - (gnus-message 4 "Malformed sources in file %s" file) - (narrow-to-region (point-min) (point)) - (goto-char (point-min)) - (while (setq expr (ignore-errors (read (current-buffer)))) - (ignore-errors - (and (or (eq (car expr) 'defvar) - (eq (car expr) 'defcustom)) - (stringp (nth 3 expr)) - (not (memq (nth 1 expr) gnus-debug-exclude-variables)) - (or (not (boundp (nth 1 expr))) - (not (equal (eval (nth 2 expr)) - (symbol-value (nth 1 expr))))) - (push (nth 1 expr) olist))))))) - (kill-buffer (current-buffer))) - (when (setq olist (nreverse olist)) - (insert "------------------ Environment follows ------------------\n\n")) - (while olist - (if (boundp (car olist)) - (ignore-errors - (gnus-pp - `(setq ,(car olist) - ,(if (or (consp (setq sym (symbol-value (car olist)))) - (and (symbolp sym) - (not (or (eq sym nil) - (eq sym t))))) - (list 'quote (symbol-value (car olist))) - (symbol-value (car olist)))))) - (insert ";; (makeunbound '" (symbol-name (car olist)) ")\n")) - (setq olist (cdr olist))) - (insert "\n\n") - ;; Remove any control chars - they seem to cause trouble for some - ;; mailers. (Byte-compiled output from the stuff above.) - (goto-char point) - (while (re-search-forward (mm-string-as-multibyte - "[\000-\010\013-\037\200-\237]") nil t) - (replace-match (format "\\%03o" (string-to-char (match-string 0))) - t t)))) - -;;; Treatment of rejected articles. -;;; Bounced mail. - -(defun gnus-summary-resend-bounced-mail (&optional fetch) - "Re-mail the current message. -This only makes sense if the current message is a bounce message that -contains some mail you have written which has been bounced back to -you. -If FETCH, try to fetch the article that this is a reply to, if indeed -this is a reply." - (interactive "P") - (gnus-summary-select-article t) - (let (summary-buffer parent) - (if fetch - (progn - (setq summary-buffer (current-buffer)) - (set-buffer gnus-original-article-buffer) - (article-goto-body) - (when (re-search-forward "^References:\n?" nil t) - (while (memq (char-after) '(?\t ? )) - (forward-line 1)) - (skip-chars-backward "\t\n ") - (setq parent - (gnus-parent-id (buffer-substring (match-end 0) (point)))))) - (set-buffer gnus-original-article-buffer)) - (gnus-setup-message 'compose-bounce - (message-bounce) - ;; Add Gcc header. - (gnus-inews-insert-archive-gcc) - (gnus-inews-insert-gcc) - ;; If there are references, we fetch the article we answered to. - (when parent - (with-current-buffer summary-buffer - (gnus-summary-refer-article parent) - (gnus-summary-show-all-headers)))))) - -;;; Gcc handling. - -(defun gnus-inews-group-method (group) - (cond - ;; If the group doesn't exist, we assume - ;; it's an archive group... - ((and (null (gnus-get-info group)) - (eq (car (gnus-server-to-method gnus-message-archive-method)) - (car (gnus-server-to-method (gnus-group-method group))))) - gnus-message-archive-method) - ;; Use the method. - ((gnus-info-method (gnus-get-info group)) - (gnus-info-method (gnus-get-info group))) - ;; Find the method. - (t (gnus-server-to-method (gnus-group-method group))))) - -;; Do Gcc handling, which copied the message over to some group. -(defun gnus-inews-do-gcc (&optional gcc) - (interactive) - (save-excursion - (save-restriction - (message-narrow-to-headers) - (let ((gcc (or gcc (mail-fetch-field "gcc" nil t))) - (cur (current-buffer)) - groups group method group-art - mml-externalize-attachments) - (when gcc - (message-remove-header "gcc") - (widen) - (setq groups (message-unquote-tokens - (message-tokenize-header gcc " ,"))) - ;; Copy the article over to some group(s). - (while (setq group (pop groups)) - (unless (gnus-check-server - (setq method (gnus-inews-group-method group))) - (error "Can't open server %s" (if (stringp method) method - (car method)))) - (unless (gnus-request-group group nil method) - (gnus-request-create-group group method)) - (setq mml-externalize-attachments - (if (stringp gnus-gcc-externalize-attachments) - (string-match gnus-gcc-externalize-attachments group) - gnus-gcc-externalize-attachments)) - (save-excursion - (nnheader-set-temp-buffer " *acc*") - (insert-buffer-substring cur) - (message-encode-message-body) - (save-restriction - (message-narrow-to-headers) - (let* ((mail-parse-charset message-default-charset) - (newsgroups-field (save-restriction - (message-narrow-to-headers-or-head) - (message-fetch-field "Newsgroups"))) - (followup-field (save-restriction - (message-narrow-to-headers-or-head) - (message-fetch-field "Followup-To"))) - ;; BUG: We really need to get the charset for - ;; each name in the Newsgroups and Followup-To - ;; lines to allow crossposting between group - ;; namess with incompatible character sets. - ;; -- Per Abrahamsen 2001-10-08. - (group-field-charset - (gnus-group-name-charset - method (or newsgroups-field ""))) - (followup-field-charset - (gnus-group-name-charset - method (or followup-field ""))) - (rfc2047-header-encoding-alist - (append - (when group-field-charset - (list (cons "Newsgroups" group-field-charset))) - (when followup-field-charset - (list (cons "Followup-To" followup-field-charset))) - rfc2047-header-encoding-alist))) - (mail-encode-encoded-word-buffer))) - (goto-char (point-min)) - (when (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$") - nil t) - (replace-match "" t t )) - (unless (setq group-art - (gnus-request-accept-article group method t t)) - (gnus-message 1 "Couldn't store article in group %s: %s" - group (gnus-status-message method)) - (sit-for 2)) - (when (and group-art - ;; FIXME: Should gcc-mark-as-read work when - ;; Gnus is not running? - (gnus-alive-p) - (or gnus-gcc-mark-as-read - (and - (boundp 'gnus-inews-mark-gcc-as-read) - (symbol-value 'gnus-inews-mark-gcc-as-read)))) - (gnus-group-mark-article-read group (cdr group-art))) - (kill-buffer (current-buffer))))))))) - -(defun gnus-inews-insert-gcc () - "Insert Gcc headers based on `gnus-outgoing-message-group'." - (save-excursion - (save-restriction - (message-narrow-to-headers) - (let* ((group gnus-outgoing-message-group) - (gcc (cond - ((functionp group) - (funcall group)) - ((or (stringp group) (listp group)) - group)))) - (when gcc - (insert "Gcc: " - (if (stringp gcc) - (if (string-match " " gcc) - (concat "\"" gcc "\"") - gcc) - (mapconcat (lambda (group) - (if (string-match " " group) - (concat "\"" group "\"") - group)) - gcc " ")) - "\n")))))) - -(defun gnus-inews-insert-archive-gcc (&optional group) - "Insert the Gcc to say where the article is to be archived." - (let* ((var gnus-message-archive-group) - (group (or group gnus-newsgroup-name "")) - (gcc-self-val - (and gnus-newsgroup-name - (not (equal gnus-newsgroup-name "")) - (gnus-group-find-parameter - gnus-newsgroup-name 'gcc-self))) - result - (groups - (cond - ((null gnus-message-archive-method) - ;; Ignore. - nil) - ((stringp var) - ;; Just a single group. - (list var)) - ((null var) - ;; We don't want this. - nil) - ((and (listp var) (stringp (car var))) - ;; A list of groups. - var) - ((functionp var) - ;; A function. - (funcall var group)) - (t - ;; An alist of regexps/functions/forms. - (while (and var - (not - (setq result - (cond - ((stringp (caar var)) - ;; Regexp. - (when (string-match (caar var) group) - (cdar var))) - ((functionp (car var)) - ;; Function. - (funcall (car var) group)) - (t - (eval (car var))))))) - (setq var (cdr var))) - result))) - name) - (when (or groups gcc-self-val) - (when (stringp groups) - (setq groups (list groups))) - (save-excursion - (save-restriction - (message-narrow-to-headers) - (goto-char (point-max)) - (insert "Gcc: ") - (if gcc-self-val - ;; Use the `gcc-self' param value instead. - (progn - (insert - (if (stringp gcc-self-val) - (if (string-match " " gcc-self-val) - (concat "\"" gcc-self-val "\"") - gcc-self-val) - ;; In nndoc groups, we use the parent group name - ;; instead of the current group. - (let ((group (or (gnus-group-find-parameter - gnus-newsgroup-name 'parent-group) - group))) - (if (string-match " " group) - (concat "\"" group "\"") - group)))) - (if (not (eq gcc-self-val 'none)) - (insert "\n") - (gnus-delete-line))) - ;; Use the list of groups. - (while (setq name (pop groups)) - (let ((str (if (string-match ":" name) - name - (gnus-group-prefixed-name - name gnus-message-archive-method)))) - (insert (if (string-match " " str) - (concat "\"" str "\"") - str))) - (when groups - (insert " "))) - (insert "\n"))))))) - -(defun gnus-mailing-list-followup-to () - "Look at the headers in the current buffer and return a Mail-Followup-To address." - (let ((x-been-there (gnus-fetch-original-field "x-beenthere")) - (list-post (gnus-fetch-original-field "list-post"))) - (when (and list-post - (string-match "mailto:\\([^>]+\\)" list-post)) - (setq list-post (match-string 1 list-post))) - (or list-post - x-been-there))) - -;;; Posting styles. - -(defun gnus-configure-posting-styles (&optional group-name) - "Configure posting styles according to `gnus-posting-styles'." - (unless gnus-inhibit-posting-styles - (let ((group (or group-name gnus-newsgroup-name "")) - (styles gnus-posting-styles) - style match attribute value v results - filep name address element) - ;; If the group has a posting-style parameter, add it at the end with a - ;; regexp matching everything, to be sure it takes precedence over all - ;; the others. - (when gnus-newsgroup-name - (let ((tmp-style (gnus-group-find-parameter group 'posting-style t))) - (when tmp-style - (setq styles (append styles (list (cons ".*" tmp-style))))))) - ;; Go through all styles and look for matches. - (dolist (style styles) - (setq match (pop style)) - (goto-char (point-min)) - (when (cond - ((stringp match) - ;; Regexp string match on the group name. - (string-match match group)) - ((eq match 'header) - ;; Obsolete format of header match. - (and (gnus-buffer-live-p gnus-article-copy) - (with-current-buffer gnus-article-copy - (save-restriction - (nnheader-narrow-to-headers) - (let ((header (message-fetch-field (pop style)))) - (and header - (string-match (pop style) header))))))) - ((or (symbolp match) - (functionp match)) - (cond - ((functionp match) - ;; Function to be called. - (funcall match)) - ((boundp match) - ;; Variable to be checked. - (symbol-value match)))) - ((listp match) - (cond - ((eq (car match) 'header) - ;; New format of header match. - (and (gnus-buffer-live-p gnus-article-copy) - (with-current-buffer gnus-article-copy - (save-restriction - (nnheader-narrow-to-headers) - (let ((header (message-fetch-field (nth 1 match)))) - (and header - (string-match (nth 2 match) header))))))) - (t - ;; This is a form to be evaled. - (eval match))))) - ;; We have a match, so we set the variables. - (dolist (attribute style) - (setq element (pop attribute) - filep nil) - (setq value - (cond - ((eq (car attribute) :file) - (setq filep t) - (cadr attribute)) - ((eq (car attribute) :value) - (cadr attribute)) - (t - (car attribute)))) - ;; We get the value. - (setq v - (cond - ((stringp value) - value) - ((or (symbolp value) - (functionp value)) - (cond ((functionp value) - (funcall value)) - ((boundp value) - (symbol-value value)))) - ((listp value) - (eval value)))) - ;; Translate obsolescent value. - (cond - ((eq element 'signature-file) - (setq element 'signature - filep t)) - ((eq element 'x-face-file) - (setq element 'x-face - filep t))) - ;; Get the contents of file elems. - (when (and filep v) - (setq v (with-temp-buffer - (insert-file-contents v) - (buffer-substring - (point-min) - (progn - (goto-char (point-max)) - (if (zerop (skip-chars-backward "\n")) - (point) - (1+ (point)))))))) - (setq results (delq (assoc element results) results)) - (push (cons element v) results)))) - ;; Now we have all the styles, so we insert them. - (setq name (assq 'name results) - address (assq 'address results)) - (setq results (delq name (delq address results))) - (gnus-make-local-hook 'message-setup-hook) - (setq results (sort results (lambda (x y) - (string-lessp (car x) (car y))))) - (dolist (result results) - (add-hook 'message-setup-hook - (cond - ((eq 'eval (car result)) - 'ignore) - ((eq 'body (car result)) - `(lambda () - (save-excursion - (message-goto-body) - (insert ,(cdr result))))) - ((eq 'signature (car result)) - (set (make-local-variable 'message-signature) nil) - (set (make-local-variable 'message-signature-file) nil) - (if (not (cdr result)) - 'ignore - `(lambda () - (save-excursion - (let ((message-signature ,(cdr result))) - (when message-signature - (message-insert-signature))))))) - (t - (let ((header - (if (symbolp (car result)) - (capitalize (symbol-name (car result))) - (car result)))) - `(lambda () - (save-excursion - (message-remove-header ,header) - (let ((value ,(cdr result))) - (when value - (message-goto-eoh) - (insert ,header ": " value) - (unless (bolp) - (insert "\n"))))))))) - nil 'local)) - (when (or name address) - (add-hook 'message-setup-hook - `(lambda () - (set (make-local-variable 'user-mail-address) - ,(or (cdr address) user-mail-address)) - (let ((user-full-name ,(or (cdr name) (user-full-name))) - (user-mail-address - ,(or (cdr address) user-mail-address))) - (save-excursion - (message-remove-header "From") - (message-goto-eoh) - (insert "From: " (message-make-from) "\n")))) - nil 'local))))) - -;;; Allow redefinition of functions. - -(gnus-ems-redefine) - -(provide 'gnus-msg) - -;;; arch-tag: 9f22b2f5-1c0a-49de-916e-4c88e984852b -;;; gnus-msg.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-nocem.el b/xemacs-packages/gnus/lisp/gnus-nocem.el deleted file mode 100644 index f5cec0d9..00000000 --- a/xemacs-packages/gnus/lisp/gnus-nocem.el +++ /dev/null @@ -1,405 +0,0 @@ -;;; gnus-nocem.el --- NoCeM pseudo-cancellation treatment - -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) -(require 'nnmail) -(require 'gnus-art) -(require 'gnus-sum) -(require 'gnus-range) - -(defgroup gnus-nocem nil - "NoCeM pseudo-cancellation treatment." - :group 'gnus-score) - -(defcustom gnus-nocem-groups - '("news.lists.filters" "news.admin.net-abuse.bulletins" - "alt.nocem.misc" "news.admin.net-abuse.announce") - "*List of groups that will be searched for NoCeM messages." - :group 'gnus-nocem - :type '(repeat (string :tag "Group"))) - -(defcustom gnus-nocem-issuers - '("AutoMoose-1" ; CancelMoose[tm] - "clewis@ferret.ocunix" ; Chris Lewis - "cosmo.roadkill" - "SpamHippo" - "hweede@snafu.de") - "*List of NoCeM issuers to pay attention to. - -This can also be a list of `(ISSUER CONDITION ...)' elements. - -See for an -issuer registry." - :group 'gnus-nocem - :link '(url-link "http://www.xs4all.nl/~rosalind/nocemreg/nocemreg.html") - :type '(repeat (choice string sexp))) - -(defcustom gnus-nocem-directory - (nnheader-concat gnus-article-save-directory "NoCeM/") - "*Directory where NoCeM files will be stored." - :group 'gnus-nocem - :type 'directory) - -(defcustom gnus-nocem-expiry-wait 15 - "*Number of days to keep NoCeM headers in the cache." - :group 'gnus-nocem - :type 'integer) - -(defcustom gnus-nocem-verifyer 'pgg-verify - "*Function called to verify that the NoCeM message is valid. -One likely value is `pgg-verify'. If the function in this variable -isn't bound, the message will be used unconditionally." - :group 'gnus-nocem - :type '(radio (function-item pgg-verify) - (function-item mc-verify) - (function :tag "other"))) - -(defcustom gnus-nocem-liberal-fetch nil - "*If t try to fetch all messages which have @@NCM in the subject. -Otherwise don't fetch messages which have references or whose message-id -matches a previously scanned and verified nocem message." - :group 'gnus-nocem - :type 'boolean) - -(defcustom gnus-nocem-check-article-limit 500 - "*If non-nil, the maximum number of articles to check in any NoCeM group." - :group 'gnus-nocem - :version "21.1" - :type '(choice (const :tag "unlimited" nil) - (integer 1000))) - -(defcustom gnus-nocem-check-from t - "Non-nil means check for valid issuers in message bodies. -Otherwise don't bother fetching articles unless their author matches a -valid issuer, which is much faster if you are selective about the issuers." - :group 'gnus-nocem - :version "21.1" - :type 'boolean) - -;;; Internal variables - -(defvar gnus-nocem-active nil) -(defvar gnus-nocem-alist nil) -(defvar gnus-nocem-touched-alist nil) -(defvar gnus-nocem-hashtb nil) -(defvar gnus-nocem-seen-message-ids nil) - -;;; Functions - -(defun gnus-nocem-active-file () - (concat (file-name-as-directory gnus-nocem-directory) "active")) - -(defun gnus-nocem-cache-file () - (concat (file-name-as-directory gnus-nocem-directory) "cache")) - -;; -;; faster lookups for group names: -;; - -(defvar gnus-nocem-real-group-hashtb nil - "Real-name mappings of subscribed groups.") - -(defun gnus-fill-real-hashtb () - "Fill up a hash table with the real-name mappings from the user's active file." - (setq gnus-nocem-real-group-hashtb (gnus-make-hashtable - (length gnus-newsrc-alist))) - (mapcar (lambda (group) - (setq group (gnus-group-real-name (car group))) - (gnus-sethash group t gnus-nocem-real-group-hashtb)) - gnus-newsrc-alist)) - -;;;###autoload -(defun gnus-nocem-scan-groups () - "Scan all NoCeM groups for new NoCeM messages." - (interactive) - (let ((groups gnus-nocem-groups) - (gnus-inhibit-demon t) - group active gactive articles check-headers) - (gnus-make-directory gnus-nocem-directory) - ;; Load any previous NoCeM headers. - (gnus-nocem-load-cache) - ;; Get the group name mappings: - (gnus-fill-real-hashtb) - ;; Read the active file if it hasn't been read yet. - (and (file-exists-p (gnus-nocem-active-file)) - (not gnus-nocem-active) - (ignore-errors - (load (gnus-nocem-active-file) t t t))) - ;; Go through all groups and see whether new articles have - ;; arrived. - (while (setq group (pop groups)) - (if (not (setq gactive (gnus-activate-group group))) - () ; This group doesn't exist. - (setq active (nth 1 (assoc group gnus-nocem-active))) - (when (and (not (< (cdr gactive) (car gactive))) ; Empty group. - (or (not active) - (< (cdr active) (cdr gactive)))) - ;; Ok, there are new articles in this group, se we fetch the - ;; headers. - (save-excursion - (let ((dependencies (make-vector 10 nil)) - headers header) - (with-temp-buffer - (setq headers - (if (eq 'nov - (gnus-retrieve-headers - (setq articles - (gnus-uncompress-range - (cons - (if active (1+ (cdr active)) - (car gactive)) - (cdr gactive)))) - group)) - (gnus-get-newsgroup-headers-xover - articles nil dependencies) - (gnus-get-newsgroup-headers dependencies))) - (while (setq header (pop headers)) - ;; We take a closer look on all articles that have - ;; "@@NCM" in the subject. Unless we already read - ;; this cross posted message. Nocem messages - ;; are not allowed to have references, so we can - ;; ignore scanning followups. - (and (string-match "@@NCM" (mail-header-subject header)) - (and gnus-nocem-check-from - (let ((case-fold-search t)) - (catch 'ok - (mapcar - (lambda (author) - (if (consp author) - (setq author (car author))) - (if (string-match - author (mail-header-from header)) - (throw 'ok t))) - gnus-nocem-issuers) - nil))) - (or gnus-nocem-liberal-fetch - (and (or (string= "" (mail-header-references - header)) - (null (mail-header-references header))) - (not (member (mail-header-message-id header) - gnus-nocem-seen-message-ids)))) - (push header check-headers))) - (setq check-headers (last (nreverse check-headers) - gnus-nocem-check-article-limit)) - (let ((i 0) - (len (length check-headers))) - (dolist (h check-headers) - (gnus-message - 7 "Checking article %d in %s for NoCeM (%d of %d)..." - (mail-header-number h) group (incf i) len) - (gnus-nocem-check-article group h))))))) - (setq gnus-nocem-active - (cons (list group gactive) - (delq (assoc group gnus-nocem-active) - gnus-nocem-active))))) - ;; Save the results, if any. - (gnus-nocem-save-cache) - (gnus-nocem-save-active))) - -(defun gnus-nocem-check-article (group header) - "Check whether the current article is an NCM article and that we want it." - ;; Get the article. - (let ((date (mail-header-date header)) - (gnus-newsgroup-name group) - issuer b e type) - (when (or (not date) - (time-less-p - (time-since (date-to-time date)) - (days-to-time gnus-nocem-expiry-wait))) - (gnus-request-article-this-buffer (mail-header-number header) group) - (goto-char (point-min)) - (when (re-search-forward - "-----BEGIN PGP\\( SIGNED\\)? MESSAGE-----" - nil t) - (delete-region (point-min) (match-beginning 0))) - (when (re-search-forward - "-----END PGP \\(MESSAGE\\|SIGNATURE\\)-----\n?" - nil t) - (delete-region (match-end 0) (point-max))) - (goto-char (point-min)) - ;; The article has to have proper NoCeM headers. - (when (and (setq b (search-forward "\n@@BEGIN NCM HEADERS\n" nil t)) - (setq e (search-forward "\n@@BEGIN NCM BODY\n" nil t))) - ;; We get the name of the issuer. - (narrow-to-region b e) - (setq issuer (mail-fetch-field "issuer") - type (mail-fetch-field "type")) - (widen) - (if (not (gnus-nocem-message-wanted-p issuer type)) - (message "invalid NoCeM issuer: %s" issuer) - (and (gnus-nocem-verify-issuer issuer) ; She is who she says she is. - (gnus-nocem-enter-article) ; We gobble the message. - (push (mail-header-message-id header) ; But don't come back for - gnus-nocem-seen-message-ids))))))) ; second helpings. - -(defun gnus-nocem-message-wanted-p (issuer type) - (let ((issuers gnus-nocem-issuers) - wanted conditions condition) - (cond - ;; Do the quick check first. - ((member issuer issuers) - t) - ((setq conditions (cdr (assoc issuer issuers))) - ;; Check whether we want this type. - (while (setq condition (pop conditions)) - (cond - ((stringp condition) - (when (string-match condition type) - (setq wanted t))) - ((and (consp condition) - (eq (car condition) 'not) - (stringp (cadr condition))) - (when (string-match (cadr condition) type) - (setq wanted nil))) - (t - (error "Invalid NoCeM condition: %S" condition)))) - wanted)))) - -(defun gnus-nocem-verify-issuer (person) - "Verify using PGP that the canceler is who she says she is." - (if (functionp gnus-nocem-verifyer) - (ignore-errors - (funcall gnus-nocem-verifyer)) - ;; If we don't have Mailcrypt, then we use the message anyway. - t)) - -(defun gnus-nocem-enter-article () - "Enter the current article into the NoCeM cache." - (goto-char (point-min)) - (let ((b (search-forward "\n@@BEGIN NCM BODY\n" nil t)) - (e (search-forward "\n@@END NCM BODY\n" nil t)) - (buf (current-buffer)) - ncm id group) - (when (and b e) - (narrow-to-region b (1+ (match-beginning 0))) - (goto-char (point-min)) - (while (search-forward "\t" nil t) - (cond - ((not (ignore-errors - (setq group (let ((obarray gnus-nocem-real-group-hashtb)) - (read buf))))) - ;; An error. - ) - ((not (symbolp group)) - ;; Ignore invalid entries. - ) - ((not (boundp group)) - ;; Make sure all entries in the hashtb are bound. - (set group nil)) - (t - (when (gnus-gethash (gnus-group-real-name (symbol-name group)) - gnus-nocem-real-group-hashtb) - ;; Valid group. - (beginning-of-line) - (while (eq (char-after) ?\t) - (forward-line -1)) - (setq id (buffer-substring (point) (1- (search-forward "\t")))) - (unless (if gnus-nocem-hashtb - (gnus-gethash id gnus-nocem-hashtb) - (setq gnus-nocem-hashtb (gnus-make-hashtable)) - nil) - ;; only store if not already present - (gnus-sethash id t gnus-nocem-hashtb) - (push id ncm)) - (forward-line 1) - (while (eq (char-after) ?\t) - (forward-line 1)))))) - (when ncm - (setq gnus-nocem-touched-alist t) - (push (cons (let ((time (current-time))) (setcdr (cdr time) nil) time) - ncm) - gnus-nocem-alist)) - t))) - -;;;###autoload -(defun gnus-nocem-load-cache () - "Load the NoCeM cache." - (interactive) - (unless gnus-nocem-alist - ;; The buffer doesn't exist, so we create it and load the NoCeM - ;; cache. - (when (file-exists-p (gnus-nocem-cache-file)) - (load (gnus-nocem-cache-file) t t t) - (gnus-nocem-alist-to-hashtb)))) - -(defun gnus-nocem-save-cache () - "Save the NoCeM cache." - (when (and gnus-nocem-alist - gnus-nocem-touched-alist) - (with-temp-file (gnus-nocem-cache-file) - (gnus-prin1 `(setq gnus-nocem-alist ',gnus-nocem-alist))) - (setq gnus-nocem-touched-alist nil))) - -(defun gnus-nocem-save-active () - "Save the NoCeM active file." - (with-temp-file (gnus-nocem-active-file) - (gnus-prin1 `(setq gnus-nocem-active ',gnus-nocem-active)))) - -(defun gnus-nocem-alist-to-hashtb () - "Create a hashtable from the Message-IDs we have." - (let* ((alist gnus-nocem-alist) - (pprev (cons nil alist)) - (prev pprev) - (expiry (days-to-time gnus-nocem-expiry-wait)) - entry) - (setq gnus-nocem-hashtb (gnus-make-hashtable (* (length alist) 51))) - (while (setq entry (car alist)) - (if (not (time-less-p (time-since (car entry)) expiry)) - ;; This entry has expired, so we remove it. - (setcdr prev (cdr alist)) - (setq prev alist) - ;; This is ok, so we enter it into the hashtable. - (setq entry (cdr entry)) - (while entry - (gnus-sethash (car entry) t gnus-nocem-hashtb) - (setq entry (cdr entry)))) - (setq alist (cdr alist))))) - -(gnus-add-shutdown 'gnus-nocem-close 'gnus) - -(defun gnus-nocem-close () - "Clear internal NoCeM variables." - (setq gnus-nocem-alist nil - gnus-nocem-hashtb nil - gnus-nocem-active nil - gnus-nocem-touched-alist nil - gnus-nocem-seen-message-ids nil - gnus-nocem-real-group-hashtb nil)) - -(defun gnus-nocem-unwanted-article-p (id) - "Say whether article ID in the current group is wanted." - (and gnus-nocem-hashtb - (gnus-gethash id gnus-nocem-hashtb))) - -(provide 'gnus-nocem) - -;;; arch-tag: 0e0c74ea-2f8e-4f3e-8fff-09f767c1adef -;;; gnus-nocem.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-picon.el b/xemacs-packages/gnus/lisp/gnus-picon.el deleted file mode 100644 index 11806e52..00000000 --- a/xemacs-packages/gnus/lisp/gnus-picon.el +++ /dev/null @@ -1,288 +0,0 @@ -;;; gnus-picon.el --- displaying pretty icons in Gnus - -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news xpm annotation glyph faces - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; There are three picon types relevant to Gnus: -;; -;; Persons: person@subdomain.dom -;; users/dom/subdomain/person/face.gif -;; usenix/dom/subdomain/person/face.gif -;; misc/MISC/person/face.gif -;; Domains: subdomain.dom -;; domain/dom/subdomain/unknown/face.gif -;; Groups: comp.lang.lisp -;; news/comp/lang/lisp/unknown/face.gif -;; -;; Original implementation by Wes Hardaker . -;; -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) -(require 'gnus-art) - -;;; User variables: - -(defcustom gnus-picon-news-directories '("news") - "*List of directories to search for newsgroups faces." - :type '(repeat string) - :group 'gnus-picon) - -(defcustom gnus-picon-user-directories '("users" "usenix" "local" "misc") - "*List of directories to search for user faces." - :type '(repeat string) - :group 'gnus-picon) - -(defcustom gnus-picon-domain-directories '("domains") - "*List of directories to search for domain faces. -Some people may want to add \"unknown\" to this list." - :type '(repeat string) - :group 'gnus-picon) - -(defcustom gnus-picon-file-types - (let ((types (list "xbm"))) - (when (gnus-image-type-available-p 'gif) - (push "gif" types)) - (when (gnus-image-type-available-p 'xpm) - (push "xpm" types)) - types) - "*List of suffixes on picon file names to try." - :type '(repeat string) - :group 'gnus-picon) - -(defface gnus-picon-xbm '((t (:foreground "black" :background "white"))) - "Face to show xbm picon in." - :group 'gnus-picon) -;; backward-compatibility alias -(put 'gnus-picon-xbm-face 'face-alias 'gnus-picon-xbm) - -(defface gnus-picon '((t (:foreground "black" :background "white"))) - "Face to show picon in." - :group 'gnus-picon) -;; backward-compatibility alias -(put 'gnus-picon-face 'face-alias 'gnus-picon) - -;;; Internal variables: - -(defvar gnus-picon-setup-p nil) -(defvar gnus-picon-glyph-alist nil - "Picon glyphs cache. -List of pairs (KEY . GLYPH) where KEY is either a filename or an URL.") -(defvar gnus-picon-cache nil) - -;;; Functions: - -(defsubst gnus-picon-split-address (address) - (setq address (split-string address "@")) - (if (stringp (cadr address)) - (cons (car address) (split-string (cadr address) "\\.")) - (if (stringp (car address)) - (split-string (car address) "\\.")))) - -(defun gnus-picon-find-face (address directories &optional exact) - (let* ((address (gnus-picon-split-address address)) - (user (pop address)) - (faddress address) - database directory result instance base) - (catch 'found - (dolist (database gnus-picon-databases) - (dolist (directory directories) - (setq address faddress - base (expand-file-name directory database)) - (while address - (when (setq result (gnus-picon-find-image - (concat base "/" (mapconcat 'downcase - (reverse address) - "/") - "/" (downcase user) "/"))) - (throw 'found result)) - (if exact - (setq address nil) - (pop address))) - ;; Kludge to search MISC as well. But not in "news". - (unless (string= directory "news") - (when (setq result (gnus-picon-find-image - (concat base "/MISC/" user "/"))) - (throw 'found result)))))))) - -(defun gnus-picon-find-image (directory) - (let ((types gnus-picon-file-types) - found type file) - (while (and (not found) - (setq type (pop types))) - (setq found (file-exists-p (setq file (concat directory "face." type))))) - (if found - file - nil))) - -(defun gnus-picon-insert-glyph (glyph category) - "Insert GLYPH into the buffer. -GLYPH can be either a glyph or a string." - (if (stringp glyph) - (insert glyph) - (gnus-add-wash-type category) - (gnus-add-image category (car glyph)) - (gnus-put-image (car glyph) (cdr glyph) category))) - -(defun gnus-picon-create-glyph (file) - (or (cdr (assoc file gnus-picon-glyph-alist)) - (cdar (push (cons file (gnus-create-image file)) - gnus-picon-glyph-alist)))) - -;;; Functions that does picon transformations: - -(defun gnus-picon-transform-address (header category) - (gnus-with-article-headers - (let ((addresses - (mail-header-parse-addresses - ;; mail-header-parse-addresses does not work (reliably) on - ;; decoded headers. - (or - (ignore-errors - (mail-encode-encoded-word-string - (or (mail-fetch-field header) ""))) - (mail-fetch-field header)))) - spec file point cache) - (dolist (address addresses) - (setq address (car address)) - (when (and (stringp address) - (setq spec (gnus-picon-split-address address))) - (if (setq cache (cdr (assoc address gnus-picon-cache))) - (setq spec cache) - (when (setq file (or (gnus-picon-find-face - address gnus-picon-user-directories) - (gnus-picon-find-face - (concat "unknown@" - (mapconcat - 'identity (cdr spec) ".")) - gnus-picon-user-directories))) - (setcar spec (cons (gnus-picon-create-glyph file) - (car spec)))) - - (dotimes (i (1- (length spec))) - (when (setq file (gnus-picon-find-face - (concat "unknown@" - (mapconcat - 'identity (nthcdr (1+ i) spec) ".")) - gnus-picon-domain-directories t)) - (setcar (nthcdr (1+ i) spec) - (cons (gnus-picon-create-glyph file) - (nth (1+ i) spec))))) - (setq spec (nreverse spec)) - (push (cons address spec) gnus-picon-cache)) - - (gnus-article-goto-header header) - (mail-header-narrow-to-field) - (when (search-forward address nil t) - (delete-region (match-beginning 0) (match-end 0)) - (setq point (point)) - (while spec - (goto-char point) - (if (> (length spec) 2) - (insert ".") - (if (= (length spec) 2) - (insert "@"))) - (gnus-picon-insert-glyph (pop spec) category)))))))) - -(defun gnus-picon-transform-newsgroups (header) - (interactive) - (gnus-with-article-headers - (gnus-article-goto-header header) - (mail-header-narrow-to-field) - (let ((groups (message-tokenize-header (mail-fetch-field header))) - spec file point) - (dolist (group groups) - (unless (setq spec (cdr (assoc group gnus-picon-cache))) - (setq spec (nreverse (split-string group "[.]"))) - (dotimes (i (length spec)) - (when (setq file (gnus-picon-find-face - (concat "unknown@" - (mapconcat - 'identity (nthcdr i spec) ".")) - gnus-picon-news-directories t)) - (setcar (nthcdr i spec) - (cons (gnus-picon-create-glyph file) - (nth i spec))))) - (push (cons group spec) gnus-picon-cache)) - (when (search-forward group nil t) - (delete-region (match-beginning 0) (match-end 0)) - (save-restriction - (narrow-to-region (point) (point)) - (while spec - (goto-char (point-min)) - (if (> (length spec) 1) - (insert ".")) - (gnus-picon-insert-glyph (pop spec) 'newsgroups-picon)) - (goto-char (point-max)))))))) - -;;; Commands: - -;; #### NOTE: the test for buffer-read-only is the same as in -;; article-display-[x-]face. See the comment up there. - -;;;###autoload -(defun gnus-treat-from-picon () - "Display picons in the From header. -If picons are already displayed, remove them." - (interactive) - (let ((wash-picon-p buffer-read-only)) - (gnus-with-article-buffer - (if (and wash-picon-p (memq 'from-picon gnus-article-wash-types)) - (gnus-delete-images 'from-picon) - (gnus-picon-transform-address "from" 'from-picon))) - )) - -;;;###autoload -(defun gnus-treat-mail-picon () - "Display picons in the Cc and To headers. -If picons are already displayed, remove them." - (interactive) - (let ((wash-picon-p buffer-read-only)) - (gnus-with-article-buffer - (if (and wash-picon-p (memq 'mail-picon gnus-article-wash-types)) - (gnus-delete-images 'mail-picon) - (gnus-picon-transform-address "cc" 'mail-picon) - (gnus-picon-transform-address "to" 'mail-picon))) - )) - -;;;###autoload -(defun gnus-treat-newsgroups-picon () - "Display picons in the Newsgroups and Followup-To headers. -If picons are already displayed, remove them." - (interactive) - (let ((wash-picon-p buffer-read-only)) - (gnus-with-article-buffer - (if (and wash-picon-p (memq 'newsgroups-picon gnus-article-wash-types)) - (gnus-delete-images 'newsgroups-picon) - (gnus-picon-transform-newsgroups "newsgroups") - (gnus-picon-transform-newsgroups "followup-to"))) - )) - -(provide 'gnus-picon) - -;;; arch-tag: fe9aede0-1b1b-463a-b4ab-807f98bcb31f -;;; gnus-picon.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-range.el b/xemacs-packages/gnus/lisp/gnus-range.el deleted file mode 100644 index 6ad59222..00000000 --- a/xemacs-packages/gnus/lisp/gnus-range.el +++ /dev/null @@ -1,660 +0,0 @@ -;;; gnus-range.el --- range and sequence functions for Gnus - -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -;;; List and range functions - -(defsubst gnus-range-normalize (range) - "Normalize RANGE. -If RANGE is a single range, return (RANGE). Otherwise, return RANGE." - (if (listp (cdr-safe range)) range (list range))) - -(defun gnus-last-element (list) - "Return last element of LIST." - (while (cdr list) - (setq list (cdr list))) - (car list)) - -(defun gnus-copy-sequence (list) - "Do a complete, total copy of a list." - (let (out) - (while (consp list) - (if (consp (car list)) - (push (gnus-copy-sequence (pop list)) out) - (push (pop list) out))) - (if list - (nconc (nreverse out) list) - (nreverse out)))) - -(defun gnus-set-difference (list1 list2) - "Return a list of elements of LIST1 that do not appear in LIST2." - (let ((list1 (copy-sequence list1))) - (while list2 - (setq list1 (delq (car list2) list1)) - (setq list2 (cdr list2))) - list1)) - -(defun gnus-range-difference (range1 range2) - "Return the range of elements in RANGE1 that do not appear in RANGE2. -Both ranges must be in ascending order." - (setq range1 (gnus-range-normalize range1)) - (setq range2 (gnus-range-normalize range2)) - (let* ((new-range (cons nil (copy-sequence range1))) - (r new-range) - (safe t)) - (while (cdr r) - (let* ((r1 (cadr r)) - (r2 (car range2)) - (min1 (if (numberp r1) r1 (car r1))) - (max1 (if (numberp r1) r1 (cdr r1))) - (min2 (if (numberp r2) r2 (car r2))) - (max2 (if (numberp r2) r2 (cdr r2)))) - - (cond ((> min1 max1) - ;; Invalid range: may result from overlap condition (below) - ;; remove Invalid range - (setcdr r (cddr r))) - ((and (= min1 max1) - (listp r1)) - ;; Inefficient representation: may result from overlap condition (below) - (setcar (cdr r) min1)) - ((not min2) - ;; All done with range2 - (setq r nil)) - ((< max1 min2) - ;; No overlap: range1 preceeds range2 - (pop r)) - ((< max2 min1) - ;; No overlap: range2 preceeds range1 - (pop range2)) - ((and (<= min2 min1) (<= max1 max2)) - ;; Complete overlap: range1 removed - (setcdr r (cddr r))) - (t - (setcdr r (nconc (list (cons min1 (1- min2)) (cons (1+ max2) max1)) (cddr r))))))) - (cdr new-range))) - - - -;;;###autoload -(defun gnus-sorted-difference (list1 list2) - "Return a list of elements of LIST1 that do not appear in LIST2. -Both lists have to be sorted over <. -The tail of LIST1 is not copied." - (let (out) - (while (and list1 list2) - (cond ((= (car list1) (car list2)) - (setq list1 (cdr list1) - list2 (cdr list2))) - ((< (car list1) (car list2)) - (setq out (cons (car list1) out)) - (setq list1 (cdr list1))) - (t - (setq list2 (cdr list2))))) - (nconc (nreverse out) list1))) - -;;;###autoload -(defun gnus-sorted-ndifference (list1 list2) - "Return a list of elements of LIST1 that do not appear in LIST2. -Both lists have to be sorted over <. -LIST1 is modified." - (let* ((top (cons nil list1)) - (prev top)) - (while (and list1 list2) - (cond ((= (car list1) (car list2)) - (setcdr prev (cdr list1)) - (setq list1 (cdr list1) - list2 (cdr list2))) - ((< (car list1) (car list2)) - (setq prev list1 - list1 (cdr list1))) - (t - (setq list2 (cdr list2))))) - (cdr top))) - -;;;###autoload -(defun gnus-sorted-complement (list1 list2) - "Return a list of elements that are in LIST1 or LIST2 but not both. -Both lists have to be sorted over <." - (let (out) - (if (or (null list1) (null list2)) - (or list1 list2) - (while (and list1 list2) - (cond ((= (car list1) (car list2)) - (setq list1 (cdr list1) - list2 (cdr list2))) - ((< (car list1) (car list2)) - (setq out (cons (car list1) out)) - (setq list1 (cdr list1))) - (t - (setq out (cons (car list2) out)) - (setq list2 (cdr list2))))) - (nconc (nreverse out) (or list1 list2))))) - -;;;###autoload -(defun gnus-intersection (list1 list2) - (let ((result nil)) - (while list2 - (when (memq (car list2) list1) - (setq result (cons (car list2) result))) - (setq list2 (cdr list2))) - result)) - -;;;###autoload -(defun gnus-sorted-intersection (list1 list2) - "Return intersection of LIST1 and LIST2. -LIST1 and LIST2 have to be sorted over <." - (let (out) - (while (and list1 list2) - (cond ((= (car list1) (car list2)) - (setq out (cons (car list1) out) - list1 (cdr list1) - list2 (cdr list2))) - ((< (car list1) (car list2)) - (setq list1 (cdr list1))) - (t - (setq list2 (cdr list2))))) - (nreverse out))) - -;;;###autoload -(defun gnus-sorted-range-intersection (range1 range2) - "Return intersection of RANGE1 and RANGE2. -RANGE1 and RANGE2 have to be sorted over <." - (let* (out - (min1 (car range1)) - (max1 (if (numberp min1) - (if (numberp (cdr range1)) - (prog1 (cdr range1) - (setq range1 nil)) min1) - (prog1 (cdr min1) - (setq min1 (car min1))))) - (min2 (car range2)) - (max2 (if (numberp min2) - (if (numberp (cdr range2)) - (prog1 (cdr range2) - (setq range2 nil)) min2) - (prog1 (cdr min2) - (setq min2 (car min2)))))) - (setq range1 (cdr range1) - range2 (cdr range2)) - (while (and min1 min2) - (cond ((< max1 min2) ; range1 preceeds range2 - (setq range1 (cdr range1) - min1 nil)) - ((< max2 min1) ; range2 preceeds range1 - (setq range2 (cdr range2) - min2 nil)) - (t ; some sort of overlap is occurring - (let ((min (max min1 min2)) - (max (min max1 max2))) - (setq out (if (= min max) - (cons min out) - (cons (cons min max) out)))) - (if (< max1 max2) ; range1 ends before range2 - (setq min1 nil) ; incr range1 - (setq min2 nil)))) ; incr range2 - (unless min1 - (setq min1 (car range1) - max1 (if (numberp min1) min1 (prog1 (cdr min1) (setq min1 (car min1)))) - range1 (cdr range1))) - (unless min2 - (setq min2 (car range2) - max2 (if (numberp min2) min2 (prog1 (cdr min2) (setq min2 (car min2)))) - range2 (cdr range2)))) - (cond ((cdr out) - (nreverse out)) - ((numberp (car out)) - out) - (t - (car out))))) - -;;;###autoload -(defalias 'gnus-set-sorted-intersection 'gnus-sorted-nintersection) - -;;;###autoload -(defun gnus-sorted-nintersection (list1 list2) - "Return intersection of LIST1 and LIST2 by modifying cdr pointers of LIST1. -LIST1 and LIST2 have to be sorted over <." - (let* ((top (cons nil list1)) - (prev top)) - (while (and list1 list2) - (cond ((= (car list1) (car list2)) - (setq prev list1 - list1 (cdr list1) - list2 (cdr list2))) - ((< (car list1) (car list2)) - (setcdr prev (cdr list1)) - (setq list1 (cdr list1))) - (t - (setq list2 (cdr list2))))) - (setcdr prev nil) - (cdr top))) - -;;;###autoload -(defun gnus-sorted-union (list1 list2) - "Return union of LIST1 and LIST2. -LIST1 and LIST2 have to be sorted over <." - (let (out) - (while (and list1 list2) - (cond ((= (car list1) (car list2)) - (setq out (cons (car list1) out) - list1 (cdr list1) - list2 (cdr list2))) - ((< (car list1) (car list2)) - (setq out (cons (car list1) out) - list1 (cdr list1))) - (t - (setq out (cons (car list2) out) - list2 (cdr list2))))) - (while list1 - (setq out (cons (car list1) out) - list1 (cdr list1))) - (while list2 - (setq out (cons (car list2) out) - list2 (cdr list2))) - (nreverse out))) - -;;;###autoload -(defun gnus-sorted-nunion (list1 list2) - "Return union of LIST1 and LIST2 by modifying cdr pointers of LIST1. -LIST1 and LIST2 have to be sorted over <." - (let* ((top (cons nil list1)) - (prev top)) - (while (and list1 list2) - (cond ((= (car list1) (car list2)) - (setq prev list1 - list1 (cdr list1) - list2 (cdr list2))) - ((< (car list1) (car list2)) - (setq prev list1 - list1 (cdr list1))) - (t - (setcdr prev (list (car list2))) - (setq prev (cdr prev) - list2 (cdr list2)) - (setcdr prev list1)))) - (while list2 - (setcdr prev (list (car list2))) - (setq prev (cdr prev) - list2 (cdr list2))) - (cdr top))) - -(defun gnus-compress-sequence (numbers &optional always-list) - "Convert list of numbers to a list of ranges or a single range. -If ALWAYS-LIST is non-nil, this function will always release a list of -ranges." - (let* ((first (car numbers)) - (last (car numbers)) - result) - (if (null numbers) - nil - (if (not (listp (cdr numbers))) - numbers - (while numbers - (cond ((= last (car numbers)) nil) ;Omit duplicated number - ((= (1+ last) (car numbers)) ;Still in sequence - (setq last (car numbers))) - (t ;End of one sequence - (setq result - (cons (if (= first last) first - (cons first last)) - result)) - (setq first (car numbers)) - (setq last (car numbers)))) - (setq numbers (cdr numbers))) - (if (and (not always-list) (null result)) - (if (= first last) (list first) (cons first last)) - (nreverse (cons (if (= first last) first (cons first last)) - result))))))) - -(defalias 'gnus-uncompress-sequence 'gnus-uncompress-range) -(defun gnus-uncompress-range (ranges) - "Expand a list of ranges into a list of numbers. -RANGES is either a single range on the form `(num . num)' or a list of -these ranges." - (let (first last result) - (cond - ((null ranges) - nil) - ((not (listp (cdr ranges))) - (setq first (car ranges)) - (setq last (cdr ranges)) - (while (<= first last) - (setq result (cons first result)) - (setq first (1+ first))) - (nreverse result)) - (t - (while ranges - (if (atom (car ranges)) - (when (numberp (car ranges)) - (setq result (cons (car ranges) result))) - (setq first (caar ranges)) - (setq last (cdar ranges)) - (while (<= first last) - (setq result (cons first result)) - (setq first (1+ first)))) - (setq ranges (cdr ranges))) - (nreverse result))))) - -(defun gnus-add-to-range (ranges list) - "Return a list of ranges that has all articles from both RANGES and LIST. -Note: LIST has to be sorted over `<'." - (if (not ranges) - (gnus-compress-sequence list t) - (setq list (copy-sequence list)) - (unless (listp (cdr ranges)) - (setq ranges (list ranges))) - (let ((out ranges) - ilist lowest highest temp) - (while (and ranges list) - (setq ilist list) - (setq lowest (or (and (atom (car ranges)) (car ranges)) - (caar ranges))) - (while (and list (cdr list) (< (cadr list) lowest)) - (setq list (cdr list))) - (when (< (car ilist) lowest) - (setq temp list) - (setq list (cdr list)) - (setcdr temp nil) - (setq out (nconc (gnus-compress-sequence ilist t) out))) - (setq highest (or (and (atom (car ranges)) (car ranges)) - (cdar ranges))) - (while (and list (<= (car list) highest)) - (setq list (cdr list))) - (setq ranges (cdr ranges))) - (when list - (setq out (nconc (gnus-compress-sequence list t) out))) - (setq out (sort out (lambda (r1 r2) - (< (or (and (atom r1) r1) (car r1)) - (or (and (atom r2) r2) (car r2)))))) - (setq ranges out) - (while ranges - (if (atom (car ranges)) - (when (cdr ranges) - (if (atom (cadr ranges)) - (when (= (1+ (car ranges)) (cadr ranges)) - (setcar ranges (cons (car ranges) - (cadr ranges))) - (setcdr ranges (cddr ranges))) - (when (= (1+ (car ranges)) (caadr ranges)) - (setcar (cadr ranges) (car ranges)) - (setcar ranges (cadr ranges)) - (setcdr ranges (cddr ranges))))) - (when (cdr ranges) - (if (atom (cadr ranges)) - (when (= (1+ (cdar ranges)) (cadr ranges)) - (setcdr (car ranges) (cadr ranges)) - (setcdr ranges (cddr ranges))) - (when (= (1+ (cdar ranges)) (caadr ranges)) - (setcdr (car ranges) (cdadr ranges)) - (setcdr ranges (cddr ranges)))))) - (setq ranges (cdr ranges))) - out))) - -(defun gnus-remove-from-range (range1 range2) - "Return a range that has all articles from RANGE2 removed from RANGE1. -The returned range is always a list. RANGE2 can also be a unsorted -list of articles. RANGE1 is modified by side effects, RANGE2 is not -modified." - (if (or (null range1) (null range2)) - range1 - (let (out r1 r2 r1_min r1_max r2_min r2_max - (range2 (gnus-copy-sequence range2))) - (setq range1 (if (listp (cdr range1)) range1 (list range1)) - range2 (sort (if (listp (cdr range2)) range2 (list range2)) - (lambda (e1 e2) - (< (if (consp e1) (car e1) e1) - (if (consp e2) (car e2) e2)))) - r1 (car range1) - r2 (car range2) - r1_min (if (consp r1) (car r1) r1) - r1_max (if (consp r1) (cdr r1) r1) - r2_min (if (consp r2) (car r2) r2) - r2_max (if (consp r2) (cdr r2) r2)) - (while (and range1 range2) - (cond ((< r2_max r1_min) ; r2 < r1 - (pop range2) - (setq r2 (car range2) - r2_min (if (consp r2) (car r2) r2) - r2_max (if (consp r2) (cdr r2) r2))) - ((and (<= r2_min r1_min) (<= r1_max r2_max)) ; r2 overlap r1 - (pop range1) - (setq r1 (car range1) - r1_min (if (consp r1) (car r1) r1) - r1_max (if (consp r1) (cdr r1) r1))) - ((and (<= r2_min r1_min) (<= r2_max r1_max)) ; r2 overlap min r1 - (pop range2) - (setq r1_min (1+ r2_max) - r2 (car range2) - r2_min (if (consp r2) (car r2) r2) - r2_max (if (consp r2) (cdr r2) r2))) - ((and (<= r1_min r2_min) (<= r2_max r1_max)) ; r2 contained in r1 - (if (eq r1_min (1- r2_min)) - (push r1_min out) - (push (cons r1_min (1- r2_min)) out)) - (pop range2) - (if (< r2_max r1_max) ; finished with r1? - (setq r1_min (1+ r2_max)) - (pop range1) - (setq r1 (car range1) - r1_min (if (consp r1) (car r1) r1) - r1_max (if (consp r1) (cdr r1) r1))) - (setq r2 (car range2) - r2_min (if (consp r2) (car r2) r2) - r2_max (if (consp r2) (cdr r2) r2))) - ((and (<= r2_min r1_max) (<= r1_max r2_max)) ; r2 overlap max r1 - (if (eq r1_min (1- r2_min)) - (push r1_min out) - (push (cons r1_min (1- r2_min)) out)) - (pop range1) - (setq r1 (car range1) - r1_min (if (consp r1) (car r1) r1) - r1_max (if (consp r1) (cdr r1) r1))) - ((< r1_max r2_min) ; r2 > r1 - (pop range1) - (if (eq r1_min r1_max) - (push r1_min out) - (push (cons r1_min r1_max) out)) - (setq r1 (car range1) - r1_min (if (consp r1) (car r1) r1) - r1_max (if (consp r1) (cdr r1) r1))))) - (when r1 - (if (eq r1_min r1_max) - (push r1_min out) - (push (cons r1_min r1_max) out)) - (pop range1)) - (while range1 - (push (pop range1) out)) - (nreverse out)))) - -(defun gnus-member-of-range (number ranges) - (if (not (listp (cdr ranges))) - (and (>= number (car ranges)) - (<= number (cdr ranges))) - (let ((not-stop t)) - (while (and ranges - (if (numberp (car ranges)) - (>= number (car ranges)) - (>= number (caar ranges))) - not-stop) - (when (if (numberp (car ranges)) - (= number (car ranges)) - (and (>= number (caar ranges)) - (<= number (cdar ranges)))) - (setq not-stop nil)) - (setq ranges (cdr ranges))) - (not not-stop)))) - -(defun gnus-list-range-intersection (list ranges) - "Return a list of numbers in LIST that are members of RANGES. -LIST is a sorted list." - (setq ranges (gnus-range-normalize ranges)) - (let (number result) - (while (setq number (pop list)) - (while (and ranges - (if (numberp (car ranges)) - (< (car ranges) number) - (< (cdar ranges) number))) - (setq ranges (cdr ranges))) - (when (and ranges - (if (numberp (car ranges)) - (= (car ranges) number) - ;; (caar ranges) <= number <= (cdar ranges) - (>= number (caar ranges)))) - (push number result))) - (nreverse result))) - -(defalias 'gnus-inverse-list-range-intersection 'gnus-list-range-difference) - -(defun gnus-list-range-difference (list ranges) - "Return a list of numbers in LIST that are not members of RANGES. -LIST is a sorted list." - (setq ranges (gnus-range-normalize ranges)) - (let (number result) - (while (setq number (pop list)) - (while (and ranges - (if (numberp (car ranges)) - (< (car ranges) number) - (< (cdar ranges) number))) - (setq ranges (cdr ranges))) - (when (or (not ranges) - (if (numberp (car ranges)) - (not (= (car ranges) number)) - ;; not ((caar ranges) <= number <= (cdar ranges)) - (< number (caar ranges)))) - (push number result))) - (nreverse result))) - -(defun gnus-range-length (range) - "Return the length RANGE would have if uncompressed." - (cond - ((null range) - 0) - ((not (listp (cdr range))) - (- (cdr range) (car range) -1)) - (t - (let ((sum 0)) - (dolist (x range sum) - (setq sum - (+ sum (if (consp x) (- (cdr x) (car x) -1) 1)))))))) - -(defun gnus-sublist-p (list sublist) - "Test whether all elements in SUBLIST are members of LIST." - (let ((sublistp t)) - (while sublist - (unless (memq (pop sublist) list) - (setq sublistp nil - sublist nil))) - sublistp)) - -(defun gnus-range-add (range1 range2) - "Add RANGE2 to RANGE1 (nondestructively)." - (unless (listp (cdr range1)) - (setq range1 (list range1))) - (unless (listp (cdr range2)) - (setq range2 (list range2))) - (let ((item1 (pop range1)) - (item2 (pop range2)) - range item selector) - (while (or item1 item2) - (setq selector - (cond - ((null item1) nil) - ((null item2) t) - ((and (numberp item1) (numberp item2)) (< item1 item2)) - ((numberp item1) (< item1 (car item2))) - ((numberp item2) (< (car item1) item2)) - (t (< (car item1) (car item2))))) - (setq item - (or - (let ((tmp1 item) (tmp2 (if selector item1 item2))) - (cond - ((null tmp1) tmp2) - ((null tmp2) tmp1) - ((and (numberp tmp1) (numberp tmp2)) - (cond - ((eq tmp1 tmp2) tmp1) - ((eq (1+ tmp1) tmp2) (cons tmp1 tmp2)) - ((eq (1+ tmp2) tmp1) (cons tmp2 tmp1)) - (t nil))) - ((numberp tmp1) - (cond - ((and (>= tmp1 (car tmp2)) (<= tmp1 (cdr tmp2))) tmp2) - ((eq (1+ tmp1) (car tmp2)) (cons tmp1 (cdr tmp2))) - ((eq (1- tmp1) (cdr tmp2)) (cons (car tmp2) tmp1)) - (t nil))) - ((numberp tmp2) - (cond - ((and (>= tmp2 (car tmp1)) (<= tmp2 (cdr tmp1))) tmp1) - ((eq (1+ tmp2) (car tmp1)) (cons tmp2 (cdr tmp1))) - ((eq (1- tmp2) (cdr tmp1)) (cons (car tmp1) tmp2)) - (t nil))) - ((< (1+ (cdr tmp1)) (car tmp2)) nil) - ((< (1+ (cdr tmp2)) (car tmp1)) nil) - (t (cons (min (car tmp1) (car tmp2)) - (max (cdr tmp1) (cdr tmp2)))))) - (progn - (if item (push item range)) - (if selector item1 item2)))) - (if selector - (setq item1 (pop range1)) - (setq item2 (pop range2)))) - (if item (push item range)) - (reverse range))) - -;;;###autoload -(defun gnus-add-to-sorted-list (list num) - "Add NUM into sorted LIST by side effect." - (let* ((top (cons nil list)) - (prev top)) - (while (and list (< (car list) num)) - (setq prev list - list (cdr list))) - (unless (eq (car list) num) - (setcdr prev (cons num list))) - (cdr top))) - -(defun gnus-range-map (func range) - "Apply FUNC to each value contained by RANGE." - (setq range (gnus-range-normalize range)) - (while range - (let ((span (pop range))) - (if (numberp span) - (funcall func span) - (let ((first (car span)) - (last (cdr span))) - (while (<= first last) - (funcall func first) - (setq first (1+ first)))))))) - -(provide 'gnus-range) - -;;; arch-tag: 4780bdd8-5a15-4aff-be28-18727895b6ad -;;; gnus-range.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-registry.el b/xemacs-packages/gnus/lisp/gnus-registry.el deleted file mode 100644 index 11c5e362..00000000 --- a/xemacs-packages/gnus/lisp/gnus-registry.el +++ /dev/null @@ -1,695 +0,0 @@ -;;; gnus-registry.el --- article registry for Gnus - -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Ted Zlatanov -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; This is the gnus-registry.el package, works with other backends -;; besides nnmail. The major issue is that it doesn't go across -;; backends, so for instance if an article is in nnml:sys and you see -;; a reference to it in nnimap splitting, the article will end up in -;; nnimap:sys - -;; gnus-registry.el intercepts article respooling, moving, deleting, -;; and copying for all backends. If it doesn't work correctly for -;; you, submit a bug report and I'll be glad to fix it. It needs -;; documentation in the manual (also on my to-do list). - -;; Put this in your startup file (~/.gnus.el for instance) - -;; (setq gnus-registry-max-entries 2500 -;; gnus-registry-use-long-group-names t) - -;; (gnus-registry-initialize) - -;; Then use this in your fancy-split: - -;; (: gnus-registry-split-fancy-with-parent) - -;; TODO: - -;; - get the correct group on spool actions - -;; - articles that are spooled to a different backend should be handled - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) -(require 'gnus-int) -(require 'gnus-sum) -(require 'gnus-util) -(require 'nnmail) - -(defvar gnus-registry-dirty t - "Boolean set to t when the registry is modified") - -(defgroup gnus-registry nil - "The Gnus registry." - :version "22.1" - :group 'gnus) - -(defvar gnus-registry-hashtb nil - "*The article registry by Message ID.") - -(defcustom gnus-registry-unfollowed-groups '("delayed" "drafts" "queue") - "List of groups that gnus-registry-split-fancy-with-parent won't follow. -The group names are matched, they don't have to be fully qualified." - :group 'gnus-registry - :type '(repeat string)) - -(defcustom gnus-registry-install nil - "Whether the registry should be installed." - :group 'gnus-registry - :type 'boolean) - -(defcustom gnus-registry-clean-empty t - "Whether the empty registry entries should be deleted. -Registry entries are considered empty when they have no groups." - :group 'gnus-registry - :type 'boolean) - -(defcustom gnus-registry-use-long-group-names nil - "Whether the registry should use long group names (BUGGY)." - :group 'gnus-registry - :type 'boolean) - -(defcustom gnus-registry-track-extra nil - "Whether the registry should track extra data about a message. -The Subject and Sender (From:) headers are currently tracked this -way." - :group 'gnus-registry - :type - '(set :tag "Tracking choices" - (const :tag "Track by subject (Subject: header)" subject) - (const :tag "Track by sender (From: header)" sender))) - -(defcustom gnus-registry-entry-caching t - "Whether the registry should cache extra information." - :group 'gnus-registry - :type 'boolean) - -(defcustom gnus-registry-minimum-subject-length 5 - "The minimum length of a subject before it's considered trackable." - :group 'gnus-registry - :type 'integer) - -(defcustom gnus-registry-trim-articles-without-groups t - "Whether the registry should clean out message IDs without groups." - :group 'gnus-registry - :type 'boolean) - -(defcustom gnus-registry-cache-file "~/.gnus.registry.eld" - "File where the Gnus registry will be stored." - :group 'gnus-registry - :type 'file) - -(defcustom gnus-registry-max-entries nil - "Maximum number of entries in the registry, nil for unlimited." - :group 'gnus-registry - :type '(radio (const :format "Unlimited " nil) - (integer :format "Maximum number: %v"))) - -;; Function(s) missing in Emacs 20 -(when (memq nil (mapcar 'fboundp '(puthash))) - (require 'cl) - (unless (fboundp 'puthash) - ;; alias puthash is missing from Emacs 20 cl-extra.el - (defalias 'puthash 'cl-puthash))) - -(defun gnus-registry-track-subject-p () - (memq 'subject gnus-registry-track-extra)) - -(defun gnus-registry-track-sender-p () - (memq 'sender gnus-registry-track-extra)) - -(defun gnus-registry-cache-read () - "Read the registry cache file." - (interactive) - (let ((file gnus-registry-cache-file)) - (when (file-exists-p file) - (gnus-message 5 "Reading %s..." file) - (gnus-load file) - (gnus-message 5 "Reading %s...done" file)))) - -;; FIXME: Get rid of duplicated code, cf. `gnus-save-newsrc-file' in -;; `gnus-start.el'. --rsteib -(defun gnus-registry-cache-save () - "Save the registry cache file." - (interactive) - (let ((file gnus-registry-cache-file)) - (save-excursion - (set-buffer (gnus-get-buffer-create " *Gnus-registry-cache*")) - (make-local-variable 'version-control) - (setq version-control gnus-backup-startup-file) - (setq buffer-file-name file) - (setq default-directory (file-name-directory buffer-file-name)) - (buffer-disable-undo) - (erase-buffer) - (gnus-message 5 "Saving %s..." file) - (if gnus-save-startup-file-via-temp-buffer - (let ((coding-system-for-write gnus-ding-file-coding-system) - (standard-output (current-buffer))) - (gnus-gnus-to-quick-newsrc-format t "gnus registry startup file" 'gnus-registry-alist) - (gnus-registry-cache-whitespace file) - (save-buffer)) - (let ((coding-system-for-write gnus-ding-file-coding-system) - (version-control gnus-backup-startup-file) - (startup-file file) - (working-dir (file-name-directory file)) - working-file - (i -1)) - ;; Generate the name of a non-existent file. - (while (progn (setq working-file - (format - (if (and (eq system-type 'ms-dos) - (not (gnus-long-file-names))) - "%s#%d.tm#" ; MSDOS limits files to 8+3 - (if (memq system-type '(vax-vms axp-vms)) - "%s$tmp$%d" - "%s#tmp#%d")) - working-dir (setq i (1+ i)))) - (file-exists-p working-file))) - - (unwind-protect - (progn - (gnus-with-output-to-file working-file - (gnus-gnus-to-quick-newsrc-format t "gnus registry startup file" 'gnus-registry-alist)) - - ;; These bindings will mislead the current buffer - ;; into thinking that it is visiting the startup - ;; file. - (let ((buffer-backed-up nil) - (buffer-file-name startup-file) - (file-precious-flag t) - (setmodes (file-modes startup-file))) - ;; Backup the current version of the startup file. - (backup-buffer) - - ;; Replace the existing startup file with the temp file. - (rename-file working-file startup-file t) - (set-file-modes startup-file setmodes))) - (condition-case nil - (delete-file working-file) - (file-error nil))))) - - (gnus-kill-buffer (current-buffer)) - (gnus-message 5 "Saving %s...done" file)))) - -;; Idea from Dan Christensen -;; Save the gnus-registry file with extra line breaks. -(defun gnus-registry-cache-whitespace (filename) - (gnus-message 5 "Adding whitespace to %s" filename) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "^(\\|(\\\"" nil t) - (replace-match "\n\\&" t)) - (goto-char (point-min)) - (while (re-search-forward " $" nil t) - (replace-match "" t t)))) - -(defun gnus-registry-save (&optional force) - (when (or gnus-registry-dirty force) - (let ((caching gnus-registry-entry-caching)) - ;; turn off entry caching, so mtime doesn't get recorded - (setq gnus-registry-entry-caching nil) - ;; remove entry caches - (maphash - (lambda (key value) - (if (hash-table-p value) - (remhash key gnus-registry-hashtb))) - gnus-registry-hashtb) - ;; remove empty entries - (when gnus-registry-clean-empty - (gnus-registry-clean-empty-function)) - ;; now trim the registry appropriately - (setq gnus-registry-alist (gnus-registry-trim - (gnus-hashtable-to-alist - gnus-registry-hashtb))) - ;; really save - (gnus-registry-cache-save) - (setq gnus-registry-entry-caching caching) - (setq gnus-registry-dirty nil)))) - -(defun gnus-registry-clean-empty-function () - "Remove all empty entries from the registry. Returns count thereof." - (let ((count 0)) - (maphash - (lambda (key value) - (unless (gnus-registry-fetch-group key) - (incf count) - (remhash key gnus-registry-hashtb))) - gnus-registry-hashtb) - count)) - -(defun gnus-registry-read () - (gnus-registry-cache-read) - (setq gnus-registry-hashtb (gnus-alist-to-hashtable gnus-registry-alist)) - (setq gnus-registry-dirty nil)) - -(defun gnus-registry-trim (alist) - "Trim alist to size, using gnus-registry-max-entries." - (if (null gnus-registry-max-entries) - alist ; just return the alist - ;; else, when given max-entries, trim the alist - (let* ((timehash (make-hash-table - :size 4096 - :test 'equal)) - (trim-length (- (length alist) gnus-registry-max-entries)) - (trim-length (if (natnump trim-length) trim-length 0))) - (maphash - (lambda (key value) - (puthash key (gnus-registry-fetch-extra key 'mtime) timehash)) - gnus-registry-hashtb) - - ;; we use the return value of this setq, which is the trimmed alist - (setq alist - (nthcdr - trim-length - (sort alist - (lambda (a b) - (time-less-p - (cdr (gethash (car a) timehash)) - (cdr (gethash (car b) timehash)))))))))) - -(defun gnus-registry-action (action data-header from &optional to method) - (let* ((id (mail-header-id data-header)) - (subject (gnus-registry-simplify-subject - (mail-header-subject data-header))) - (sender (mail-header-from data-header)) - (from (gnus-group-guess-full-name-from-command-method from)) - (to (if to (gnus-group-guess-full-name-from-command-method to) nil)) - (to-name (if to to "the Bit Bucket")) - (old-entry (gethash id gnus-registry-hashtb))) - (gnus-message 5 "Registry: article %s %s from %s to %s" - id - (if method "respooling" "going") - from - to) - - ;; All except copy will need a delete - (gnus-registry-delete-group id from) - - (when (equal 'copy action) - (gnus-registry-add-group id from subject sender)) ; undo the delete - - (gnus-registry-add-group id to subject sender))) - -(defun gnus-registry-spool-action (id group &optional subject sender) - (let ((group (gnus-group-guess-full-name-from-command-method group))) - (when (and (stringp id) (string-match "\r$" id)) - (setq id (substring id 0 -1))) - (gnus-message 5 "Registry: article %s spooled to %s" - id - group) - (gnus-registry-add-group id group subject sender))) - -;; Function for nn{mail|imap}-split-fancy: look up all references in -;; the cache and if a match is found, return that group. -(defun gnus-registry-split-fancy-with-parent () - "Split this message into the same group as its parent. The parent -is obtained from the registry. This function can be used as an entry -in `nnmail-split-fancy' or `nnimap-split-fancy', for example like -this: (: gnus-registry-split-fancy-with-parent) - -For a message to be split, it looks for the parent message in the -References or In-Reply-To header and then looks in the registry to -see which group that message was put in. This group is returned. - -See the Info node `(gnus)Fancy Mail Splitting' for more details." - (let ((refstr (or (message-fetch-field "references") - (message-fetch-field "in-reply-to"))) - (nnmail-split-fancy-with-parent-ignore-groups - (if (listp nnmail-split-fancy-with-parent-ignore-groups) - nnmail-split-fancy-with-parent-ignore-groups - (list nnmail-split-fancy-with-parent-ignore-groups))) - references res) - (if refstr - (progn - (setq references (nreverse (gnus-split-references refstr))) - (mapcar (lambda (x) - (setq res (or (gnus-registry-fetch-group x) res)) - (when (or (gnus-registry-grep-in-list - res - gnus-registry-unfollowed-groups) - (gnus-registry-grep-in-list - res - nnmail-split-fancy-with-parent-ignore-groups)) - (setq res nil))) - references)) - - ;; else: there were no references, now try the extra tracking - (let ((sender (message-fetch-field "from")) - (subject (gnus-registry-simplify-subject - (message-fetch-field "subject"))) - (single-match t)) - (when (and single-match - (gnus-registry-track-sender-p) - sender) - (maphash - (lambda (key value) - (let ((this-sender (cdr - (gnus-registry-fetch-extra key 'sender)))) - (when (and single-match - this-sender - (equal sender this-sender)) - ;; too many matches, bail - (unless (equal res (gnus-registry-fetch-group key)) - (setq single-match nil)) - (setq res (gnus-registry-fetch-group key)) - (gnus-message - ;; raise level of messaging if gnus-registry-track-extra - (if gnus-registry-track-extra 5 9) - "%s (extra tracking) traced sender %s to group %s" - "gnus-registry-split-fancy-with-parent" - sender - (if res res "nil"))))) - gnus-registry-hashtb)) - (when (and single-match - (gnus-registry-track-subject-p) - subject - (< gnus-registry-minimum-subject-length (length subject))) - (maphash - (lambda (key value) - (let ((this-subject (cdr - (gnus-registry-fetch-extra key 'subject)))) - (when (and single-match - this-subject - (equal subject this-subject)) - ;; too many matches, bail - (unless (equal res (gnus-registry-fetch-group key)) - (setq single-match nil)) - (setq res (gnus-registry-fetch-group key)) - (gnus-message - ;; raise level of messaging if gnus-registry-track-extra - (if gnus-registry-track-extra 5 9) - "%s (extra tracking) traced subject %s to group %s" - "gnus-registry-split-fancy-with-parent" - subject - (if res res "nil"))))) - gnus-registry-hashtb)) - (unless single-match - (gnus-message - 5 - "gnus-registry-split-fancy-with-parent: too many extra matches for %s" - refstr) - (setq res nil)))) - (gnus-message - 5 - "gnus-registry-split-fancy-with-parent traced %s to group %s" - refstr (if res res "nil")) - - (when (and res gnus-registry-use-long-group-names) - (let ((m1 (gnus-find-method-for-group res)) - (m2 (or gnus-command-method - (gnus-find-method-for-group gnus-newsgroup-name))) - (short-res (gnus-group-short-name res))) - (if (gnus-methods-equal-p m1 m2) - (progn - (gnus-message - 9 - "gnus-registry-split-fancy-with-parent stripped group %s to %s" - res - short-res) - (setq res short-res)) - ;; else... - (gnus-message - 5 - "gnus-registry-split-fancy-with-parent ignored foreign group %s" - res) - (setq res nil)))) - res)) - -(defun gnus-registry-register-message-ids () - "Register the Message-ID of every article in the group" - (unless (gnus-parameter-registry-ignore gnus-newsgroup-name) - (dolist (article gnus-newsgroup-articles) - (let ((id (gnus-registry-fetch-message-id-fast article))) - (unless (gnus-registry-fetch-group id) - (gnus-message 9 "Registry: Registering article %d with group %s" - article gnus-newsgroup-name) - (gnus-registry-add-group - (gnus-registry-fetch-message-id-fast article) - gnus-newsgroup-name - (gnus-registry-fetch-simplified-message-subject-fast article) - (gnus-registry-fetch-sender-fast article))))))) - -(defun gnus-registry-fetch-message-id-fast (article) - "Fetch the Message-ID quickly, using the internal gnus-data-list function" - (if (and (numberp article) - (assoc article (gnus-data-list nil))) - (mail-header-id (gnus-data-header (assoc article (gnus-data-list nil)))) - nil)) - -(defun gnus-registry-simplify-subject (subject) - (if (stringp subject) - (gnus-simplify-subject subject) - nil)) - -(defun gnus-registry-fetch-simplified-message-subject-fast (article) - "Fetch the Subject quickly, using the internal gnus-data-list function" - (if (and (numberp article) - (assoc article (gnus-data-list nil))) - (gnus-registry-simplify-subject - (mail-header-subject (gnus-data-header - (assoc article (gnus-data-list nil))))) - nil)) - -(defun gnus-registry-fetch-sender-fast (article) - "Fetch the Sender quickly, using the internal gnus-data-list function" - (if (and (numberp article) - (assoc article (gnus-data-list nil))) - (mail-header-from (gnus-data-header - (assoc article (gnus-data-list nil)))) - nil)) - -(defun gnus-registry-grep-in-list (word list) - (when word - (memq nil - (mapcar 'not - (mapcar - (lambda (x) - (string-match x word)) - list))))) - -(defun gnus-registry-fetch-extra (id &optional entry) - "Get the extra data of a message, based on the message ID. -Returns the first place where the trail finds a nonstring." - (let ((entry-cache (gethash entry gnus-registry-hashtb))) - (if (and entry - (hash-table-p entry-cache) - (gethash id entry-cache)) - (gethash id entry-cache) - ;; else, if there is no caching possible... - (let ((trail (gethash id gnus-registry-hashtb))) - (when (listp trail) - (dolist (crumb trail) - (unless (stringp crumb) - (return (gnus-registry-fetch-extra-entry crumb entry id))))))))) - -(defun gnus-registry-fetch-extra-entry (alist &optional entry id) - "Get the extra data of a message, or a specific entry in it. -Update the entry cache if needed." - (if (and entry id) - (let ((entry-cache (gethash entry gnus-registry-hashtb)) - entree) - (when gnus-registry-entry-caching - ;; create the hash table - (unless (hash-table-p entry-cache) - (setq entry-cache (make-hash-table - :size 4096 - :test 'equal)) - (puthash entry entry-cache gnus-registry-hashtb)) - - ;; get the entree from the hash table or from the alist - (setq entree (gethash id entry-cache))) - - (unless entree - (setq entree (assq entry alist)) - (when gnus-registry-entry-caching - (puthash id entree entry-cache))) - entree) - alist)) - -(defun gnus-registry-store-extra (id extra) - "Store the extra data of a message, based on the message ID. -The message must have at least one group name." - (when (gnus-registry-group-count id) - ;; we now know the trail has at least 1 group name, so it's not empty - (let ((trail (gethash id gnus-registry-hashtb)) - (old-extra (gnus-registry-fetch-extra id)) - entry-cache) - (dolist (crumb trail) - (unless (stringp crumb) - (dolist (entry crumb) - (setq entry-cache (gethash (car entry) gnus-registry-hashtb)) - (when entry-cache - (remhash id entry-cache)))) - (puthash id (cons extra (delete old-extra trail)) - gnus-registry-hashtb) - (setq gnus-registry-dirty t))))) - -(defun gnus-registry-store-extra-entry (id key value) - "Put a specific entry in the extras field of the registry entry for id." - (let* ((extra (gnus-registry-fetch-extra id)) - (alist (cons (cons key value) - (gnus-assq-delete-all key (gnus-registry-fetch-extra id))))) - (gnus-registry-store-extra id alist))) - -(defun gnus-registry-fetch-group (id) - "Get the group of a message, based on the message ID. -Returns the first place where the trail finds a group name." - (when (gnus-registry-group-count id) - ;; we now know the trail has at least 1 group name - (let ((trail (gethash id gnus-registry-hashtb))) - (dolist (crumb trail) - (when (stringp crumb) - (return (if gnus-registry-use-long-group-names - crumb - (gnus-group-short-name crumb)))))))) - -(defun gnus-registry-group-count (id) - "Get the number of groups of a message, based on the message ID." - (let ((trail (gethash id gnus-registry-hashtb))) - (if (and trail (listp trail)) - (apply '+ (mapcar (lambda (x) (if (stringp x) 1 0)) trail)) - 0))) - -(defun gnus-registry-delete-group (id group) - "Delete a group for a message, based on the message ID." - (when group - (when id - (let ((trail (gethash id gnus-registry-hashtb)) - (group (gnus-group-short-name group))) - (puthash id (if trail - (delete group trail) - nil) - gnus-registry-hashtb)) - ;; now, clear the entry if there are no more groups - (when gnus-registry-trim-articles-without-groups - (unless (gnus-registry-group-count id) - (gnus-registry-delete-id id))) - ;; is this ID still in the registry? - (when (gethash id gnus-registry-hashtb) - (gnus-registry-store-extra-entry id 'mtime (current-time)))))) - -(defun gnus-registry-delete-id (id) - "Delete a message ID from the registry." - (when (stringp id) - (remhash id gnus-registry-hashtb) - (maphash - (lambda (key value) - (when (hash-table-p value) - (remhash id value))) - gnus-registry-hashtb))) - -(defun gnus-registry-add-group (id group &optional subject sender) - "Add a group for a message, based on the message ID." - (when group - (when (and id - (not (string-match "totally-fudged-out-message-id" id))) - (let ((full-group group) - (group (if gnus-registry-use-long-group-names - group - (gnus-group-short-name group)))) - (gnus-registry-delete-group id group) - - (unless gnus-registry-use-long-group-names ;; unnecessary in this case - (gnus-registry-delete-group id full-group)) - - (let ((trail (gethash id gnus-registry-hashtb))) - (puthash id (if trail - (cons group trail) - (list group)) - gnus-registry-hashtb) - - (when (and (gnus-registry-track-subject-p) - subject) - (gnus-registry-store-extra-entry - id - 'subject - (gnus-registry-simplify-subject subject))) - (when (and (gnus-registry-track-sender-p) - sender) - (gnus-registry-store-extra-entry - id - 'sender - sender)) - - (gnus-registry-store-extra-entry id 'mtime (current-time))))))) - -(defun gnus-registry-clear () - "Clear the Gnus registry." - (interactive) - (setq gnus-registry-alist nil) - (setq gnus-registry-hashtb (gnus-alist-to-hashtable gnus-registry-alist)) - (setq gnus-registry-dirty t)) - -;;;###autoload -(defun gnus-registry-initialize () - (interactive) - (setq gnus-registry-install t) - (gnus-registry-install-hooks) - (gnus-registry-read)) - -;;;###autoload -(defun gnus-registry-install-hooks () - "Install the registry hooks." - (interactive) - (add-hook 'gnus-summary-article-move-hook 'gnus-registry-action) - (add-hook 'gnus-summary-article-delete-hook 'gnus-registry-action) - (add-hook 'gnus-summary-article-expire-hook 'gnus-registry-action) - (add-hook 'nnmail-spool-hook 'gnus-registry-spool-action) - - (add-hook 'gnus-save-newsrc-hook 'gnus-registry-save) - (add-hook 'gnus-read-newsrc-el-hook 'gnus-registry-read) - - (add-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids)) - -(defun gnus-registry-unload-hook () - "Uninstall the registry hooks." - (interactive) - (remove-hook 'gnus-summary-article-move-hook 'gnus-registry-action) - (remove-hook 'gnus-summary-article-delete-hook 'gnus-registry-action) - (remove-hook 'gnus-summary-article-expire-hook 'gnus-registry-action) - (remove-hook 'nnmail-spool-hook 'gnus-registry-spool-action) - - (remove-hook 'gnus-save-newsrc-hook 'gnus-registry-save) - (remove-hook 'gnus-read-newsrc-el-hook 'gnus-registry-read) - - (remove-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids)) - -(add-hook 'gnus-registry-unload-hook 'gnus-registry-unload-hook) - -(when gnus-registry-install - (gnus-registry-install-hooks) - (gnus-registry-read)) - -;; TODO: a lot of things - -(provide 'gnus-registry) - -;;; arch-tag: 5cba0a32-718a-4a97-8c91-0a15af21da94 -;;; gnus-registry.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-salt.el b/xemacs-packages/gnus/lisp/gnus-salt.el deleted file mode 100644 index 13f61033..00000000 --- a/xemacs-packages/gnus/lisp/gnus-salt.el +++ /dev/null @@ -1,1055 +0,0 @@ -;;; gnus-salt.el --- alternate summary mode interfaces for Gnus - -;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) -(require 'gnus-sum) -(require 'gnus-win) - -;;; -;;; gnus-pick-mode -;;; - -(defvar gnus-pick-mode nil - "Minor mode for providing a pick-and-read interface in Gnus -summary buffers.") - -(defcustom gnus-pick-display-summary nil - "*Display summary while reading." - :type 'boolean - :group 'gnus-summary-pick) - -(defcustom gnus-pick-mode-hook nil - "Hook run in summary pick mode buffers." - :type 'hook - :group 'gnus-summary-pick) - -(when (featurep 'xemacs) - (add-hook 'gnus-pick-mode-hook 'gnus-xmas-pick-menu-add)) - -(defcustom gnus-mark-unpicked-articles-as-read nil - "*If non-nil, mark all unpicked articles as read." - :type 'boolean - :group 'gnus-summary-pick) - -(defcustom gnus-pick-elegant-flow t - "If non-nil, `gnus-pick-start-reading' runs - `gnus-summary-next-group' when no articles have been picked." - :type 'boolean - :group 'gnus-summary-pick) - -(defcustom gnus-summary-pick-line-format - "%-5P %U\%R\%z\%I\%(%[%4L: %-23,23n%]%) %s\n" - "*The format specification of the lines in pick buffers. -It accepts the same format specs that `gnus-summary-line-format' does." - :type 'string - :group 'gnus-summary-pick) - -;;; Internal variables. - -(defvar gnus-pick-mode-map nil) - -(unless gnus-pick-mode-map - (setq gnus-pick-mode-map (make-sparse-keymap)) - - (gnus-define-keys gnus-pick-mode-map - " " gnus-pick-next-page - "u" gnus-pick-unmark-article-or-thread - "." gnus-pick-article-or-thread - gnus-down-mouse-2 gnus-pick-mouse-pick-region - "\r" gnus-pick-start-reading)) - -(defun gnus-pick-make-menu-bar () - (unless (boundp 'gnus-pick-menu) - (easy-menu-define - gnus-pick-menu gnus-pick-mode-map "" - '("Pick" - ("Pick" - ["Article" gnus-summary-mark-as-processable t] - ["Thread" gnus-uu-mark-thread t] - ["Region" gnus-uu-mark-region t] - ["Regexp" gnus-uu-mark-by-regexp t] - ["Buffer" gnus-uu-mark-buffer t]) - ("Unpick" - ["Article" gnus-summary-unmark-as-processable t] - ["Thread" gnus-uu-unmark-thread t] - ["Region" gnus-uu-unmark-region t] - ["Regexp" gnus-uu-unmark-by-regexp t] - ["Buffer" gnus-summary-unmark-all-processable t]) - ["Start reading" gnus-pick-start-reading t] - ["Switch pick mode off" gnus-pick-mode gnus-pick-mode])))) - -(defun gnus-pick-mode (&optional arg) - "Minor mode for providing a pick-and-read interface in Gnus summary buffers. - -\\{gnus-pick-mode-map}" - (interactive "P") - (when (eq major-mode 'gnus-summary-mode) - (if (not (set (make-local-variable 'gnus-pick-mode) - (if (null arg) (not gnus-pick-mode) - (> (prefix-numeric-value arg) 0)))) - (remove-hook 'gnus-message-setup-hook 'gnus-pick-setup-message) - ;; Make sure that we don't select any articles upon group entry. - (set (make-local-variable 'gnus-auto-select-first) nil) - ;; Change line format. - (setq gnus-summary-line-format gnus-summary-pick-line-format) - (setq gnus-summary-line-format-spec nil) - (gnus-update-format-specifications nil 'summary) - (gnus-update-summary-mark-positions) - (add-hook 'gnus-message-setup-hook 'gnus-pick-setup-message) - (set (make-local-variable 'gnus-summary-goto-unread) 'never) - ;; Set up the menu. - (when (gnus-visual-p 'pick-menu 'menu) - (gnus-pick-make-menu-bar)) - (gnus-add-minor-mode 'gnus-pick-mode " Pick" gnus-pick-mode-map) - (gnus-run-hooks 'gnus-pick-mode-hook)))) - -(defun gnus-pick-setup-message () - "Make Message do the right thing on exit." - (when (and (gnus-buffer-live-p gnus-summary-buffer) - (with-current-buffer gnus-summary-buffer - gnus-pick-mode)) - (message-add-action - `(gnus-configure-windows ,gnus-current-window-configuration t) - 'send 'exit 'postpone 'kill))) - -(defvar gnus-pick-line-number 1) -(defun gnus-pick-line-number () - "Return the current line number." - (if (bobp) - (setq gnus-pick-line-number 1) - (incf gnus-pick-line-number))) - -(defun gnus-pick-start-reading (&optional catch-up) - "Start reading the picked articles. -If given a prefix, mark all unpicked articles as read." - (interactive "P") - (if gnus-newsgroup-processable - (progn - (gnus-summary-limit-to-articles nil) - (when (or catch-up gnus-mark-unpicked-articles-as-read) - (gnus-summary-limit-mark-excluded-as-read)) - (gnus-summary-first-article) - (gnus-configure-windows - (if gnus-pick-display-summary 'article 'pick) t)) - (if gnus-pick-elegant-flow - (progn - (when (or catch-up gnus-mark-unpicked-articles-as-read) - (gnus-summary-catchup nil t)) - (if (gnus-group-quit-config gnus-newsgroup-name) - (gnus-summary-exit) - (gnus-summary-next-group))) - (error "No articles have been picked")))) - -(defun gnus-pick-goto-article (arg) - "Go to the article number indicated by ARG. -If ARG is an invalid article number, then stay on current line." - (let (pos) - (save-excursion - (goto-char (point-min)) - (when (zerop (forward-line (1- (prefix-numeric-value arg)))) - (setq pos (point)))) - (if (not pos) - (gnus-error 2 "No such line: %s" arg) - (goto-char pos)))) - -(defun gnus-pick-article (&optional arg) - "Pick the article on the current line. -If ARG, pick the article on that line instead." - (interactive "P") - (when arg - (gnus-pick-goto-article arg)) - (gnus-summary-mark-as-processable 1)) - -(defun gnus-pick-article-or-thread (&optional arg) - "If `gnus-thread-hide-subtree' is t, then pick the thread on the current line. -Otherwise pick the article on the current line. -If ARG, pick the article/thread on that line instead." - (interactive "P") - (when arg - (gnus-pick-goto-article arg)) - (if gnus-thread-hide-subtree - (progn - (save-excursion - (gnus-uu-mark-thread)) - (forward-line 1)) - (gnus-summary-mark-as-processable 1))) - -(defun gnus-pick-unmark-article-or-thread (&optional arg) - "If `gnus-thread-hide-subtree' is t, then unmark the thread on current line. -Otherwise unmark the article on current line. -If ARG, unmark thread/article on that line instead." - (interactive "P") - (when arg - (gnus-pick-goto-article arg)) - (if gnus-thread-hide-subtree - (save-excursion - (gnus-uu-unmark-thread)) - (gnus-summary-unmark-as-processable 1))) - -(defun gnus-pick-mouse-pick (e) - (interactive "e") - (mouse-set-point e) - (save-excursion - (gnus-summary-mark-as-processable 1))) - -(defun gnus-pick-mouse-pick-region (start-event) - "Pick articles that the mouse is dragged over. -This must be bound to a button-down mouse event." - (interactive "e") - (mouse-minibuffer-check start-event) - (let* ((echo-keystrokes 0) - (start-posn (event-start start-event)) - (start-point (posn-point start-posn)) - (start-line (1+ (count-lines (point-min) start-point))) - (start-window (posn-window start-posn)) - (bounds (gnus-window-edges start-window)) - (top (nth 1 bounds)) - (bottom (if (window-minibuffer-p start-window) - (nth 3 bounds) - ;; Don't count the mode line. - (1- (nth 3 bounds)))) - (click-count (1- (event-click-count start-event)))) - (setq mouse-selection-click-count click-count) - (setq mouse-selection-click-count-buffer (current-buffer)) - (mouse-set-point start-event) - ;; In case the down click is in the middle of some intangible text, - ;; use the end of that text, and put it in START-POINT. - (when (< (point) start-point) - (goto-char start-point)) - (gnus-pick-article) - (setq start-point (point)) - ;; end-of-range is used only in the single-click case. - ;; It is the place where the drag has reached so far - ;; (but not outside the window where the drag started). - (let (event end end-point (end-of-range (point))) - (track-mouse - (while (progn - (setq event (cdr (gnus-read-event-char))) - (or (mouse-movement-p event) - (eq (car-safe event) 'switch-frame))) - (if (eq (car-safe event) 'switch-frame) - nil - (setq end (event-end event) - end-point (posn-point end)) - - (cond - ;; Are we moving within the original window? - ((and (eq (posn-window end) start-window) - (integer-or-marker-p end-point)) - ;; Go to START-POINT first, so that when we move to END-POINT, - ;; if it's in the middle of intangible text, - ;; point jumps in the direction away from START-POINT. - (goto-char start-point) - (goto-char end-point) - (gnus-pick-article) - ;; In case the user moved his mouse really fast, pick - ;; articles on the line between this one and the last one. - (let* ((this-line (1+ (count-lines (point-min) end-point))) - (min-line (min this-line start-line)) - (max-line (max this-line start-line))) - ;; Why not use `forward-line'? --Stef - (while (< min-line max-line) - (goto-line min-line) - (gnus-pick-article) - (setq min-line (1+ min-line))) - (setq start-line this-line)) - (when (zerop (% click-count 3)) - (setq end-of-range (point)))) - (t - (let ((mouse-row (cdr (cdr (mouse-position))))) - (cond - ((null mouse-row)) - ((< mouse-row top) - (mouse-scroll-subr start-window (- mouse-row top))) - ((>= mouse-row bottom) - (mouse-scroll-subr start-window - (1+ (- mouse-row bottom))))))))))) - (when (consp event) - (let ((fun (key-binding (vector (car event))))) - ;; Run the binding of the terminating up-event, if possible. - ;; In the case of a multiple click, it gives the wrong results, - ;; because it would fail to set up a region. - (when nil - ;; (and (= (mod mouse-selection-click-count 3) 0) (fboundp fun)) - ;; In this case, we can just let the up-event execute normally. - (let ((end (event-end event))) - ;; Set the position in the event before we replay it, - ;; because otherwise it may have a position in the wrong - ;; buffer. - (setcar (cdr end) end-of-range) - ;; Delete the overlay before calling the function, - ;; because delete-overlay increases buffer-modified-tick. - (push event unread-command-events)))))))) - -(defun gnus-pick-next-page () - "Go to the next page. If at the end of the buffer, start reading articles." - (interactive) - (let ((scroll-in-place nil)) - (condition-case nil - (scroll-up) - (end-of-buffer (gnus-pick-start-reading))))) - -;;; -;;; gnus-binary-mode -;;; - -(defvar gnus-binary-mode nil - "Minor mode for providing a binary group interface in Gnus summary buffers.") - -(defvar gnus-binary-mode-hook nil - "Hook run in summary binary mode buffers.") - -(defvar gnus-binary-mode-map nil) - -(unless gnus-binary-mode-map - (setq gnus-binary-mode-map (make-sparse-keymap)) - - (gnus-define-keys - gnus-binary-mode-map - "g" gnus-binary-show-article)) - -(defun gnus-binary-make-menu-bar () - (unless (boundp 'gnus-binary-menu) - (easy-menu-define - gnus-binary-menu gnus-binary-mode-map "" - '("Pick" - ["Switch binary mode off" gnus-binary-mode t])))) - -(defun gnus-binary-mode (&optional arg) - "Minor mode for providing a binary group interface in Gnus summary buffers." - (interactive "P") - (when (eq major-mode 'gnus-summary-mode) - (make-local-variable 'gnus-binary-mode) - (setq gnus-binary-mode - (if (null arg) (not gnus-binary-mode) - (> (prefix-numeric-value arg) 0))) - (when gnus-binary-mode - ;; Make sure that we don't select any articles upon group entry. - (make-local-variable 'gnus-auto-select-first) - (setq gnus-auto-select-first nil) - (make-local-variable 'gnus-summary-display-article-function) - (setq gnus-summary-display-article-function 'gnus-binary-display-article) - ;; Set up the menu. - (when (gnus-visual-p 'binary-menu 'menu) - (gnus-binary-make-menu-bar)) - (gnus-add-minor-mode 'gnus-binary-mode " Binary" gnus-binary-mode-map) - (gnus-run-hooks 'gnus-binary-mode-hook)))) - -(defun gnus-binary-display-article (article &optional all-header) - "Run ARTICLE through the binary decode functions." - (when (gnus-summary-goto-subject article) - (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) - (gnus-uu-decode-uu)))) - -(defun gnus-binary-show-article (&optional arg) - "Bypass the binary functions and show the article." - (interactive "P") - (let (gnus-summary-display-article-function) - (gnus-summary-show-article arg))) - -;;; -;;; gnus-tree-mode -;;; - -(defcustom gnus-tree-line-format "%(%[%3,3n%]%)" - "Format of tree elements." - :type 'string - :group 'gnus-summary-tree) - -(defcustom gnus-tree-minimize-window t - "If non-nil, minimize the tree buffer window. -If a number, never let the tree buffer grow taller than that number of -lines." - :type '(choice boolean - integer) - :group 'gnus-summary-tree) - -(defcustom gnus-selected-tree-face 'modeline - "*Face used for highlighting selected articles in the thread tree." - :type 'face - :group 'gnus-summary-tree) - -(defvar gnus-tree-brackets '((?\[ . ?\]) (?\( . ?\)) - (?\{ . ?\}) (?< . ?>)) - "Brackets used in tree nodes.") - -(defvar gnus-tree-parent-child-edges '(?- ?\\ ?|) - "Characters used to connect parents with children.") - -(defcustom gnus-tree-mode-line-format "Gnus: %%b %S %Z" - "*The format specification for the tree mode line." - :type 'string - :group 'gnus-summary-tree) - -(defcustom gnus-generate-tree-function 'gnus-generate-vertical-tree - "*Function for generating a thread tree. -Two predefined functions are available: -`gnus-generate-horizontal-tree' and `gnus-generate-vertical-tree'." - :type '(radio (function-item gnus-generate-vertical-tree) - (function-item gnus-generate-horizontal-tree) - (function :tag "Other" nil)) - :group 'gnus-summary-tree) - -(defcustom gnus-tree-mode-hook nil - "*Hook run in tree mode buffers." - :type 'hook - :group 'gnus-summary-tree) - -(when (featurep 'xemacs) - (add-hook 'gnus-tree-mode-hook 'gnus-xmas-tree-menu-add) - (add-hook 'gnus-tree-mode-hook 'gnus-xmas-switch-horizontal-scrollbar-off)) - - -;;; Internal variables. - -(defvar gnus-tree-line-format-alist - `((?n gnus-tmp-name ?s) - (?f gnus-tmp-from ?s) - (?N gnus-tmp-number ?d) - (?\[ gnus-tmp-open-bracket ?c) - (?\] gnus-tmp-close-bracket ?c) - (?s gnus-tmp-subject ?s))) - -(defvar gnus-tree-mode-line-format-alist gnus-summary-mode-line-format-alist) - -(defvar gnus-tree-mode-line-format-spec nil) -(defvar gnus-tree-line-format-spec nil) - -(defvar gnus-tree-node-length nil) -(defvar gnus-selected-tree-overlay nil) - -(defvar gnus-tree-displayed-thread nil) -(defvar gnus-tree-inhibit nil) - -(defvar gnus-tree-mode-map nil) -(put 'gnus-tree-mode 'mode-class 'special) - -(unless gnus-tree-mode-map - (setq gnus-tree-mode-map (make-keymap)) - (suppress-keymap gnus-tree-mode-map) - (gnus-define-keys - gnus-tree-mode-map - "\r" gnus-tree-select-article - gnus-mouse-2 gnus-tree-pick-article - "\C-?" gnus-tree-read-summary-keys - "h" gnus-tree-show-summary - - "\C-c\C-i" gnus-info-find-node) - - (substitute-key-definition - 'undefined 'gnus-tree-read-summary-keys gnus-tree-mode-map)) - -(defun gnus-tree-make-menu-bar () - (unless (boundp 'gnus-tree-menu) - (easy-menu-define - gnus-tree-menu gnus-tree-mode-map "" - '("Tree" - ["Select article" gnus-tree-select-article t])))) - -(defun gnus-tree-mode () - "Major mode for displaying thread trees." - (interactive) - (gnus-set-format 'tree-mode) - (gnus-set-format 'tree t) - (when (gnus-visual-p 'tree-menu 'menu) - (gnus-tree-make-menu-bar)) - (kill-all-local-variables) - (gnus-simplify-mode-line) - (setq mode-name "Tree") - (setq major-mode 'gnus-tree-mode) - (use-local-map gnus-tree-mode-map) - (buffer-disable-undo) - (setq buffer-read-only t) - (setq truncate-lines t) - (save-excursion - (gnus-set-work-buffer) - (gnus-tree-node-insert (make-mail-header "") nil) - (setq gnus-tree-node-length (1- (point)))) - (gnus-run-mode-hooks 'gnus-tree-mode-hook)) - -(defun gnus-tree-read-summary-keys (&optional arg) - "Read a summary buffer key sequence and execute it." - (interactive "P") - (unless gnus-tree-inhibit - (let ((buf (current-buffer)) - (gnus-tree-inhibit t) - win) - (set-buffer gnus-article-buffer) - (gnus-article-read-summary-keys arg nil t) - (when (setq win (get-buffer-window buf)) - (select-window win) - (when gnus-selected-tree-overlay - (goto-char (or (gnus-overlay-end gnus-selected-tree-overlay) 1))) - (gnus-tree-minimize))))) - -(defun gnus-tree-show-summary () - "Reconfigure windows to show summary buffer." - (interactive) - (if (not (gnus-buffer-live-p gnus-summary-buffer)) - (error "There is no summary buffer for this tree buffer") - (gnus-configure-windows 'article) - (gnus-summary-goto-subject gnus-current-article))) - -(defun gnus-tree-select-article (article) - "Select the article under point, if any." - (interactive (list (gnus-tree-article-number))) - (let ((buf (current-buffer))) - (when article - (with-current-buffer gnus-summary-buffer - (gnus-summary-goto-article article)) - (select-window (get-buffer-window buf))))) - -(defun gnus-tree-pick-article (e) - "Select the article under the mouse pointer." - (interactive "e") - (mouse-set-point e) - (gnus-tree-select-article (gnus-tree-article-number))) - -(defun gnus-tree-article-number () - (get-text-property (point) 'gnus-number)) - -(defun gnus-tree-article-region (article) - "Return a cons with BEG and END of the article region." - (let ((pos (text-property-any - (point-min) (point-max) 'gnus-number article))) - (when pos - (cons pos (next-single-property-change pos 'gnus-number))))) - -(defun gnus-tree-goto-article (article) - (let ((pos (text-property-any - (point-min) (point-max) 'gnus-number article))) - (when pos - (goto-char pos)))) - -(defun gnus-tree-recenter () - "Center point in the tree window." - (let ((selected (selected-window)) - (tree-window (gnus-get-buffer-window gnus-tree-buffer t))) - (when tree-window - (select-window tree-window) - (when gnus-selected-tree-overlay - (goto-char (or (gnus-overlay-end gnus-selected-tree-overlay) 1))) - (let* ((top (cond ((< (window-height) 4) 0) - ((< (window-height) 7) 1) - (t 2))) - (height (1- (window-height))) - (bottom (save-excursion (goto-char (point-max)) - (forward-line (- height)) - (point)))) - ;; Set the window start to either `bottom', which is the biggest - ;; possible valid number, or the second line from the top, - ;; whichever is the least. - (set-window-start - tree-window (min bottom (save-excursion - (forward-line (- top)) (point))))) - (select-window selected)))) - -(defun gnus-get-tree-buffer () - "Return the tree buffer properly initialized." - (with-current-buffer (gnus-get-buffer-create gnus-tree-buffer) - (unless (eq major-mode 'gnus-tree-mode) - (gnus-tree-mode)) - (current-buffer))) - -(defun gnus-tree-minimize () - (when (and gnus-tree-minimize-window - (not (one-window-p))) - (let ((windows 0) - tot-win-height) - (walk-windows (lambda (window) (incf windows))) - (setq tot-win-height - (- (frame-height) - (* window-min-height (1- windows)) - 2)) - (let* ((window-min-height 2) - (height (count-lines (point-min) (point-max))) - (min (max (1- window-min-height) height)) - (tot (if (numberp gnus-tree-minimize-window) - (min gnus-tree-minimize-window min) - min)) - (win (get-buffer-window (current-buffer))) - (wh (and win (1- (window-height win))))) - (setq tot (min tot tot-win-height)) - (when (and win - (not (eq tot wh))) - (let ((selected (selected-window))) - (when (ignore-errors (select-window win)) - (enlarge-window (- tot wh)) - (select-window selected)))))))) - -;;; Generating the tree. - -(defun gnus-tree-node-insert (header sparse &optional adopted) - (let* ((dummy (stringp header)) - (header (if (vectorp header) header - (progn - (setq header (make-mail-header "*****")) - (mail-header-set-number header 0) - (mail-header-set-lines header 0) - (mail-header-set-chars header 0) - header))) - (gnus-tmp-from (mail-header-from header)) - (gnus-tmp-subject (mail-header-subject header)) - (gnus-tmp-number (mail-header-number header)) - (gnus-tmp-name - (cond - ((string-match "(.+)" gnus-tmp-from) - (substring gnus-tmp-from - (1+ (match-beginning 0)) (1- (match-end 0)))) - ((string-match "<[^>]+> *$" gnus-tmp-from) - (let ((beg (match-beginning 0))) - (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from) - (substring gnus-tmp-from (1+ (match-beginning 0)) - (1- (match-end 0)))) - (substring gnus-tmp-from 0 beg)))) - ((memq gnus-tmp-number sparse) - "***") - (t gnus-tmp-from))) - (gnus-tmp-open-bracket - (cond ((memq gnus-tmp-number sparse) - (caadr gnus-tree-brackets)) - (dummy (caaddr gnus-tree-brackets)) - (adopted (car (nth 3 gnus-tree-brackets))) - (t (caar gnus-tree-brackets)))) - (gnus-tmp-close-bracket - (cond ((memq gnus-tmp-number sparse) - (cdadr gnus-tree-brackets)) - (adopted (cdr (nth 3 gnus-tree-brackets))) - (dummy - (cdaddr gnus-tree-brackets)) - (t (cdar gnus-tree-brackets)))) - (buffer-read-only nil) - beg end) - (gnus-add-text-properties - (setq beg (point)) - (setq end (progn (eval gnus-tree-line-format-spec) (point))) - (list 'gnus-number gnus-tmp-number)) - (when (or t (gnus-visual-p 'tree-highlight 'highlight)) - (gnus-tree-highlight-node gnus-tmp-number beg end)))) - -(defun gnus-tree-highlight-node (article beg end) - "Highlight current line according to `gnus-summary-highlight'." - (let ((list gnus-summary-highlight) - face) - (with-current-buffer gnus-summary-buffer - (let* ((score (or (cdr (assq article gnus-newsgroup-scored)) - gnus-summary-default-score 0)) - (default gnus-summary-default-score) - (default-high gnus-summary-default-high-score) - (default-low gnus-summary-default-low-score) - (uncached (memq article gnus-newsgroup-undownloaded)) - (downloaded (not uncached)) - (mark (or (gnus-summary-article-mark article) gnus-unread-mark))) - ;; Eval the cars of the lists until we find a match. - (while (and list - (not (eval (caar list)))) - (setq list (cdr list))))) - (unless (eq (setq face (cdar list)) (get-text-property beg 'face)) - (gnus-put-text-property-excluding-characters-with-faces - beg end 'face - (if (boundp face) (symbol-value face) face))))) - -(defun gnus-tree-indent (level) - (insert (make-string (1- (* (1+ gnus-tree-node-length) level)) ? ))) - -(defvar gnus-tmp-limit) -(defvar gnus-tmp-sparse) -(defvar gnus-tmp-indent) - -(defun gnus-generate-tree (thread) - "Generate a thread tree for THREAD." - (with-current-buffer (gnus-get-tree-buffer) - (let ((buffer-read-only nil) - (gnus-tmp-indent 0)) - (erase-buffer) - (funcall gnus-generate-tree-function thread 0) - (gnus-set-mode-line 'tree) - (goto-char (point-min)) - (gnus-tree-minimize) - (gnus-tree-recenter) - (let ((selected (selected-window))) - (when (gnus-get-buffer-window (set-buffer gnus-tree-buffer) t) - (select-window (gnus-get-buffer-window (set-buffer gnus-tree-buffer) t)) - (gnus-horizontal-recenter) - (select-window selected)))))) - -(defun gnus-generate-horizontal-tree (thread level &optional dummyp adopted) - "Generate a horizontal tree." - (let* ((dummy (stringp (car thread))) - (do (or dummy - (and (car thread) - (memq (mail-header-number (car thread)) - gnus-tmp-limit)))) - col beg) - (if (not do) - ;; We don't want this article. - (setq thread (cdr thread)) - (if (not (bolp)) - ;; Not the first article on the line, so we insert a "-". - (insert (car gnus-tree-parent-child-edges)) - ;; If the level isn't zero, then we insert some indentation. - (unless (zerop level) - (gnus-tree-indent level) - (insert (cadr gnus-tree-parent-child-edges)) - (setq col (- (setq beg (point)) (gnus-point-at-bol) 1)) - ;; Draw "|" lines upwards. - (while (progn - (forward-line -1) - (forward-char col) - (eq (char-after) ? )) - (delete-char 1) - (insert (caddr gnus-tree-parent-child-edges))) - (goto-char beg))) - (setq dummyp nil) - ;; Insert the article node. - (gnus-tree-node-insert (pop thread) gnus-tmp-sparse adopted)) - (if (null thread) - ;; End of the thread, so we go to the next line. - (unless (bolp) - (insert "\n")) - ;; Recurse downwards in all children of this article. - (while thread - (gnus-generate-horizontal-tree - (pop thread) (if do (1+ level) level) - (or dummyp dummy) dummy))))) - -(defsubst gnus-tree-indent-vertical () - (let ((len (- (* (1+ gnus-tree-node-length) gnus-tmp-indent) - (- (point) (gnus-point-at-bol))))) - (when (> len 0) - (insert (make-string len ? ))))) - -(defsubst gnus-tree-forward-line (n) - (while (>= (decf n) 0) - (unless (zerop (forward-line 1)) - (end-of-line) - (insert "\n"))) - (end-of-line)) - -(defun gnus-generate-vertical-tree (thread level &optional dummyp adopted) - "Generate a vertical tree." - (let* ((dummy (stringp (car thread))) - (do (or dummy - (and (car thread) - (memq (mail-header-number (car thread)) - gnus-tmp-limit)))) - beg) - (if (not do) - ;; We don't want this article. - (setq thread (cdr thread)) - (if (not (save-excursion (beginning-of-line) (bobp))) - ;; Not the first article on the line, so we insert a "-". - (progn - (gnus-tree-indent-vertical) - (insert (make-string (/ gnus-tree-node-length 2) ? )) - (insert (caddr gnus-tree-parent-child-edges)) - (gnus-tree-forward-line 1)) - ;; If the level isn't zero, then we insert some indentation. - (unless (zerop gnus-tmp-indent) - (gnus-tree-forward-line (1- (* 2 level))) - (gnus-tree-indent-vertical) - (delete-char -1) - (insert (cadr gnus-tree-parent-child-edges)) - (setq beg (point)) - (forward-char -1) - ;; Draw "-" lines leftwards. - (while (and (not (bobp)) - (eq (char-after (1- (point))) ? )) - (delete-char -1) - (insert (car gnus-tree-parent-child-edges)) - (forward-char -1)) - (goto-char beg) - (gnus-tree-forward-line 1))) - (setq dummyp nil) - ;; Insert the article node. - (gnus-tree-indent-vertical) - (gnus-tree-node-insert (pop thread) gnus-tmp-sparse adopted) - (gnus-tree-forward-line 1)) - (if (null thread) - ;; End of the thread, so we go to the next line. - (progn - (goto-char (point-min)) - (end-of-line) - (incf gnus-tmp-indent)) - ;; Recurse downwards in all children of this article. - (while thread - (gnus-generate-vertical-tree - (pop thread) (if do (1+ level) level) - (or dummyp dummy) dummy))))) - -;;; Interface functions. - -(defun gnus-possibly-generate-tree (article &optional force) - "Generate the thread tree for ARTICLE if it isn't displayed already." - (when (with-current-buffer gnus-summary-buffer - (and gnus-use-trees - gnus-show-threads - (vectorp (gnus-summary-article-header article)))) - (save-excursion - (let ((top (with-current-buffer gnus-summary-buffer - (gnus-cut-thread - (gnus-remove-thread - (mail-header-id - (gnus-summary-article-header article)) - t)))) - (gnus-tmp-limit gnus-newsgroup-limit) - (gnus-tmp-sparse gnus-newsgroup-sparse)) - (when (or force - (not (eq top gnus-tree-displayed-thread))) - (gnus-generate-tree top) - (setq gnus-tree-displayed-thread top)))))) - -(defun gnus-tree-open (group) - (gnus-get-tree-buffer)) - -(defun gnus-tree-close (group) - (gnus-kill-buffer gnus-tree-buffer)) - -(defun gnus-tree-perhaps-minimize () - (when (and gnus-tree-minimize-window - (get-buffer gnus-tree-buffer)) - (with-current-buffer gnus-tree-buffer - (gnus-tree-minimize)))) - -(defun gnus-highlight-selected-tree (article) - "Highlight the selected article in the tree." - (let ((buf (current-buffer)) - region) - (set-buffer gnus-tree-buffer) - (when (setq region (gnus-tree-article-region article)) - (when (or (not gnus-selected-tree-overlay) - (gnus-extent-detached-p gnus-selected-tree-overlay)) - ;; Create a new overlay. - (gnus-overlay-put - (setq gnus-selected-tree-overlay - (gnus-make-overlay (point-min) (1+ (point-min)))) - 'face gnus-selected-tree-face)) - ;; Move the overlay to the article. - (gnus-move-overlay - gnus-selected-tree-overlay (goto-char (car region)) (cdr region)) - (gnus-tree-minimize) - (gnus-tree-recenter) - (let ((selected (selected-window))) - (when (gnus-get-buffer-window (set-buffer gnus-tree-buffer) t) - (select-window (gnus-get-buffer-window (set-buffer gnus-tree-buffer) t)) - (gnus-horizontal-recenter) - (select-window selected)))) -;; If we remove this save-excursion, it updates the wrong mode lines?!? - (with-current-buffer gnus-tree-buffer - (gnus-set-mode-line 'tree)) - (set-buffer buf))) - -(defun gnus-tree-highlight-article (article face) - (with-current-buffer (gnus-get-tree-buffer) - (let (region) - (when (setq region (gnus-tree-article-region article)) - (gnus-put-text-property (car region) (cdr region) 'face face) - (set-window-point - (gnus-get-buffer-window (current-buffer) t) (cdr region)))))) - -;;; -;;; gnus-carpal -;;; - -(defvar gnus-carpal-group-buffer-buttons - '(("next" . gnus-group-next-unread-group) - ("prev" . gnus-group-prev-unread-group) - ("read" . gnus-group-read-group) - ("select" . gnus-group-select-group) - ("catch-up" . gnus-group-catchup-current) - ("new-news" . gnus-group-get-new-news-this-group) - ("toggle-sub" . gnus-group-unsubscribe-current-group) - ("subscribe" . gnus-group-unsubscribe-group) - ("kill" . gnus-group-kill-group) - ("yank" . gnus-group-yank-group) - ("describe" . gnus-group-describe-group) - "list" - ("subscribed" . gnus-group-list-groups) - ("all" . gnus-group-list-all-groups) - ("killed" . gnus-group-list-killed) - ("zombies" . gnus-group-list-zombies) - ("matching" . gnus-group-list-matching) - ("post" . gnus-group-post-news) - ("mail" . gnus-group-mail) - ("local" . (lambda () (interactive) (gnus-group-news 0))) - ("rescan" . gnus-group-get-new-news) - ("browse-foreign" . gnus-group-browse-foreign) - ("exit" . gnus-group-exit))) - -(defvar gnus-carpal-summary-buffer-buttons - '("mark" - ("read" . gnus-summary-mark-as-read-forward) - ("tick" . gnus-summary-tick-article-forward) - ("clear" . gnus-summary-clear-mark-forward) - ("expirable" . gnus-summary-mark-as-expirable) - "move" - ("scroll" . gnus-summary-next-page) - ("next-unread" . gnus-summary-next-unread-article) - ("prev-unread" . gnus-summary-prev-unread-article) - ("first" . gnus-summary-first-unread-article) - ("best" . gnus-summary-best-unread-article) - "article" - ("headers" . gnus-summary-toggle-header) - ("uudecode" . gnus-uu-decode-uu) - ("enter-digest" . gnus-summary-enter-digest-group) - ("fetch-parent" . gnus-summary-refer-parent-article) - "mail" - ("move" . gnus-summary-move-article) - ("copy" . gnus-summary-copy-article) - ("respool" . gnus-summary-respool-article) - "threads" - ("lower" . gnus-summary-lower-thread) - ("kill" . gnus-summary-kill-thread) - "post" - ("post" . gnus-summary-post-news) - ("local" . gnus-summary-news-other-window) - ("mail" . gnus-summary-mail-other-window) - ("followup" . gnus-summary-followup-with-original) - ("reply" . gnus-summary-reply-with-original) - ("cancel" . gnus-summary-cancel-article) - "misc" - ("exit" . gnus-summary-exit) - ("fed-up" . gnus-summary-catchup-and-goto-next-group))) - -(defvar gnus-carpal-server-buffer-buttons - '(("add" . gnus-server-add-server) - ("browse" . gnus-server-browse-server) - ("list" . gnus-server-list-servers) - ("kill" . gnus-server-kill-server) - ("yank" . gnus-server-yank-server) - ("copy" . gnus-server-copy-server) - ("exit" . gnus-server-exit))) - -(defvar gnus-carpal-browse-buffer-buttons - '(("subscribe" . gnus-browse-unsubscribe-current-group) - ("exit" . gnus-browse-exit))) - -(defvar gnus-carpal-group-buffer "*Carpal Group*") -(defvar gnus-carpal-summary-buffer "*Carpal Summary*") -(defvar gnus-carpal-server-buffer "*Carpal Server*") -(defvar gnus-carpal-browse-buffer "*Carpal Browse*") - -(defvar gnus-carpal-attached-buffer nil) - -(defvar gnus-carpal-mode-hook nil - "*Hook run in carpal mode buffers.") - -(defvar gnus-carpal-button-face 'bold - "*Face used on carpal buttons.") - -(defvar gnus-carpal-header-face 'bold-italic - "*Face used on carpal buffer headers.") - -(defvar gnus-carpal-mode-map nil) -(put 'gnus-carpal-mode 'mode-class 'special) - -(if gnus-carpal-mode-map - nil - (setq gnus-carpal-mode-map (make-keymap)) - (suppress-keymap gnus-carpal-mode-map) - (define-key gnus-carpal-mode-map " " 'gnus-carpal-select) - (define-key gnus-carpal-mode-map "\r" 'gnus-carpal-select) - (define-key gnus-carpal-mode-map gnus-mouse-2 'gnus-carpal-mouse-select)) - -(defun gnus-carpal-mode () - "Major mode for clicking buttons. - -All normal editing commands are switched off. -\\ -The following commands are available: - -\\{gnus-carpal-mode-map}" - (interactive) - (kill-all-local-variables) - (setq mode-line-modified (cdr gnus-mode-line-modified)) - (setq major-mode 'gnus-carpal-mode) - (setq mode-name "Gnus Carpal") - (setq mode-line-process nil) - (use-local-map gnus-carpal-mode-map) - (buffer-disable-undo) - (setq buffer-read-only t) - (make-local-variable 'gnus-carpal-attached-buffer) - (gnus-run-mode-hooks 'gnus-carpal-mode-hook)) - -(defun gnus-carpal-setup-buffer (type) - (let ((buffer (symbol-value (intern (format "gnus-carpal-%s-buffer" type))))) - (if (get-buffer buffer) - () - (with-current-buffer (gnus-get-buffer-create buffer) - (gnus-carpal-mode) - (setq gnus-carpal-attached-buffer - (intern (format "gnus-%s-buffer" type))) - (let ((buttons (symbol-value - (intern (format "gnus-carpal-%s-buffer-buttons" - type)))) - (buffer-read-only nil) - button) - (while buttons - (setq button (car buttons) - buttons (cdr buttons)) - (if (stringp button) - (gnus-set-text-properties - (point) - (prog2 (insert button) (point) (insert " ")) - (list 'face gnus-carpal-header-face)) - (gnus-set-text-properties - (point) - (prog2 (insert (car button)) (point) (insert " ")) - (list 'gnus-callback (cdr button) - 'face gnus-carpal-button-face - gnus-mouse-face-prop 'highlight)))) - (let ((fill-column (- (window-width) 2))) - (fill-region (point-min) (point-max))) - (set-window-point (get-buffer-window (current-buffer)) - (point-min))))))) - -(defun gnus-carpal-select () - "Select the button under point." - (interactive) - (let ((func (get-text-property (point) 'gnus-callback))) - (if (null func) - () - (pop-to-buffer (symbol-value gnus-carpal-attached-buffer)) - (call-interactively func)))) - -(defun gnus-carpal-mouse-select (event) - "Select the button under the mouse pointer." - (interactive "e") - (mouse-set-point event) - (gnus-carpal-select)) - -;;; Allow redefinition of functions. -(gnus-ems-redefine) - -(provide 'gnus-salt) - -;; arch-tag: 35449164-77b3-4398-bcbd-a2e3e998f810 -;;; gnus-salt.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-score.el b/xemacs-packages/gnus/lisp/gnus-score.el deleted file mode 100644 index 67979b4f..00000000 --- a/xemacs-packages/gnus/lisp/gnus-score.el +++ /dev/null @@ -1,3074 +0,0 @@ -;;; gnus-score.el --- scoring code for Gnus - -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Per Abrahamsen -;; Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) -(require 'gnus-sum) -(require 'gnus-range) -(require 'gnus-win) -(require 'message) -(require 'score-mode) - -(autoload 'ffap-string-at-point "ffap") - -(defcustom gnus-global-score-files nil - "List of global score files and directories. -Set this variable if you want to use people's score files. One entry -for each score file or each score file directory. Gnus will decide -by itself what score files are applicable to which group. - -Say you want to use the single score file -\"/ftp.gnus.org@ftp:/pub/larsi/ding/score/soc.motss.SCORE\" and all -score files in the \"/ftp.some-where:/pub/score\" directory. - - (setq gnus-global-score-files - '(\"/ftp.gnus.org:/pub/larsi/ding/score/soc.motss.SCORE\" - \"/ftp.some-where:/pub/score\"))" - :group 'gnus-score-files - :type '(repeat file)) - -(defcustom gnus-score-file-single-match-alist nil - "Alist mapping regexps to lists of score files. -Each element of this alist should be of the form - (\"REGEXP\" [ \"SCORE-FILE-1\" ] [ \"SCORE-FILE-2\" ] ... ) - -If the name of a group is matched by REGEXP, the corresponding scorefiles -will be used for that group. -The first match found is used, subsequent matching entries are ignored (to -use multiple matches, see `gnus-score-file-multiple-match-alist'). - -These score files are loaded in addition to any files returned by -`gnus-score-find-score-files-function'." - :group 'gnus-score-files - :type '(repeat (cons regexp (repeat file)))) - -(defcustom gnus-score-file-multiple-match-alist nil - "Alist mapping regexps to lists of score files. -Each element of this alist should be of the form - (\"REGEXP\" [ \"SCORE-FILE-1\" ] [ \"SCORE-FILE-2\" ] ... ) - -If the name of a group is matched by REGEXP, the corresponding scorefiles -will be used for that group. -If multiple REGEXPs match a group, the score files corresponding to each -match will be used (for only one match to be used, see -`gnus-score-file-single-match-alist'). - -These score files are loaded in addition to any files returned by -`gnus-score-find-score-files-function'." - :group 'gnus-score-files - :type '(repeat (cons regexp (repeat file)))) - -(defcustom gnus-score-file-suffix "SCORE" - "Suffix of the score files." - :group 'gnus-score-files - :type 'string) - -(defcustom gnus-adaptive-file-suffix "ADAPT" - "Suffix of the adaptive score files." - :group 'gnus-score-files - :group 'gnus-score-adapt - :type 'string) - -(defcustom gnus-score-find-score-files-function 'gnus-score-find-bnews - "Function used to find score files. -The function will be called with the group name as the argument, and -should return a list of score files to apply to that group. The score -files do not actually have to exist. - -Predefined values are: - -`gnus-score-find-single': Only apply the group's own score file. -`gnus-score-find-hierarchical': Also apply score files from parent groups. -`gnus-score-find-bnews': Apply score files whose names matches. - -See the documentation to these functions for more information. - -This variable can also be a list of functions to be called. Each -function is given the group name as argument and should either return -a list of score files, or a list of score alists. - -If functions other than these pre-defined functions are used, -the `a' symbolic prefix to the score commands will always use -\"all.SCORE\"." - :group 'gnus-score-files - :type '(radio (function-item gnus-score-find-single) - (function-item gnus-score-find-hierarchical) - (function-item gnus-score-find-bnews) - (repeat :tag "List of functions" - (choice (function :tag "Other" :value 'ignore) - (function-item gnus-score-find-single) - (function-item gnus-score-find-hierarchical) - (function-item gnus-score-find-bnews))) - (function :tag "Other" :value 'ignore))) - -(defcustom gnus-score-interactive-default-score 1000 - "*Scoring commands will raise/lower the score with this number as the default." - :group 'gnus-score-default - :type 'integer) - -(defcustom gnus-score-expiry-days 7 - "*Number of days before unused score file entries are expired. -If this variable is nil, no score file entries will be expired." - :group 'gnus-score-expire - :type '(choice (const :tag "never" nil) - number)) - -(defcustom gnus-update-score-entry-dates t - "*If non-nil, update matching score entry dates. -If this variable is nil, then score entries that provide matches -will be expired along with non-matching score entries." - :group 'gnus-score-expire - :type 'boolean) - -(defcustom gnus-decay-scores nil - "*If non-nil, decay non-permanent scores." - :group 'gnus-score-decay - :type 'boolean) - -(defcustom gnus-decay-score-function 'gnus-decay-score - "*Function called to decay a score. -It is called with one parameter -- the score to be decayed." - :group 'gnus-score-decay - :type '(radio (function-item gnus-decay-score) - (function :tag "Other"))) - -(defcustom gnus-score-decay-constant 3 - "*Decay all \"small\" scores with this amount." - :group 'gnus-score-decay - :type 'integer) - -(defcustom gnus-score-decay-scale .05 - "*Decay all \"big\" scores with this factor." - :group 'gnus-score-decay - :type 'number) - -(defcustom gnus-home-score-file nil - "Variable to control where interactive score entries are to go. -It can be: - - * A string - This file will be used as the home score file. - - * A function - The result of this function will be used as the home score file. - The function will be passed the name of the group as its - parameter. - - * A list - The elements in this list can be: - - * `(regexp file-name ...)' - If the `regexp' matches the group name, the first `file-name' - will be used as the home score file. (Multiple filenames are - allowed so that one may use gnus-score-file-single-match-alist to - set this variable.) - - * A function. - If the function returns non-nil, the result will be used - as the home score file. The function will be passed the - name of the group as its parameter. - - * A string. Use the string as the home score file. - - The list will be traversed from the beginning towards the end looking - for matches." - :group 'gnus-score-files - :type '(choice string - (repeat (choice string - (cons regexp (repeat file)) - function)) - (function-item gnus-hierarchial-home-score-file) - (function-item gnus-current-home-score-file) - function)) - -(defcustom gnus-home-adapt-file nil - "Variable to control where new adaptive score entries are to go. -This variable allows the same syntax as `gnus-home-score-file'." - :group 'gnus-score-adapt - :group 'gnus-score-files - :type '(choice string - (repeat (choice string - (cons regexp (repeat file)) - function)) - function)) - -(defcustom gnus-default-adaptive-score-alist - `((gnus-kill-file-mark) - (gnus-unread-mark) - (gnus-read-mark - (from , (+ 2 gnus-score-decay-constant)) - (subject , (+ 27 gnus-score-decay-constant))) - (gnus-catchup-mark - (subject , (+ -7 (* -1 gnus-score-decay-constant)))) - (gnus-killed-mark - (from , (- -1 gnus-score-decay-constant)) - (subject , (+ -17 (* -1 gnus-score-decay-constant)))) - (gnus-del-mark - (from , (- -1 gnus-score-decay-constant)) - (subject , (+ -12 (* -1 gnus-score-decay-constant))))) - "Alist of marks and scores. -If you use score decays, you might want to set values higher than -`gnus-score-decay-constant'." - :group 'gnus-score-adapt - :type '(repeat (cons (symbol :tag "Mark") - (repeat (list (choice :tag "Header" - (const from) - (const subject) - (symbol :tag "other")) - (integer :tag "Score")))))) - -(defcustom gnus-adaptive-word-length-limit nil - "*Words of a length lesser than this limit will be ignored when doing adaptive scoring." - :version "22.1" - :group 'gnus-score-adapt - :type '(radio (const :format "Unlimited " nil) - (integer :format "Maximum length: %v"))) - -(defcustom gnus-ignored-adaptive-words nil - "List of words to be ignored when doing adaptive word scoring." - :group 'gnus-score-adapt - :type '(repeat string)) - -(defcustom gnus-default-ignored-adaptive-words - '("a" "i" "the" "to" "of" "and" "in" "is" "it" "for" "that" "if" "you" - "this" "be" "on" "with" "not" "have" "are" "or" "as" "from" "can" - "but" "by" "at" "an" "will" "no" "all" "was" "do" "there" "my" "one" - "so" "we" "they" "what" "would" "any" "which" "about" "get" "your" - "use" "some" "me" "then" "name" "like" "out" "when" "up" "time" - "other" "more" "only" "just" "end" "also" "know" "how" "new" "should" - "been" "than" "them" "he" "who" "make" "may" "people" "these" "now" - "their" "here" "into" "first" "could" "way" "had" "see" "work" "well" - "were" "two" "very" "where" "while" "us" "because" "good" "same" - "even" "much" "most" "many" "such" "long" "his" "over" "last" "since" - "right" "before" "our" "without" "too" "those" "why" "must" "part" - "being" "current" "back" "still" "go" "point" "value" "each" "did" - "both" "true" "off" "say" "another" "state" "might" "under" "start" - "try" "re") - "*Default list of words to be ignored when doing adaptive word scoring." - :group 'gnus-score-adapt - :type '(repeat string)) - -(defcustom gnus-default-adaptive-word-score-alist - `((,gnus-read-mark . 30) - (,gnus-catchup-mark . -10) - (,gnus-killed-mark . -20) - (,gnus-del-mark . -15)) - "*Alist of marks and scores." - :group 'gnus-score-adapt - :type '(repeat (cons (character :tag "Mark") - (integer :tag "Score")))) - -(defcustom gnus-adaptive-word-minimum nil - "If a number, this is the minimum score value that can be assigned to a word." - :group 'gnus-score-adapt - :type '(choice (const nil) integer)) - -(defcustom gnus-adaptive-word-no-group-words nil - "If t, don't adaptively score words included in the group name." - :group 'gnus-score-adapt - :type 'boolean) - -(defcustom gnus-score-mimic-keymap nil - "*Have the score entry functions pretend that they are a keymap." - :group 'gnus-score-default - :type 'boolean) - -(defcustom gnus-score-exact-adapt-limit 10 - "*Number that says how long a match has to be before using substring matching. -When doing adaptive scoring, one normally uses fuzzy or substring -matching. However, if the header one matches is short, the possibility -for false positives is great, so if the length of the match is less -than this variable, exact matching will be used. - -If this variable is nil, exact matching will always be used." - :group 'gnus-score-adapt - :type '(choice (const nil) integer)) - -(defcustom gnus-score-uncacheable-files "ADAPT$" - "All score files that match this regexp will not be cached." - :group 'gnus-score-adapt - :group 'gnus-score-files - :type 'regexp) - -(defcustom gnus-score-default-header nil - "Default header when entering new scores. - -Should be one of the following symbols. - - a: from - s: subject - b: body - h: head - i: message-id - t: references - x: xref - e: `extra' (non-standard overview) - l: lines - d: date - f: followup - -If nil, the user will be asked for a header." - :group 'gnus-score-default - :type '(choice (const :tag "from" a) - (const :tag "subject" s) - (const :tag "body" b) - (const :tag "head" h) - (const :tag "message-id" i) - (const :tag "references" t) - (const :tag "xref" x) - (const :tag "extra" e) - (const :tag "lines" l) - (const :tag "date" d) - (const :tag "followup" f) - (const :tag "ask" nil))) - -(defcustom gnus-score-default-type nil - "Default match type when entering new scores. - -Should be one of the following symbols. - - s: substring - e: exact string - f: fuzzy string - r: regexp string - b: before date - a: after date - n: this date - <: less than number - >: greater than number - =: equal to number - -If nil, the user will be asked for a match type." - :group 'gnus-score-default - :type '(choice (const :tag "substring" s) - (const :tag "exact string" e) - (const :tag "fuzzy string" f) - (const :tag "regexp string" r) - (const :tag "before date" b) - (const :tag "after date" a) - (const :tag "this date" n) - (const :tag "less than number" <) - (const :tag "greater than number" >) - (const :tag "equal than number" =) - (const :tag "ask" nil))) - -(defcustom gnus-score-default-fold nil - "Non-nil means use case folding for new score file entries." - :group 'gnus-score-default - :type 'boolean) - -(defcustom gnus-score-default-duration nil - "Default duration of effect when entering new scores. - -Should be one of the following symbols. - - t: temporary - p: permanent - i: immediate - -If nil, the user will be asked for a duration." - :group 'gnus-score-default - :type '(choice (const :tag "temporary" t) - (const :tag "permanent" p) - (const :tag "immediate" i) - (const :tag "ask" nil))) - -(defcustom gnus-score-after-write-file-function nil - "Function called with the name of the score file just written to disk." - :group 'gnus-score-files - :type '(choice (const nil) function)) - -(defcustom gnus-score-thread-simplify nil - "If non-nil, subjects will simplified as in threading." - :group 'gnus-score-various - :type 'boolean) - - - -;; Internal variables. - -(defvar gnus-score-use-all-scores t - "If nil, only `gnus-score-find-score-files-function' is used.") - -(defvar gnus-adaptive-word-syntax-table - (let ((table (copy-syntax-table (standard-syntax-table))) - (numbers '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))) - (while numbers - (modify-syntax-entry (pop numbers) " " table)) - (modify-syntax-entry ?' "w" table) - table) - "Syntax table used when doing adaptive word scoring.") - -(defvar gnus-scores-exclude-files nil) -(defvar gnus-internal-global-score-files nil) -(defvar gnus-score-file-list nil) - -(defvar gnus-short-name-score-file-cache nil) - -(defvar gnus-score-help-winconf nil) -(defvar gnus-adaptive-score-alist gnus-default-adaptive-score-alist) -(defvar gnus-adaptive-word-score-alist gnus-default-adaptive-word-score-alist) -(defvar gnus-score-trace nil) -(defvar gnus-score-edit-buffer nil) - -(defvar gnus-score-alist nil - "Alist containing score information. -The keys can be symbols or strings. The following symbols are defined. - -touched: If this alist has been modified. -mark: Automatically mark articles below this. -expunge: Automatically expunge articles below this. -files: List of other score files to load when loading this one. -eval: Sexp to be evaluated when the score file is loaded. - -String entries have the form (HEADER (MATCH TYPE SCORE DATE) ...) -where HEADER is the header being scored, MATCH is the string we are -looking for, TYPE is a flag indicating whether it should use regexp or -substring matching, SCORE is the score to add and DATE is the date -of the last successful match.") - -(defvar gnus-score-cache nil) -(defvar gnus-scores-articles nil) -(defvar gnus-score-index nil) - - -(defconst gnus-header-index - ;; Name to index alist. - '(("number" 0 gnus-score-integer) - ("subject" 1 gnus-score-string) - ("from" 2 gnus-score-string) - ("date" 3 gnus-score-date) - ("message-id" 4 gnus-score-string) - ("references" 5 gnus-score-string) - ("chars" 6 gnus-score-integer) - ("lines" 7 gnus-score-integer) - ("xref" 8 gnus-score-string) - ("extra" 9 gnus-score-string) - ("head" -1 gnus-score-body) - ("body" -1 gnus-score-body) - ("all" -1 gnus-score-body) - ("followup" 2 gnus-score-followup) - ("thread" 5 gnus-score-thread))) - -;;; Summary mode score maps. - -(gnus-define-keys (gnus-summary-score-map "V" gnus-summary-mode-map) - "s" gnus-summary-set-score - "S" gnus-summary-current-score - "c" gnus-score-change-score-file - "C" gnus-score-customize - "m" gnus-score-set-mark-below - "x" gnus-score-set-expunge-below - "R" gnus-summary-rescore - "e" gnus-score-edit-current-scores - "f" gnus-score-edit-file - "F" gnus-score-flush-cache - "t" gnus-score-find-trace - "w" gnus-score-find-favourite-words) - -;; Summary score file commands - -;; Much modification of the kill (ahem, score) code and lots of the -;; functions are written by Per Abrahamsen . - -(defun gnus-summary-lower-score (&optional score symp) - "Make a score entry based on the current article. -The user will be prompted for header to score on, match type, -permanence, and the string to be used. The numerical prefix will be -used as score. A symbolic prefix of `a' says to use the `all.SCORE' -file for the command instead of the current score file." - (interactive (gnus-interactive "P\ny")) - (gnus-summary-increase-score (- (gnus-score-delta-default score)) symp)) - -(defun gnus-score-kill-help-buffer () - (when (get-buffer "*Score Help*") - (kill-buffer "*Score Help*") - (when gnus-score-help-winconf - (set-window-configuration gnus-score-help-winconf)))) - -(defun gnus-summary-increase-score (&optional score symp) - "Make a score entry based on the current article. -The user will be prompted for header to score on, match type, -permanence, and the string to be used. The numerical prefix will be -used as score. A symbolic prefix of `a' says to use the `all.SCORE' -file for the command instead of the current score file." - (interactive (gnus-interactive "P\ny")) - (let* ((nscore (gnus-score-delta-default score)) - (prefix (if (< nscore 0) ?L ?I)) - (increase (> nscore 0)) - (char-to-header - '((?a "from" nil nil string) - (?s "subject" nil nil string) - (?b "body" "" nil body-string) - (?h "head" "" nil body-string) - (?i "message-id" nil nil string) - (?r "references" "message-id" nil string) - (?x "xref" nil nil string) - (?e "extra" nil nil string) - (?l "lines" nil nil number) - (?d "date" nil nil date) - (?f "followup" nil nil string) - (?t "thread" "message-id" nil string))) - (char-to-type - '((?s s "substring" string) - (?e e "exact string" string) - (?f f "fuzzy string" string) - (?r r "regexp string" string) - (?z s "substring" body-string) - (?p r "regexp string" body-string) - (?b before "before date" date) - (?a after "after date" date) - (?n at "this date" date) - (?< < "less than number" number) - (?> > "greater than number" number) - (?= = "equal to number" number))) - (current-score-file gnus-current-score-file) - (char-to-perm - (list (list ?t (current-time-string) "temporary") - '(?p perm "permanent") '(?i now "immediate"))) - (mimic gnus-score-mimic-keymap) - (hchar (and gnus-score-default-header - (aref (symbol-name gnus-score-default-header) 0))) - (tchar (and gnus-score-default-type - (aref (symbol-name gnus-score-default-type) 0))) - (pchar (and gnus-score-default-duration - (aref (symbol-name gnus-score-default-duration) 0))) - entry temporary type match extra) - - (unwind-protect - (progn - - ;; First we read the header to score. - (while (not hchar) - (if mimic - (progn - (sit-for 1) - (message "%c-" prefix)) - (message "%s header (%s?): " (if increase "Increase" "Lower") - (mapconcat (lambda (s) (char-to-string (car s))) - char-to-header ""))) - (setq hchar (read-char)) - (when (or (= hchar ??) (= hchar ?\C-h)) - (setq hchar nil) - (gnus-score-insert-help "Match on header" char-to-header 1))) - - (gnus-score-kill-help-buffer) - (unless (setq entry (assq (downcase hchar) char-to-header)) - (if mimic (error "%c %c" prefix hchar) - (error "Invalid header type"))) - - (when (/= (downcase hchar) hchar) - ;; This was a majuscule, so we end reading and set the defaults. - (if mimic (message "%c %c" prefix hchar) (message "")) - (setq tchar (or tchar ?s) - pchar (or pchar ?t))) - - (let ((legal-types - (delq nil - (mapcar (lambda (s) - (if (eq (nth 4 entry) - (nth 3 s)) - s nil)) - char-to-type)))) - ;; We continue reading - the type. - (while (not tchar) - (if mimic - (progn - (sit-for 1) (message "%c %c-" prefix hchar)) - (message "%s header '%s' with match type (%s?): " - (if increase "Increase" "Lower") - (nth 1 entry) - (mapconcat (lambda (s) (char-to-string (car s))) - legal-types ""))) - (setq tchar (read-char)) - (when (or (= tchar ??) (= tchar ?\C-h)) - (setq tchar nil) - (gnus-score-insert-help "Match type" legal-types 2))) - - (gnus-score-kill-help-buffer) - (unless (setq type (nth 1 (assq (downcase tchar) legal-types))) - (if mimic (error "%c %c" prefix hchar) - (error "Invalid match type")))) - - (when (/= (downcase tchar) tchar) - ;; It was a majuscule, so we end reading and use the default. - (if mimic (message "%c %c %c" prefix hchar tchar) - (message "")) - (setq pchar (or pchar ?t))) - - ;; We continue reading. - (while (not pchar) - (if mimic - (progn - (sit-for 1) (message "%c %c %c-" prefix hchar tchar)) - (message "%s permanence (%s?): " (if increase "Increase" "Lower") - (mapconcat (lambda (s) (char-to-string (car s))) - char-to-perm ""))) - (setq pchar (read-char)) - (when (or (= pchar ??) (= pchar ?\C-h)) - (setq pchar nil) - (gnus-score-insert-help "Match permanence" char-to-perm 2))) - - (gnus-score-kill-help-buffer) - (if mimic (message "%c %c %c %c" prefix hchar tchar pchar) - (message "")) - (unless (setq temporary (cadr (assq pchar char-to-perm))) - ;; Deal with der(r)ided superannuated paradigms. - (when (and (eq (1+ prefix) 77) - (eq (+ hchar 12) 109) - (eq (1- tchar) 113) - (eq (- pchar 4) 111)) - (error "You rang?")) - (if mimic - (error "%c %c %c %c" prefix hchar tchar pchar) - (error "Invalid match duration")))) - ;; Always kill the score help buffer. - (gnus-score-kill-help-buffer)) - - ;; If scoring an extra (non-standard overview) header, - ;; we must find out which header is in question. - (setq extra - (and gnus-extra-headers - (equal (nth 1 entry) "extra") - (intern ; need symbol - (gnus-completing-read-with-default - (symbol-name (car gnus-extra-headers)) ; default response - "Score extra header" ; prompt - (mapcar (lambda (x) ; completion list - (cons (symbol-name x) x)) - gnus-extra-headers) - nil ; no completion limit - t)))) ; require match - ;; extra is now nil or a symbol. - - ;; We have all the data, so we enter this score. - (setq match (if (string= (nth 2 entry) "") "" - (gnus-summary-header (or (nth 2 entry) (nth 1 entry)) - nil extra))) - - ;; Modify the match, perhaps. - (cond - ((equal (nth 1 entry) "xref") - (when (string-match "^Xref: *" match) - (setq match (substring match (match-end 0)))) - (when (string-match "^[^:]* +" match) - (setq match (substring match (match-end 0)))))) - - (when (memq type '(r R regexp Regexp)) - (setq match (regexp-quote match))) - - ;; Change score file to the "all.SCORE" file. - (when (eq symp 'a) - (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-score-load-file - ;; This is a kludge; yes... - (cond - ((eq gnus-score-find-score-files-function - 'gnus-score-find-hierarchical) - (gnus-score-file-name "")) - ((eq gnus-score-find-score-files-function 'gnus-score-find-single) - current-score-file) - (t - (gnus-score-file-name "all")))))) - - (gnus-summary-score-entry - (nth 1 entry) ; Header - match ; Match - type ; Type - (if (eq score 's) nil score) ; Score - (if (eq temporary 'perm) ; Temp - nil - temporary) - (not (nth 3 entry)) ; Prompt - nil ; not silent - extra) ; non-standard overview. - - (when (eq symp 'a) - ;; We change the score file back to the previous one. - (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-score-load-file current-score-file))))) - -(defun gnus-score-insert-help (string alist idx) - (setq gnus-score-help-winconf (current-window-configuration)) - (save-excursion - (set-buffer (gnus-get-buffer-create "*Score Help*")) - (buffer-disable-undo) - (delete-windows-on (current-buffer)) - (erase-buffer) - (insert string ":\n\n") - (let ((max -1) - (list alist) - (i 0) - n width pad format) - ;; find the longest string to display - (while list - (setq n (length (nth idx (car list)))) - (unless (> max n) - (setq max n)) - (setq list (cdr list))) - (setq max (+ max 4)) ; %c, `:', SPACE, a SPACE at end - (setq n (/ (1- (window-width)) max)) ; items per line - (setq width (/ (1- (window-width)) n)) ; width of each item - ;; insert `n' items, each in a field of width `width' - (while alist - (if (< i n) - () - (setq i 0) - (delete-char -1) ; the `\n' takes a char - (insert "\n")) - (setq pad (- width 3)) - (setq format (concat "%c: %-" (int-to-string pad) "s")) - (insert (format format (caar alist) (nth idx (car alist)))) - (setq alist (cdr alist)) - (setq i (1+ i)))) - (goto-char (point-min)) - ;; display ourselves in a small window at the bottom - (gnus-appt-select-lowest-window) - (if (< (/ (window-height) 2) window-min-height) - (switch-to-buffer "*Score Help*") - (split-window) - (pop-to-buffer "*Score Help*")) - (let ((window-min-height 1)) - (shrink-window-if-larger-than-buffer)) - (select-window (gnus-get-buffer-window gnus-summary-buffer t)))) - -(defun gnus-summary-header (header &optional no-err extra) - ;; Return HEADER for current articles, or error. - (let ((article (gnus-summary-article-number)) - headers) - (if article - (if (and (setq headers (gnus-summary-article-header article)) - (vectorp headers)) - (if extra ; `header' must be "extra" - (or (cdr (assq extra (mail-header-extra headers))) "") - (aref headers (nth 1 (assoc header gnus-header-index)))) - (if no-err - nil - (error "Pseudo-articles can't be scored"))) - (if no-err - (error "No article on current line") - nil)))) - -(defun gnus-newsgroup-score-alist () - (or - (let ((param-file (gnus-group-find-parameter - gnus-newsgroup-name 'score-file))) - (when param-file - (gnus-score-load param-file))) - (gnus-score-load - (gnus-score-file-name gnus-newsgroup-name))) - gnus-score-alist) - -(defsubst gnus-score-get (symbol &optional alist) - ;; Get SYMBOL's definition in ALIST. - (cdr (assoc symbol - (or alist - gnus-score-alist - (gnus-newsgroup-score-alist))))) - -(defun gnus-summary-score-entry (header match type score date - &optional prompt silent extra) - "Enter score file entry. -HEADER is the header being scored. -MATCH is the string we are looking for. -TYPE is the match type: substring, regexp, exact, fuzzy. -SCORE is the score to add. -DATE is the expire date, or nil for no expire, or 'now for immediate expire. -If optional argument `PROMPT' is non-nil, allow user to edit match. -If optional argument `SILENT' is nil, show effect of score entry. -If optional argument `EXTRA' is non-nil, it's a non-standard overview header." - ;; Regexp is the default type. - (when (eq type t) - (setq type 'r)) - ;; Simplify matches... - (cond ((or (eq type 'r) (eq type 's) (eq type nil)) - (setq match (if match (gnus-simplify-subject-re match) ""))) - ((eq type 'f) - (setq match (gnus-simplify-subject-fuzzy match)))) - (let ((score (gnus-score-delta-default score)) - (header (downcase header)) - new) - (set-text-properties 0 (length header) nil header) - (when prompt - (setq match (read-string - (format "Match %s on %s, %s: " - (cond ((eq date 'now) - "now") - ((stringp date) - "temp") - (t "permanent")) - header - (if (< score 0) "lower" "raise")) - (if (numberp match) - (int-to-string match) - match)))) - - ;; If this is an integer comparison, we transform from string to int. - (if (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer) - (if (stringp match) - (setq match (string-to-number match))) - (set-text-properties 0 (length match) nil match)) - - (unless (eq date 'now) - ;; Add the score entry to the score file. - (when (= score gnus-score-interactive-default-score) - (setq score nil)) - (let ((old (gnus-score-get header)) - elem) - (setq new - (cond - (extra - (list match score - (and date (if (numberp date) date - (date-to-day date))) - type (symbol-name extra))) - (type - (list match score - (and date (if (numberp date) date - (date-to-day date))) - type)) - (date (list match score (date-to-day date))) - (score (list match score)) - (t (list match)))) - ;; We see whether we can collapse some score entries. - ;; This isn't quite correct, because there may be more elements - ;; later on with the same key that have matching elems... Hm. - (if (and old - (setq elem (assoc match old)) - (eq (nth 3 elem) (nth 3 new)) - (or (and (numberp (nth 2 elem)) (numberp (nth 2 new))) - (and (not (nth 2 elem)) (not (nth 2 new))))) - ;; Yup, we just add this new score to the old elem. - (setcar (cdr elem) (+ (or (nth 1 elem) - gnus-score-interactive-default-score) - (or (nth 1 new) - gnus-score-interactive-default-score))) - ;; Nope, we have to add a new elem. - (gnus-score-set header (if old (cons new old) (list new)) nil t)) - (gnus-score-set 'touched '(t)))) - - ;; Score the current buffer. - (unless silent - (if (and (>= (nth 1 (assoc header gnus-header-index)) 0) - (eq (nth 2 (assoc header gnus-header-index)) - 'gnus-score-string)) - (gnus-summary-score-effect header match type score extra) - (gnus-summary-rescore))) - - ;; Return the new scoring rule. - new)) - -(defun gnus-summary-score-effect (header match type score &optional extra) - "Simulate the effect of a score file entry. -HEADER is the header being scored. -MATCH is the string we are looking for. -TYPE is the score type. -SCORE is the score to add. -EXTRA is the possible non-standard header." - (interactive (list (completing-read "Header: " - gnus-header-index - (lambda (x) (fboundp (nth 2 x))) - t) - (read-string "Match: ") - (if (y-or-n-p "Use regexp match? ") 'r 's) - (string-to-number (read-string "Score: ")))) - (save-excursion - (unless (and (stringp match) (> (length match) 0)) - (error "No match")) - (goto-char (point-min)) - (let ((regexp (cond ((eq type 'f) - (gnus-simplify-subject-fuzzy match)) - ((eq type 'r) - match) - ((eq type 'e) - (concat "\\`" (regexp-quote match) "\\'")) - (t - (regexp-quote match))))) - (while (not (eobp)) - (let ((content (gnus-summary-header header 'noerr extra)) - (case-fold-search t)) - (and content - (when (if (eq type 'f) - (string-equal (gnus-simplify-subject-fuzzy content) - regexp) - (string-match regexp content)) - (gnus-summary-raise-score score)))) - (beginning-of-line 2)))) - (gnus-set-mode-line 'summary)) - -(defun gnus-summary-score-crossposting (score date) - ;; Enter score file entry for current crossposting. - ;; SCORE is the score to add. - ;; DATE is the expire date. - (let ((xref (gnus-summary-header "xref")) - (start 0) - group) - (unless xref - (error "This article is not crossposted")) - (while (string-match " \\([^ \t]+\\):" xref start) - (setq start (match-end 0)) - (when (not (string= - (setq group - (substring xref (match-beginning 1) (match-end 1))) - gnus-newsgroup-name)) - (gnus-summary-score-entry - "xref" (concat " " group ":") nil score date t))))) - - -;;; -;;; Gnus Score Files -;;; - -;; All score code written by Per Abrahamsen . - -(defun gnus-score-set-mark-below (score) - "Automatically mark articles with score below SCORE as read." - (interactive - (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg)) - (string-to-number (read-string "Mark below: "))))) - (setq score (or score gnus-summary-default-score 0)) - (gnus-score-set 'mark (list score)) - (gnus-score-set 'touched '(t)) - (setq gnus-summary-mark-below score) - (gnus-score-update-lines)) - -(defun gnus-score-update-lines () - "Update all lines in the summary buffer." - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (gnus-summary-update-line) - (forward-line 1)))) - -(defun gnus-score-update-all-lines () - "Update all lines in the summary buffer, even the hidden ones." - (save-excursion - (goto-char (point-min)) - (let (hidden) - (while (not (eobp)) - (when (gnus-summary-show-thread) - (push (point) hidden)) - (gnus-summary-update-line) - (forward-line 1)) - ;; Re-hide the hidden threads. - (while hidden - (goto-char (pop hidden)) - (gnus-summary-hide-thread))))) - -(defun gnus-score-set-expunge-below (score) - "Automatically expunge articles with score below SCORE." - (interactive - (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg)) - (string-to-number (read-string "Set expunge below: "))))) - (setq score (or score gnus-summary-default-score 0)) - (gnus-score-set 'expunge (list score)) - (gnus-score-set 'touched '(t))) - -(defun gnus-score-followup-article (&optional score) - "Add SCORE to all followups to the article in the current buffer." - (interactive "P") - (setq score (gnus-score-delta-default score)) - (when (gnus-buffer-live-p gnus-summary-buffer) - (save-excursion - (save-restriction - (message-narrow-to-headers) - (let ((id (mail-fetch-field "message-id"))) - (when id - (set-buffer gnus-summary-buffer) - (gnus-summary-score-entry - "references" (concat id "[ \t]*$") 'r - score (current-time-string) nil t))))))) - -(defun gnus-score-followup-thread (&optional score) - "Add SCORE to all later articles in the thread the current buffer is part of." - (interactive "P") - (setq score (gnus-score-delta-default score)) - (when (gnus-buffer-live-p gnus-summary-buffer) - (save-excursion - (save-restriction - (goto-char (point-min)) - (let ((id (mail-fetch-field "message-id"))) - (when id - (set-buffer gnus-summary-buffer) - (gnus-summary-score-entry - "references" id 's - score (current-time-string)))))))) - -(defun gnus-score-set (symbol value &optional alist warn) - ;; Set SYMBOL to VALUE in ALIST. - (let* ((alist - (or alist - gnus-score-alist - (gnus-newsgroup-score-alist))) - (entry (assoc symbol alist))) - (cond ((gnus-score-get 'read-only alist) - ;; This is a read-only score file, so we do nothing. - (when warn - (gnus-message 4 "Note: read-only score file; entry discarded"))) - (entry - (setcdr entry value)) - ((null alist) - (error "Empty alist")) - (t - (setcdr alist - (cons (cons symbol value) (cdr alist))))))) - -(defun gnus-summary-raise-score (n) - "Raise the score of the current article by N." - (interactive "p") - (gnus-summary-set-score (+ (gnus-summary-article-score) - (or n gnus-score-interactive-default-score )))) - -(defun gnus-summary-set-score (n) - "Set the score of the current article to N." - (interactive "p") - (save-excursion - (gnus-summary-show-thread) - (let ((buffer-read-only nil)) - ;; Set score. - (gnus-summary-update-mark - (if (= n (or gnus-summary-default-score 0)) ? ;Whitespace - (if (< n (or gnus-summary-default-score 0)) - gnus-score-below-mark gnus-score-over-mark)) - 'score)) - (let* ((article (gnus-summary-article-number)) - (score (assq article gnus-newsgroup-scored))) - (if score (setcdr score n) - (push (cons article n) gnus-newsgroup-scored))) - (gnus-summary-update-line))) - -(defun gnus-summary-current-score () - "Return the score of the current article." - (interactive) - (gnus-message 1 "%s" (gnus-summary-article-score))) - -(defun gnus-score-change-score-file (file) - "Change current score alist." - (interactive - (list (read-file-name "Change to score file: " gnus-kill-files-directory))) - (gnus-score-load-file file) - (gnus-set-mode-line 'summary)) - -(defvar gnus-score-edit-exit-function) -(defun gnus-score-edit-current-scores (file) - "Edit the current score alist." - (interactive (list gnus-current-score-file)) - (if (not gnus-current-score-file) - (error "No current score file") - (let ((winconf (current-window-configuration))) - (when (buffer-name gnus-summary-buffer) - (gnus-score-save)) - (gnus-make-directory (file-name-directory file)) - (setq gnus-score-edit-buffer (find-file-noselect file)) - (gnus-configure-windows 'edit-score) - (gnus-score-mode) - (setq gnus-score-edit-exit-function 'gnus-score-edit-done) - (make-local-variable 'gnus-prev-winconf) - (setq gnus-prev-winconf winconf)) - (gnus-message - 4 (substitute-command-keys - "\\\\[gnus-score-edit-exit] to save edits")))) - -(defun gnus-score-edit-file (file) - "Edit a score file." - (interactive - (list (read-file-name "Edit score file: " gnus-kill-files-directory))) - (gnus-make-directory (file-name-directory file)) - (when (buffer-name gnus-summary-buffer) - (gnus-score-save)) - (let ((winconf (current-window-configuration))) - (setq gnus-score-edit-buffer (find-file-noselect file)) - (gnus-configure-windows 'edit-score) - (gnus-score-mode) - (setq gnus-score-edit-exit-function 'gnus-score-edit-done) - (make-local-variable 'gnus-prev-winconf) - (setq gnus-prev-winconf winconf)) - (gnus-message - 4 (substitute-command-keys - "\\\\[gnus-score-edit-exit] to save edits"))) - -(defun gnus-score-edit-file-at-point (&optional format) - "Edit score file at point in Score Trace buffers. -If FORMAT, also format the current score file." - (let* ((rule (save-excursion - (beginning-of-line) - (read (current-buffer)))) - (sep "[ \n\r\t]*") - ;; Must be synced with `gnus-score-find-trace': - (reg " -> +") - (file (save-excursion - (end-of-line) - (if (and (re-search-backward reg (gnus-point-at-bol) t) - (re-search-forward reg (gnus-point-at-eol) t)) - (buffer-substring (point) (gnus-point-at-eol)) - nil)))) - (if (or (not file) - (string-match "\\<\\(non-file rule\\|A file\\)\\>" file) - ;; (see `gnus-score-find-trace' and `gnus-score-advanced') - (string= "" file)) - (gnus-error 3 "Can't find a score file in current line.") - (gnus-score-edit-file file) - (when format - (gnus-score-pretty-print)) - (when (consp rule) ;; the rule exists - (setq rule (mapconcat #'(lambda (obj) - (regexp-quote (format "%S" obj))) - rule - sep)) - (goto-char (point-min)) - (re-search-forward rule nil t) - ;; make it easy to use `kill-sexp': - (goto-char (1- (match-beginning 0))))))) - -(defun gnus-score-load-file (file) - ;; Load score file FILE. Returns a list a retrieved score-alists. - (let* ((file (expand-file-name - (or (and (string-match - (concat "^" (regexp-quote - (expand-file-name - gnus-kill-files-directory))) - (expand-file-name file)) - file) - (expand-file-name file gnus-kill-files-directory)))) - (cached (assoc file gnus-score-cache)) - (global (member file gnus-internal-global-score-files)) - lists alist) - (if cached - ;; The score file was already loaded. - (setq alist (cdr cached)) - ;; We load the score file. - (setq gnus-score-alist nil) - (setq alist (gnus-score-load-score-alist file)) - ;; We add '(touched) to the alist to signify that it hasn't been - ;; touched (yet). - (unless (assq 'touched alist) - (push (list 'touched nil) alist)) - ;; If it is a global score file, we make it read-only. - (and global - (not (assq 'read-only alist)) - (push (list 'read-only t) alist)) - (push (cons file alist) gnus-score-cache)) - (let ((a alist) - found) - (while a - ;; Downcase all header names. - (cond - ((stringp (caar a)) - (setcar (car a) (downcase (caar a))) - (setq found t)) - ;; Advanced scoring. - ((consp (caar a)) - (setq found t))) - (pop a)) - ;; If there are actual scores in the alist, we add it to the - ;; return value of this function. - (when found - (setq lists (list alist)))) - ;; Treat the other possible atoms in the score alist. - (let ((mark (car (gnus-score-get 'mark alist))) - (expunge (car (gnus-score-get 'expunge alist))) - (mark-and-expunge (car (gnus-score-get 'mark-and-expunge alist))) - (files (gnus-score-get 'files alist)) - (exclude-files (gnus-score-get 'exclude-files alist)) - (orphan (car (gnus-score-get 'orphan alist))) - (adapt (gnus-score-get 'adapt alist)) - (thread-mark-and-expunge - (car (gnus-score-get 'thread-mark-and-expunge alist))) - (adapt-file (car (gnus-score-get 'adapt-file alist))) - (local (gnus-score-get 'local alist)) - (decay (car (gnus-score-get 'decay alist))) - (eval (car (gnus-score-get 'eval alist)))) - ;; Perform possible decays. - (when (and gnus-decay-scores - (or cached (file-exists-p file)) - (or (not decay) - (gnus-decay-scores alist decay))) - (gnus-score-set 'touched '(t) alist) - (gnus-score-set 'decay (list (time-to-days (current-time))) alist)) - ;; We do not respect eval and files atoms from global score - ;; files. - (when (and files (not global)) - (setq lists (apply 'append lists - (mapcar (lambda (file) - (gnus-score-load-file file)) - (if adapt-file (cons adapt-file files) - files))))) - (when (and eval (not global)) - (eval eval)) - ;; We then expand any exclude-file directives. - (setq gnus-scores-exclude-files - (nconc - (apply - 'nconc - (mapcar - (lambda (sfile) - (list - (expand-file-name sfile (file-name-directory file)) - (expand-file-name sfile gnus-kill-files-directory))) - exclude-files)) - gnus-scores-exclude-files)) - (when local - (save-excursion - (set-buffer gnus-summary-buffer) - (while local - (and (consp (car local)) - (symbolp (caar local)) - (progn - (make-local-variable (caar local)) - (set (caar local) (nth 1 (car local))))) - (setq local (cdr local))))) - (when orphan - (setq gnus-orphan-score orphan)) - (setq gnus-adaptive-score-alist - (cond ((equal adapt '(t)) - (setq gnus-newsgroup-adaptive t) - gnus-default-adaptive-score-alist) - ((equal adapt '(ignore)) - (setq gnus-newsgroup-adaptive nil)) - ((consp adapt) - (setq gnus-newsgroup-adaptive t) - adapt) - (t - gnus-default-adaptive-score-alist))) - (setq gnus-thread-expunge-below - (or thread-mark-and-expunge gnus-thread-expunge-below)) - (setq gnus-summary-mark-below - (or mark mark-and-expunge gnus-summary-mark-below)) - (setq gnus-summary-expunge-below - (or expunge mark-and-expunge gnus-summary-expunge-below)) - (setq gnus-newsgroup-adaptive-score-file - (or adapt-file gnus-newsgroup-adaptive-score-file))) - (setq gnus-current-score-file file) - (setq gnus-score-alist alist) - lists)) - -(defun gnus-score-load (file) - ;; Load score FILE. - (let ((cache (assoc file gnus-score-cache))) - (if cache - (setq gnus-score-alist (cdr cache)) - (setq gnus-score-alist nil) - (gnus-score-load-score-alist file) - (unless gnus-score-alist - (setq gnus-score-alist (copy-alist '((touched nil))))) - (push (cons file gnus-score-alist) gnus-score-cache)))) - -(defun gnus-score-remove-from-cache (file) - (setq gnus-score-cache - (delq (assoc file gnus-score-cache) gnus-score-cache))) - -(defun gnus-score-load-score-alist (file) - "Read score FILE." - (let (alist) - (if (not (file-readable-p file)) - ;; Couldn't read file. - (setq gnus-score-alist nil) - ;; Read file. - (with-temp-buffer - (let ((coding-system-for-read score-mode-coding-system)) - (insert-file-contents file)) - (goto-char (point-min)) - ;; Only do the loading if the score file isn't empty. - (when (save-excursion (re-search-forward "[()0-9a-zA-Z]" nil t)) - (setq alist - (condition-case () - (read (current-buffer)) - (error - (gnus-error 3.2 "Problem with score file %s" file)))))) - (cond - ((and alist - (atom alist)) - ;; Bogus score file. - (error "Invalid syntax with score file %s" file)) - ((eq (car alist) 'setq) - ;; This is an old-style score file. - (setq gnus-score-alist (gnus-score-transform-old-to-new alist))) - (t - (setq gnus-score-alist alist))) - ;; Check the syntax of the score file. - (setq gnus-score-alist - (gnus-score-check-syntax gnus-score-alist file))))) - -(defun gnus-score-check-syntax (alist file) - "Check the syntax of the score ALIST." - (cond - ((null alist) - nil) - ((not (consp alist)) - (gnus-message 1 "Score file is not a list: %s" file) - (ding) - nil) - (t - (let ((a alist) - sr err s type) - (while (and a (not err)) - (setq - err - (cond - ((not (listp (car a))) - (format "Invalid score element %s in %s" (car a) file)) - ((stringp (caar a)) - (cond - ((not (listp (setq sr (cdar a)))) - (format "Invalid header match %s in %s" (nth 1 (car a)) file)) - (t - (setq type (caar a)) - (while (and sr (not err)) - (setq s (pop sr)) - (setq - err - (cond - ((if (member (downcase type) '("lines" "chars")) - (not (numberp (car s))) - (not (stringp (car s)))) - (format "Invalid match %s in %s" (car s) file)) - ((and (cadr s) (not (integerp (cadr s)))) - (format "Non-integer score %s in %s" (cadr s) file)) - ((and (caddr s) (not (integerp (caddr s)))) - (format "Non-integer date %s in %s" (caddr s) file)) - ((and (cadddr s) (not (symbolp (cadddr s)))) - (format "Non-symbol match type %s in %s" (cadddr s) file))))) - err))))) - (setq a (cdr a))) - (if err - (progn - (ding) - (gnus-message 3 err) - (sit-for 2) - nil) - alist))))) - -(defun gnus-score-transform-old-to-new (alist) - (let* ((alist (nth 2 alist)) - out entry) - (when (eq (car alist) 'quote) - (setq alist (nth 1 alist))) - (while alist - (setq entry (car alist)) - (if (stringp (car entry)) - (let ((scor (cdr entry))) - (push entry out) - (while scor - (setcar scor - (list (caar scor) (nth 2 (car scor)) - (and (nth 3 (car scor)) - (date-to-day (nth 3 (car scor)))) - (if (nth 1 (car scor)) 'r 's))) - (setq scor (cdr scor)))) - (push (if (not (listp (cdr entry))) - (list (car entry) (cdr entry)) - entry) - out)) - (setq alist (cdr alist))) - (cons (list 'touched t) (nreverse out)))) - -(defun gnus-score-save () - ;; Save all score information. - (let ((cache gnus-score-cache) - entry score file) - (save-excursion - (setq gnus-score-alist nil) - (nnheader-set-temp-buffer " *Gnus Scores*") - (while cache - (current-buffer) - (setq entry (pop cache) - file (nnheader-translate-file-chars (car entry) t) - score (cdr entry)) - (if (or (not (equal (gnus-score-get 'touched score) '(t))) - (gnus-score-get 'read-only score) - (and (file-exists-p file) - (not (file-writable-p file)))) - () - (setq score (setcdr entry (gnus-delete-alist 'touched score))) - (erase-buffer) - (let (emacs-lisp-mode-hook) - (if (string-match - (concat (regexp-quote gnus-adaptive-file-suffix) "$") - file) - ;; This is an adaptive score file, so we do not run - ;; it through `pp'. These files can get huge, and - ;; are not meant to be edited by human hands. - (gnus-prin1 score) - ;; This is a normal score file, so we print it very - ;; prettily. - (let ((lisp-mode-syntax-table score-mode-syntax-table)) - (gnus-pp score)))) - (gnus-make-directory (file-name-directory file)) - ;; If the score file is empty, we delete it. - (if (zerop (buffer-size)) - (delete-file file) - ;; There are scores, so we write the file. - (when (file-writable-p file) - (let ((coding-system-for-write score-mode-coding-system)) - (gnus-write-buffer file)) - (when gnus-score-after-write-file-function - (funcall gnus-score-after-write-file-function file))))) - (and gnus-score-uncacheable-files - (string-match gnus-score-uncacheable-files file) - (gnus-score-remove-from-cache file))) - (kill-buffer (current-buffer))))) - -(defun gnus-score-load-files (score-files) - "Load all score files in SCORE-FILES." - ;; Load the score files. - (let (scores) - (while score-files - (if (stringp (car score-files)) - ;; It is a string, which means that it's a score file name, - ;; so we load the score file and add the score alist to - ;; the list of alists. - (setq scores (nconc (gnus-score-load-file (car score-files)) scores)) - ;; It is an alist, so we just add it to the list directly. - (setq scores (nconc (car score-files) scores))) - (setq score-files (cdr score-files))) - ;; Prune the score files that are to be excluded, if any. - (when gnus-scores-exclude-files - (let ((s scores) - c) - (while s - (and (setq c (rassq (car s) gnus-score-cache)) - (member (car c) gnus-scores-exclude-files) - (setq scores (delq (car s) scores))) - (setq s (cdr s))))) - scores)) - -(defun gnus-score-headers (score-files &optional trace) - ;; Score `gnus-newsgroup-headers'. - (let (scores news) - ;; PLM: probably this is not the best place to clear orphan-score - (setq gnus-orphan-score nil - gnus-scores-articles nil - gnus-scores-exclude-files nil - scores (gnus-score-load-files score-files)) - (setq news scores) - ;; Do the scoring. - (while news - (setq scores news - news nil) - (when (and gnus-summary-default-score - scores) - (let* ((entries gnus-header-index) - (now (date-to-day (current-time-string))) - (expire (and gnus-score-expiry-days - (- now gnus-score-expiry-days))) - (headers gnus-newsgroup-headers) - (current-score-file gnus-current-score-file) - entry header new) - (gnus-message 7 "Scoring...") - ;; Create articles, an alist of the form `(HEADER . SCORE)'. - (while (setq header (pop headers)) - ;; WARNING: The assq makes the function O(N*S) while it could - ;; be written as O(N+S), where N is (length gnus-newsgroup-headers) - ;; and S is (length gnus-newsgroup-scored). - (unless (assq (mail-header-number header) gnus-newsgroup-scored) - (setq gnus-scores-articles ;Total of 2 * N cons-cells used. - (cons (cons header (or gnus-summary-default-score 0)) - gnus-scores-articles)))) - - (save-excursion - (set-buffer (gnus-get-buffer-create "*Headers*")) - (buffer-disable-undo) - (when (gnus-buffer-live-p gnus-summary-buffer) - (message-clone-locals gnus-summary-buffer)) - - ;; Set the global variant of this variable. - (setq gnus-current-score-file current-score-file) - ;; score orphans - (when gnus-orphan-score - (setq gnus-score-index - (nth 1 (assoc "references" gnus-header-index))) - (gnus-score-orphans gnus-orphan-score)) - ;; Run each header through the score process. - (while entries - (setq entry (pop entries) - header (nth 0 entry) - gnus-score-index (nth 1 (assoc header gnus-header-index))) - (when (< 0 (apply 'max (mapcar - (lambda (score) - (length (gnus-score-get header score))) - scores))) - ;; Call the scoring function for this type of "header". - (when (setq new (funcall (nth 2 entry) scores header - now expire trace)) - (push new news)))) - (when (gnus-buffer-live-p gnus-summary-buffer) - (let ((scored gnus-newsgroup-scored)) - (with-current-buffer gnus-summary-buffer - (setq gnus-newsgroup-scored scored)))) - ;; Remove the buffer. - (gnus-kill-buffer (current-buffer))) - - ;; Add articles to `gnus-newsgroup-scored'. - (while gnus-scores-articles - (when (or (/= gnus-summary-default-score - (cdar gnus-scores-articles)) - gnus-save-score) - (push (cons (mail-header-number (caar gnus-scores-articles)) - (cdar gnus-scores-articles)) - gnus-newsgroup-scored)) - (setq gnus-scores-articles (cdr gnus-scores-articles))) - - (let (score) - (while (setq score (pop scores)) - (while score - (when (consp (caar score)) - (gnus-score-advanced (car score) trace)) - (pop score)))) - - (gnus-message 7 "Scoring...done")))))) - -(defun gnus-score-lower-thread (thread score-adjust) - "Lower the score on THREAD with SCORE-ADJUST. -THREAD is expected to contain a list of the form `(PARENT [CHILD1 -CHILD2 ...])' where PARENT is a header array and each CHILD is a list -of the same form as THREAD. The empty list nil is valid. For each -article in the tree, the score of the corresponding entry in -`gnus-newsgroup-scored' is adjusted by SCORE-ADJUST." - (while thread - (let ((head (car thread))) - (if (listp head) - ;; handle a child and its descendants - (gnus-score-lower-thread head score-adjust) - ;; handle the parent - (let* ((article (mail-header-number head)) - (score (assq article gnus-newsgroup-scored))) - (if score (setcdr score (+ (cdr score) score-adjust)) - (push (cons article score-adjust) gnus-newsgroup-scored))))) - (setq thread (cdr thread)))) - -(defun gnus-score-orphans (score) - "Score orphans. -A root is an article with no references. An orphan is an article -which has references, but is not connected via its references to a -root article. This function finds all the orphans, and adjusts their -score in `gnus-newsgroup-scored' by SCORE." - ;; gnus-make-threads produces a list, where each entry is a "thread" - ;; as described in the gnus-score-lower-thread docs. This function - ;; will be called again (after limiting has been done) if the display - ;; is threaded. It would be nice to somehow save this info and use - ;; it later. - (dolist (thread (gnus-make-threads)) - (let ((id (aref (car thread) gnus-score-index))) - ;; If the parent of the thread is not a root, lower the score of - ;; it and its descendants. Note that some roots seem to satisfy - ;; (eq id nil) and some (eq id ""); not sure why. - (when (and id - (not (string= id ""))) - (gnus-score-lower-thread thread score))))) - -(defun gnus-score-integer (scores header now expire &optional trace) - (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) - entries alist) - ;; Find matches. - (while scores - (setq alist (car scores) - scores (cdr scores) - entries (assoc header alist)) - (while (cdr entries) ;First entry is the header index. - (let* ((rest (cdr entries)) - (kill (car rest)) - (match (nth 0 kill)) - (type (or (nth 3 kill) '>)) - (score (or (nth 1 kill) gnus-score-interactive-default-score)) - (date (nth 2 kill)) - (found nil) - (match-func (if (or (eq type '>) (eq type '<) (eq type '<=) - (eq type '>=) (eq type '=)) - type - (error "Invalid match type: %s" type))) - (articles gnus-scores-articles)) - ;; Instead of doing all the clever stuff that - ;; `gnus-score-string' does to minimize searches and stuff, - ;; I will assume that people generally will put so few - ;; matches on numbers that any cleverness will take more - ;; time than one would gain. - (while articles - (when (funcall match-func - (or (aref (caar articles) gnus-score-index) 0) - match) - (when trace - (push (cons (car-safe (rassq alist gnus-score-cache)) kill) - gnus-score-trace)) - (setq found t) - (setcdr (car articles) (+ score (cdar articles)))) - (setq articles (cdr articles))) - ;; Update expire date - (cond ((null date)) ;Permanent entry. - ((and found gnus-update-score-entry-dates) ;Match, update date. - (gnus-score-set 'touched '(t) alist) - (setcar (nthcdr 2 kill) now)) - ((and expire (< date expire)) ;Old entry, remove. - (gnus-score-set 'touched '(t) alist) - (setcdr entries (cdr rest)) - (setq rest entries))) - (setq entries rest))))) - nil) - -(defun gnus-score-date (scores header now expire &optional trace) - (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) - entries alist match match-func article) - ;; Find matches. - (while scores - (setq alist (car scores) - scores (cdr scores) - entries (assoc header alist)) - (while (cdr entries) ;First entry is the header index. - (let* ((rest (cdr entries)) - (kill (car rest)) - (type (or (nth 3 kill) 'before)) - (score (or (nth 1 kill) gnus-score-interactive-default-score)) - (date (nth 2 kill)) - (found nil) - (articles gnus-scores-articles) - l) - (cond - ((eq type 'after) - (setq match-func 'string< - match (gnus-date-iso8601 (nth 0 kill)))) - ((eq type 'before) - (setq match-func 'gnus-string> - match (gnus-date-iso8601 (nth 0 kill)))) - ((eq type 'at) - (setq match-func 'string= - match (gnus-date-iso8601 (nth 0 kill)))) - ((eq type 'regexp) - (setq match-func 'string-match - match (nth 0 kill))) - (t (error "Invalid match type: %s" type))) - ;; Instead of doing all the clever stuff that - ;; `gnus-score-string' does to minimize searches and stuff, - ;; I will assume that people generally will put so few - ;; matches on numbers that any cleverness will take more - ;; time than one would gain. - (while (setq article (pop articles)) - (when (and - (setq l (aref (car article) gnus-score-index)) - (funcall match-func match (gnus-date-iso8601 l))) - (when trace - (push (cons (car-safe (rassq alist gnus-score-cache)) kill) - gnus-score-trace)) - (setq found t) - (setcdr article (+ score (cdr article))))) - ;; Update expire date - (cond ((null date)) ;Permanent entry. - ((and found gnus-update-score-entry-dates) ;Match, update date. - (gnus-score-set 'touched '(t) alist) - (setcar (nthcdr 2 kill) now)) - ((and expire (< date expire)) ;Old entry, remove. - (gnus-score-set 'touched '(t) alist) - (setcdr entries (cdr rest)) - (setq rest entries))) - (setq entries rest))))) - nil) - -(defun gnus-score-body (scores header now expire &optional trace) - (if gnus-agent-fetching - nil - (save-excursion - (setq gnus-scores-articles - (sort gnus-scores-articles - (lambda (a1 a2) - (< (mail-header-number (car a1)) - (mail-header-number (car a2)))))) - (set-buffer nntp-server-buffer) - (save-restriction - (let* ((buffer-read-only nil) - (articles gnus-scores-articles) - (all-scores scores) - (request-func (cond ((string= "head" header) - 'gnus-request-head) - ((string= "body" header) - 'gnus-request-body) - (t 'gnus-request-article))) - entries alist ofunc article last) - (when articles - (setq last (mail-header-number (caar (last articles)))) - ;; Not all backends support partial fetching. In that case, - ;; we just fetch the entire article. - (unless (gnus-check-backend-function - (and (string-match "^gnus-" (symbol-name request-func)) - (intern (substring (symbol-name request-func) - (match-end 0)))) - gnus-newsgroup-name) - (setq ofunc request-func) - (setq request-func 'gnus-request-article)) - (while articles - (setq article (mail-header-number (caar articles))) - (gnus-message 7 "Scoring article %s of %s..." article last) - (widen) - (when (funcall request-func article gnus-newsgroup-name) - (goto-char (point-min)) - ;; If just parts of the article is to be searched, but the - ;; backend didn't support partial fetching, we just narrow - ;; to the relevant parts. - (when ofunc - (if (eq ofunc 'gnus-request-head) - (narrow-to-region - (point) - (or (search-forward "\n\n" nil t) (point-max))) - (narrow-to-region - (or (search-forward "\n\n" nil t) (point)) - (point-max)))) - (setq scores all-scores) - ;; Find matches. - (while scores - (setq alist (pop scores) - entries (assoc header alist)) - (while (cdr entries) ;First entry is the header index. - (let* ((rest (cdr entries)) - (kill (car rest)) - (match (nth 0 kill)) - (type (or (nth 3 kill) 's)) - (score (or (nth 1 kill) - gnus-score-interactive-default-score)) - (date (nth 2 kill)) - (found nil) - (case-fold-search - (not (or (eq type 'R) (eq type 'S) - (eq type 'Regexp) (eq type 'String)))) - (search-func - (cond ((or (eq type 'r) (eq type 'R) - (eq type 'regexp) (eq type 'Regexp)) - 're-search-forward) - ((or (eq type 's) (eq type 'S) - (eq type 'string) (eq type 'String)) - 'search-forward) - (t - (error "Invalid match type: %s" type))))) - (goto-char (point-min)) - (when (funcall search-func match nil t) - ;; Found a match, update scores. - (setcdr (car articles) (+ score (cdar articles))) - (setq found t) - (when trace - (push - (cons (car-safe (rassq alist gnus-score-cache)) - kill) - gnus-score-trace))) - ;; Update expire date - (unless trace - (cond - ((null date)) ;Permanent entry. - ((and found gnus-update-score-entry-dates) - ;; Match, update date. - (gnus-score-set 'touched '(t) alist) - (setcar (nthcdr 2 kill) now)) - ((and expire (< date expire)) ;Old entry, remove. - (gnus-score-set 'touched '(t) alist) - (setcdr entries (cdr rest)) - (setq rest entries)))) - (setq entries rest))))) - (setq articles (cdr articles))))))) - nil)) - -(defun gnus-score-thread (scores header now expire &optional trace) - (gnus-score-followup scores header now expire trace t)) - -(defun gnus-score-followup (scores header now expire &optional trace thread) - (if gnus-agent-fetching - ;; FIXME: It seems doable in fetching mode. - nil - ;; Insert the unique article headers in the buffer. - (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) - (current-score-file gnus-current-score-file) - (all-scores scores) - ;; gnus-score-index is used as a free variable. - alike last this art entries alist articles - new news) - - ;; Change score file to the adaptive score file. All entries that - ;; this function makes will be put into this file. - (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-score-load-file - (or gnus-newsgroup-adaptive-score-file - (gnus-score-file-name - gnus-newsgroup-name gnus-adaptive-file-suffix)))) - - (setq gnus-scores-articles (sort gnus-scores-articles - 'gnus-score-string<) - articles gnus-scores-articles) - - (erase-buffer) - (while articles - (setq art (car articles) - this (aref (car art) gnus-score-index) - articles (cdr articles)) - (if (equal last this) - (push art alike) - (when last - (insert last ?\n) - (put-text-property (1- (point)) (point) 'articles alike)) - (setq alike (list art) - last this))) - (when last ; Bwadr, duplicate code. - (insert last ?\n) - (put-text-property (1- (point)) (point) 'articles alike)) - - ;; Find matches. - (while scores - (setq alist (car scores) - scores (cdr scores) - entries (assoc header alist)) - (while (cdr entries) ;First entry is the header index. - (let* ((rest (cdr entries)) - (kill (car rest)) - (match (nth 0 kill)) - (type (or (nth 3 kill) 's)) - (score (or (nth 1 kill) gnus-score-interactive-default-score)) - (date (nth 2 kill)) - (found nil) - (mt (aref (symbol-name type) 0)) - (case-fold-search - (not (or (= mt ?R) (= mt ?S) (= mt ?E) (= mt ?F)))) - (dmt (downcase mt)) - (search-func - (cond ((= dmt ?r) 're-search-forward) - ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward) - (t (error "Invalid match type: %s" type)))) - arts art) - (goto-char (point-min)) - (if (= dmt ?e) - (while (funcall search-func match nil t) - (and (= (gnus-point-at-bol) - (match-beginning 0)) - (= (progn (end-of-line) (point)) - (match-end 0)) - (progn - (setq found (setq arts (get-text-property - (point) 'articles))) - ;; Found a match, update scores. - (while arts - (setq art (car arts) - arts (cdr arts)) - (gnus-score-add-followups - (car art) score all-scores thread)))) - (end-of-line)) - (while (funcall search-func match nil t) - (end-of-line) - (setq found (setq arts (get-text-property (point) 'articles))) - ;; Found a match, update scores. - (while (setq art (pop arts)) - (setcdr art (+ score (cdr art))) - (when trace - (push (cons - (car-safe (rassq alist gnus-score-cache)) - kill) - gnus-score-trace)) - (when (setq new (gnus-score-add-followups - (car art) score all-scores thread)) - (push new news))))) - ;; Update expire date - (cond ((null date)) ;Permanent entry. - ((and found gnus-update-score-entry-dates) - ;Match, update date. - (gnus-score-set 'touched '(t) alist) - (setcar (nthcdr 2 kill) now)) - ((and expire (< date expire)) ;Old entry, remove. - (gnus-score-set 'touched '(t) alist) - (setcdr entries (cdr rest)) - (setq rest entries))) - (setq entries rest)))) - ;; We change the score file back to the previous one. - (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-score-load-file current-score-file)) - (list (cons "references" news))))) - -(defun gnus-score-add-followups (header score scores &optional thread) - "Add a score entry to the adapt file." - (save-excursion - (set-buffer gnus-summary-buffer) - (let* ((id (mail-header-id header)) - (scores (car scores)) - entry dont) - ;; Don't enter a score if there already is one. - (while (setq entry (pop scores)) - (and (equal "references" (car entry)) - (or (null (nth 3 (cadr entry))) - (eq 's (nth 3 (cadr entry)))) - (assoc id entry) - (setq dont t))) - (unless dont - (gnus-summary-score-entry - (if thread "thread" "references") - id 's score (current-time-string) nil t))))) - -(defun gnus-score-string (score-list header now expire &optional trace) - ;; Score ARTICLES according to HEADER in SCORE-LIST. - ;; Update matching entries to NOW and remove unmatched entries older - ;; than EXPIRE. - - ;; Insert the unique article headers in the buffer. - (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) - ;; gnus-score-index is used as a free variable. - (simplify (and gnus-score-thread-simplify - (string= "subject" header))) - alike last this art entries alist articles - fuzzies arts words kill) - - ;; Sorting the articles costs os O(N*log N) but will allow us to - ;; only match with each unique header. Thus the actual matching - ;; will be O(M*U) where M is the number of strings to match with, - ;; and U is the number of unique headers. It is assumed (but - ;; untested) this will be a net win because of the large constant - ;; factor involved with string matching. - (setq gnus-scores-articles - ;; We cannot string-sort the extra headers list. *sigh* - (if (= gnus-score-index 9) - gnus-scores-articles - (sort gnus-scores-articles 'gnus-score-string<)) - articles gnus-scores-articles) - - (erase-buffer) - (while (setq art (pop articles)) - (setq this (aref (car art) gnus-score-index)) - - ;; If we're working with non-standard headers, we are stuck - ;; with working on them as a group. What a hassle. - ;; Just wait 'til you see what horrors we commit against `match'... - (if (= gnus-score-index 9) - (setq this (gnus-prin1-to-string this))) ; ick. - - (if simplify - (setq this (gnus-map-function gnus-simplify-subject-functions this))) - (if (equal last this) - ;; O(N*H) cons-cells used here, where H is the number of - ;; headers. - (push art alike) - (when last - ;; Insert the line, with a text property on the - ;; terminating newline referring to the articles with - ;; this line. - (insert last ?\n) - (put-text-property (1- (point)) (point) 'articles alike)) - (setq alike (list art) - last this))) - (when last ; Bwadr, duplicate code. - (insert last ?\n) - (put-text-property (1- (point)) (point) 'articles alike)) - - ;; Go through all the score alists and pick out the entries - ;; for this header. - (while score-list - (setq alist (pop score-list) - ;; There's only one instance of this header for - ;; each score alist. - entries (assoc header alist)) - (while (cdr entries) ;First entry is the header index. - (let* ((kill (cadr entries)) - (type (or (nth 3 kill) 's)) - (score (or (nth 1 kill) gnus-score-interactive-default-score)) - (date (nth 2 kill)) - (extra (nth 4 kill)) ; non-standard header; string. - (found nil) - (mt (aref (symbol-name type) 0)) - (case-fold-search (not (memq mt '(?R ?S ?E ?F)))) - (dmt (downcase mt)) - ;; Assume user already simplified regexp and fuzzies - (match (if (and simplify (not (memq dmt '(?f ?r)))) - (gnus-map-function - gnus-simplify-subject-functions - (nth 0 kill)) - (nth 0 kill))) - (search-func - (cond ((= dmt ?r) 're-search-forward) - ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward) - ((= dmt ?w) nil) - (t (error "Invalid match type: %s" type))))) - - ;; Evil hackery to make match usable in non-standard headers. - (when extra - (setq match (concat "[ (](" extra " \\. \"[^)]*" - match "[^\"]*\")[ )]") - search-func 're-search-forward)) ; XXX danger?!? - - (cond - ;; Fuzzy matches. We save these for later. - ((= dmt ?f) - (push (cons entries alist) fuzzies) - (setq entries (cdr entries))) - ;; Word matches. Save these for even later. - ((= dmt ?w) - (push (cons entries alist) words) - (setq entries (cdr entries))) - ;; Exact matches. - ((= dmt ?e) - ;; Do exact matching. - (goto-char (point-min)) - (while (and (not (eobp)) - (funcall search-func match nil t)) - ;; Is it really exact? - (and (eolp) - (= (gnus-point-at-bol) (match-beginning 0)) - ;; Yup. - (progn - (setq found (setq arts (get-text-property - (point) 'articles))) - ;; Found a match, update scores. - (if trace - (while (setq art (pop arts)) - (setcdr art (+ score (cdr art))) - (push - (cons - (car-safe (rassq alist gnus-score-cache)) - kill) - gnus-score-trace)) - (while (setq art (pop arts)) - (setcdr art (+ score (cdr art))))))) - (forward-line 1)) - ;; Update expiry date - (if trace - (setq entries (cdr entries)) - (cond - ;; Permanent entry. - ((null date) - (setq entries (cdr entries))) - ;; We have a match, so we update the date. - ((and found gnus-update-score-entry-dates) - (gnus-score-set 'touched '(t) alist) - (setcar (nthcdr 2 kill) now) - (setq entries (cdr entries))) - ;; This entry has expired, so we remove it. - ((and expire (< date expire)) - (gnus-score-set 'touched '(t) alist) - (setcdr entries (cddr entries))) - ;; No match; go to next entry. - (t - (setq entries (cdr entries)))))) - ;; Regexp and substring matching. - (t - (goto-char (point-min)) - (when (string= match "") - (setq match "\n")) - (while (and (not (eobp)) - (funcall search-func match nil t)) - (goto-char (match-beginning 0)) - (end-of-line) - (setq found (setq arts (get-text-property (point) 'articles))) - ;; Found a match, update scores. - (if trace - (while (setq art (pop arts)) - (setcdr art (+ score (cdr art))) - (push (cons (car-safe (rassq alist gnus-score-cache)) kill) - gnus-score-trace)) - (while (setq art (pop arts)) - (setcdr art (+ score (cdr art))))) - (forward-line 1)) - ;; Update expiry date - (if trace - (setq entries (cdr entries)) - (cond - ;; Permanent entry. - ((null date) - (setq entries (cdr entries))) - ;; We have a match, so we update the date. - ((and found gnus-update-score-entry-dates) - (gnus-score-set 'touched '(t) alist) - (setcar (nthcdr 2 kill) now) - (setq entries (cdr entries))) - ;; This entry has expired, so we remove it. - ((and expire (< date expire)) - (gnus-score-set 'touched '(t) alist) - (setcdr entries (cddr entries))) - ;; No match; go to next entry. - (t - (setq entries (cdr entries)))))))))) - - ;; Find fuzzy matches. - (when fuzzies - ;; Simplify the entire buffer for easy matching. - (gnus-simplify-buffer-fuzzy) - (while (setq kill (cadaar fuzzies)) - (let* ((match (nth 0 kill)) - (type (nth 3 kill)) - (score (or (nth 1 kill) gnus-score-interactive-default-score)) - (date (nth 2 kill)) - (mt (aref (symbol-name type) 0)) - (case-fold-search (not (= mt ?F))) - found) - (goto-char (point-min)) - (while (and (not (eobp)) - (search-forward match nil t)) - (when (and (= (gnus-point-at-bol) (match-beginning 0)) - (eolp)) - (setq found (setq arts (get-text-property (point) 'articles))) - (if trace - (while (setq art (pop arts)) - (setcdr art (+ score (cdr art))) - (push (cons - (car-safe (rassq (cdar fuzzies) gnus-score-cache)) - kill) - gnus-score-trace)) - ;; Found a match, update scores. - (while (setq art (pop arts)) - (setcdr art (+ score (cdr art)))))) - (forward-line 1)) - ;; Update expiry date - (if (not trace) - (cond - ;; Permanent. - ((null date) - ;; Do nothing. - ) - ;; Match, update date. - ((and found gnus-update-score-entry-dates) - (gnus-score-set 'touched '(t) (cdar fuzzies)) - (setcar (nthcdr 2 kill) now)) - ;; Old entry, remove. - ((and expire (< date expire)) - (gnus-score-set 'touched '(t) (cdar fuzzies)) - (setcdr (caar fuzzies) (cddaar fuzzies))))) - (setq fuzzies (cdr fuzzies))))) - - (when words - ;; Enter all words into the hashtb. - (let ((hashtb (gnus-make-hashtable - (* 10 (count-lines (point-min) (point-max)))))) - (gnus-enter-score-words-into-hashtb hashtb) - (while (setq kill (cadaar words)) - (let* ((score (or (nth 1 kill) gnus-score-interactive-default-score)) - (date (nth 2 kill)) - found) - (when (setq arts (intern-soft (nth 0 kill) hashtb)) - (setq arts (symbol-value arts)) - (setq found t) - (if trace - (while (setq art (pop arts)) - (setcdr art (+ score (cdr art))) - (push (cons - (car-safe (rassq (cdar words) gnus-score-cache)) - kill) - gnus-score-trace)) - ;; Found a match, update scores. - (while (setq art (pop arts)) - (setcdr art (+ score (cdr art)))))) - ;; Update expiry date - (if (not trace) - (cond - ;; Permanent. - ((null date) - ;; Do nothing. - ) - ;; Match, update date. - ((and found gnus-update-score-entry-dates) - (gnus-score-set 'touched '(t) (cdar words)) - (setcar (nthcdr 2 kill) now)) - ;; Old entry, remove. - ((and expire (< date expire)) - (gnus-score-set 'touched '(t) (cdar words)) - (setcdr (caar words) (cddaar words))))) - (setq words (cdr words)))))) - nil)) - -(defun gnus-enter-score-words-into-hashtb (hashtb) - ;; Find all the words in the buffer and enter them into - ;; the hashtable. - (let ((syntab (syntax-table)) - word val) - (goto-char (point-min)) - (unwind-protect - (progn - (set-syntax-table gnus-adaptive-word-syntax-table) - (while (re-search-forward "\\b\\w+\\b" nil t) - (setq val - (gnus-gethash - (setq word (downcase (buffer-substring - (match-beginning 0) (match-end 0)))) - hashtb)) - (gnus-sethash - word - (append (get-text-property (gnus-point-at-eol) 'articles) val) - hashtb))) - (set-syntax-table syntab)) - ;; Make all the ignorable words ignored. - (let ((ignored (append gnus-ignored-adaptive-words - (if gnus-adaptive-word-no-group-words - (message-tokenize-header - (gnus-group-real-name gnus-newsgroup-name) - ".")) - gnus-default-ignored-adaptive-words))) - (while ignored - (gnus-sethash (pop ignored) nil hashtb))))) - -(defun gnus-score-string< (a1 a2) - ;; Compare headers in articles A2 and A2. - ;; The header index used is the free variable `gnus-score-index'. - (string-lessp (aref (car a1) gnus-score-index) - (aref (car a2) gnus-score-index))) - -(defun gnus-current-score-file-nondirectory (&optional score-file) - (let ((score-file (or score-file gnus-current-score-file))) - (if score-file - (gnus-short-group-name (file-name-nondirectory score-file)) - "none"))) - -(defun gnus-score-adaptive () - "Create adaptive score rules for this newsgroup." - (when gnus-newsgroup-adaptive - ;; We change the score file to the adaptive score file. - (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-score-load-file - (or gnus-newsgroup-adaptive-score-file - (gnus-home-score-file gnus-newsgroup-name t) - (gnus-score-file-name - gnus-newsgroup-name gnus-adaptive-file-suffix)))) - ;; Perform ordinary line scoring. - (when (or (not (listp gnus-newsgroup-adaptive)) - (memq 'line gnus-newsgroup-adaptive)) - (save-excursion - (let* ((malist (gnus-copy-sequence gnus-adaptive-score-alist)) - (alist malist) - (date (current-time-string)) - (data gnus-newsgroup-data) - elem headers match func) - ;; First we transform the adaptive rule alist into something - ;; that's faster to process. - (while malist - (setq elem (car malist)) - (when (symbolp (car elem)) - (setcar elem (symbol-value (car elem)))) - (setq elem (cdr elem)) - (while elem - (when (fboundp - (setq func - (intern - (concat "mail-header-" - (if (eq (caar elem) 'followup) - "message-id" - (downcase (symbol-name (caar elem)))))))) - (setcdr (car elem) - (cons (if (eq (caar elem) 'followup) - "references" - (symbol-name (caar elem))) - (cdar elem))) - (setcar (car elem) - `(lambda (h) - (,func h)))) - (setq elem (cdr elem))) - (setq malist (cdr malist))) - ;; Then we score away. - (while data - (setq elem (cdr (assq (gnus-data-mark (car data)) alist))) - (if (or (not elem) - (gnus-data-pseudo-p (car data))) - () - (when (setq headers (gnus-data-header (car data))) - (while elem - (setq match (funcall (caar elem) headers)) - (gnus-summary-score-entry - (nth 1 (car elem)) match - (cond - ((numberp match) - '=) - ((equal (nth 1 (car elem)) "date") - 'a) - (t - ;; Whether we use substring or exact matches is - ;; controlled here. - (if (or (not gnus-score-exact-adapt-limit) - (< (length match) gnus-score-exact-adapt-limit)) - 'e - (if (equal (nth 1 (car elem)) "subject") - 'f 's)))) - (nth 2 (car elem)) date nil t) - (setq elem (cdr elem))))) - (setq data (cdr data)))))) - - ;; Perform adaptive word scoring. - (when (and (listp gnus-newsgroup-adaptive) - (memq 'word gnus-newsgroup-adaptive)) - (with-temp-buffer - (let* ((hashtb (gnus-make-hashtable 1000)) - (date (date-to-day (current-time-string))) - (data gnus-newsgroup-data) - (syntab (syntax-table)) - word d score val) - (unwind-protect - (progn - (set-syntax-table gnus-adaptive-word-syntax-table) - ;; Go through all articles. - (while (setq d (pop data)) - (when (and - (not (gnus-data-pseudo-p d)) - (setq score - (cdr (assq - (gnus-data-mark d) - gnus-adaptive-word-score-alist)))) - ;; This article has a mark that should lead to - ;; adaptive word rules, so we insert the subject - ;; and find all words in that string. - (insert (mail-header-subject (gnus-data-header d))) - (downcase-region (point-min) (point-max)) - (goto-char (point-min)) - (while (re-search-forward "\\b\\w+\\b" nil t) - ;; Put the word and score into the hashtb. - (setq val (gnus-gethash (setq word (match-string 0)) - hashtb)) - (when (or (not gnus-adaptive-word-length-limit) - (> (length word) - gnus-adaptive-word-length-limit)) - (setq val (+ score (or val 0))) - (if (and gnus-adaptive-word-minimum - (< val gnus-adaptive-word-minimum)) - (setq val gnus-adaptive-word-minimum)) - (gnus-sethash word val hashtb))) - (erase-buffer)))) - (set-syntax-table syntab)) - ;; Make all the ignorable words ignored. - (let ((ignored (append gnus-ignored-adaptive-words - (if gnus-adaptive-word-no-group-words - (message-tokenize-header - (gnus-group-real-name - gnus-newsgroup-name) - ".")) - gnus-default-ignored-adaptive-words))) - (while ignored - (gnus-sethash (pop ignored) nil hashtb))) - ;; Now we have all the words and scores, so we - ;; add these rules to the ADAPT file. - (set-buffer gnus-summary-buffer) - (mapatoms - (lambda (word) - (when (symbol-value word) - (gnus-summary-score-entry - "subject" (symbol-name word) 'w (symbol-value word) - date nil t))) - hashtb)))))) - -(defun gnus-score-edit-done () - (let ((bufnam (buffer-file-name (current-buffer))) - (winconf gnus-prev-winconf)) - (when winconf - (set-window-configuration winconf)) - (gnus-score-remove-from-cache bufnam) - (gnus-score-load-file bufnam))) - -(defun gnus-score-find-trace () - "Find all score rules that applies to the current article." - (interactive) - (let ((old-scored gnus-newsgroup-scored)) - (let ((gnus-newsgroup-headers - (list (gnus-summary-article-header))) - (gnus-newsgroup-scored nil) - ;; Must be synced with `gnus-score-edit-file-at-point': - (frmt "%S [%s] -> %s\n") - trace - file) - (save-excursion - (nnheader-set-temp-buffer "*Score Trace*")) - (setq gnus-score-trace nil) - (gnus-possibly-score-headers 'trace) - (if (not (setq trace gnus-score-trace)) - (gnus-error - 1 "No score rules apply to the current article (default score %d)." - gnus-summary-default-score) - (set-buffer "*Score Trace*") - ;; Use a keymap instead? - (local-set-key "q" - (lambda () - (interactive) - (bury-buffer nil) - (gnus-summary-expand-window))) - (local-set-key "e" (lambda () - "Run `gnus-score-edit-file-at-point'." - (interactive) - (gnus-score-edit-file-at-point))) - (local-set-key "f" (lambda () - "Run `gnus-score-edit-file-at-point'." - (interactive) - (gnus-score-edit-file-at-point 'format))) - (local-set-key "t" 'toggle-truncate-lines) - (setq truncate-lines t) - (dolist (entry trace) - (setq file (or (car entry) - ;; Must be synced with - ;; `gnus-score-edit-file-at-point': - "(non-file rule)")) - (insert - (format frmt - (cdr entry) - ;; Don't use `file-name-sans-extension' to see .SCORE and - ;; .ADAPT directly: - (file-name-nondirectory file) - (abbreviate-file-name file)))) - (insert - "\n\nQuick help: - -Type `e' to edit score file corresponding to the score rule on current line, -`f' to format (pretty print) the score file and edit it, -`t' toggle to truncate long lines in this buffer, -`q' to quit. - -The first sexp on each line is the score rule, followed by the file name of -the score file and its full name, including the directory.") - (goto-char (point-min)) - (gnus-configure-windows 'score-trace))) - (set-buffer gnus-summary-buffer) - (setq gnus-newsgroup-scored old-scored))) - -(defun gnus-score-find-favourite-words () - "List words used in scoring." - (interactive) - (let ((alists (gnus-score-load-files (gnus-all-score-files))) - alist rule rules kill) - ;; Go through all the score alists for this group - ;; and find all `w' rules. - (while (setq alist (pop alists)) - (while (setq rule (pop alist)) - (when (and (stringp (car rule)) - (equal "subject" (downcase (pop rule)))) - (while (setq kill (pop rule)) - (when (memq (nth 3 kill) '(w W word Word)) - (push (cons (or (nth 1 kill) - gnus-score-interactive-default-score) - (car kill)) - rules)))))) - (setq rules (sort rules (lambda (r1 r2) - (string-lessp (cdr r1) (cdr r2))))) - ;; Add up words that have appeared several times. - (let ((r rules)) - (while (cdr r) - (if (equal (cdar r) (cdadr r)) - (progn - (setcar (car r) (+ (caar r) (caadr r))) - (setcdr r (cddr r))) - (pop r)))) - ;; Insert the words. - (nnheader-set-temp-buffer "*Score Words*") - (if (not (setq rules (sort rules (lambda (r1 r2) (> (car r1) (car r2)))))) - (gnus-error 3 "No word score rules") - (while rules - (insert (format "%-5d: %s\n" (caar rules) (cdar rules))) - (pop rules)) - (goto-char (point-min)) - (gnus-configure-windows 'score-words)))) - -(defun gnus-summary-rescore () - "Redo the entire scoring process in the current summary." - (interactive) - (gnus-score-save) - (setq gnus-score-cache nil) - (setq gnus-newsgroup-scored nil) - (gnus-possibly-score-headers) - (gnus-score-update-all-lines)) - -(defun gnus-score-flush-cache () - "Flush the cache of score files." - (interactive) - (gnus-score-save) - (setq gnus-score-cache nil - gnus-score-alist nil - gnus-short-name-score-file-cache nil) - (gnus-message 6 "The score cache is now flushed")) - -(gnus-add-shutdown 'gnus-score-close 'gnus) - -(defvar gnus-score-file-alist-cache nil) - -(defun gnus-score-close () - "Clear all internal score variables." - (setq gnus-score-cache nil - gnus-internal-global-score-files nil - gnus-score-file-list nil - gnus-score-file-alist-cache nil)) - -;; Summary score marking commands. - -(defun gnus-summary-raise-same-subject-and-select (score) - "Raise articles which has the same subject with SCORE and select the next." - (interactive "p") - (let ((subject (gnus-summary-article-subject))) - (gnus-summary-raise-score score) - (while (gnus-summary-find-subject subject) - (gnus-summary-raise-score score)) - (gnus-summary-next-article t))) - -(defun gnus-summary-raise-same-subject (score) - "Raise articles which has the same subject with SCORE." - (interactive "p") - (let ((subject (gnus-summary-article-subject))) - (gnus-summary-raise-score score) - (while (gnus-summary-find-subject subject) - (gnus-summary-raise-score score)) - (gnus-summary-next-subject 1 t))) - -(defun gnus-score-delta-default (level) - (if level (prefix-numeric-value level) - gnus-score-interactive-default-score)) - -(defun gnus-summary-raise-thread (&optional score) - "Raise the score of the articles in the current thread with SCORE." - (interactive "P") - (setq score (gnus-score-delta-default score)) - (let (e) - (save-excursion - (let ((articles (gnus-summary-articles-in-thread))) - (while articles - (gnus-summary-goto-subject (car articles)) - (gnus-summary-raise-score score) - (setq articles (cdr articles)))) - (setq e (point))) - (let ((gnus-summary-check-current t)) - (unless (zerop (gnus-summary-next-subject 1 t)) - (goto-char e)))) - (gnus-summary-recenter) - (gnus-summary-position-point) - (gnus-set-mode-line 'summary)) - -(defun gnus-summary-lower-same-subject-and-select (score) - "Raise articles which has the same subject with SCORE and select the next." - (interactive "p") - (gnus-summary-raise-same-subject-and-select (- score))) - -(defun gnus-summary-lower-same-subject (score) - "Raise articles which has the same subject with SCORE." - (interactive "p") - (gnus-summary-raise-same-subject (- score))) - -(defun gnus-summary-lower-thread (&optional score) - "Lower score of articles in the current thread with SCORE." - (interactive "P") - (gnus-summary-raise-thread (- (gnus-score-delta-default score)))) - -;;; Finding score files. - -(defun gnus-score-score-files (group) - "Return a list of all possible score files." - ;; Search and set any global score files. - (when gnus-global-score-files - (unless gnus-internal-global-score-files - (gnus-score-search-global-directories gnus-global-score-files))) - ;; Fix the kill-file dir variable. - (setq gnus-kill-files-directory - (file-name-as-directory gnus-kill-files-directory)) - ;; If we can't read it, there are no score files. - (if (not (file-exists-p (expand-file-name gnus-kill-files-directory))) - (setq gnus-score-file-list nil) - (if (not (gnus-use-long-file-name 'not-score)) - ;; We do not use long file names, so we have to do some - ;; directory traversing. - (setq gnus-score-file-list - (cons nil - (or gnus-short-name-score-file-cache - (prog2 - (gnus-message 6 "Finding all score files...") - (setq gnus-short-name-score-file-cache - (gnus-score-score-files-1 - gnus-kill-files-directory)) - (gnus-message 6 "Finding all score files...done"))))) - ;; We want long file names. - (when (or (not gnus-score-file-list) - (not (car gnus-score-file-list)) - (gnus-file-newer-than gnus-kill-files-directory - (car gnus-score-file-list))) - (setq gnus-score-file-list - (cons (nth 5 (file-attributes gnus-kill-files-directory)) - (nreverse - (directory-files - gnus-kill-files-directory t - (gnus-score-file-regexp))))))) - (cdr gnus-score-file-list))) - -(defun gnus-score-score-files-1 (dir) - "Return all possible score files under DIR." - (let ((files (list (expand-file-name dir))) - (regexp (gnus-score-file-regexp)) - (case-fold-search nil) - seen out file) - (while (setq file (pop files)) - (cond - ;; Ignore files that start with a dot. - ((string-match "^\\." (file-name-nondirectory file)) - nil) - ;; Add subtrees of directory to also be searched. - ((and (file-directory-p file) - (not (member (file-truename file) seen))) - (push (file-truename file) seen) - (setq files (nconc (directory-files file t nil t) files))) - ;; Add files to the list of score files. - ((string-match regexp file) - (push file out)))) - (or out - ;; Return a dummy value. - (list (expand-file-name "this.file.does.not.exist.SCORE" - gnus-kill-files-directory))))) - -(defun gnus-score-file-regexp () - "Return a regexp that match all score files." - (concat "\\(" (regexp-quote gnus-score-file-suffix ) - "\\|" (regexp-quote gnus-adaptive-file-suffix) "\\)\\'")) - -(defun gnus-score-find-bnews (group) - "Return a list of score files for GROUP. -The score files are those files in the ~/News/ directory which matches -GROUP using BNews sys file syntax." - (let* ((sfiles (append (gnus-score-score-files group) - gnus-internal-global-score-files)) - (kill-dir (file-name-as-directory - (expand-file-name gnus-kill-files-directory))) - (klen (length kill-dir)) - (score-regexp (gnus-score-file-regexp)) - (trans (cdr (assq ?: nnheader-file-name-translation-alist))) - (group-trans (nnheader-translate-file-chars group t)) - ofiles not-match regexp) - (save-excursion - (set-buffer (gnus-get-buffer-create "*gnus score files*")) - (buffer-disable-undo) - ;; Go through all score file names and create regexp with them - ;; as the source. - (while sfiles - (erase-buffer) - (insert (car sfiles)) - (goto-char (point-min)) - ;; First remove the suffix itself. - (when (re-search-forward (concat "." score-regexp) nil t) - (replace-match "" t t) - (goto-char (point-min)) - (if (looking-at (regexp-quote kill-dir)) - ;; If the file name was just "SCORE", `klen' is one character - ;; too much. - (delete-char (min (1- (point-max)) klen)) - (goto-char (point-max)) - (if (re-search-backward gnus-directory-sep-char-regexp nil t) - (delete-region (1+ (point)) (point-min)) - (gnus-message 1 "Can't find directory separator in %s" - (car sfiles)))) - ;; If short file names were used, we have to translate slashes. - (goto-char (point-min)) - (let ((regexp (concat - "[/:" (if trans (char-to-string trans)) "]"))) - (while (re-search-forward regexp nil t) - (replace-match "." t t))) - ;; Kludge to get rid of "nntp+" problems. - (goto-char (point-min)) - (when (looking-at "nn[a-z]+\\+") - (search-forward "+") - (forward-char -1) - (insert "\\") - (forward-char 1)) - ;; Kludge to deal with "++". - (while (search-forward "+" nil t) - (replace-match "\\+" t t)) - ;; Translate "all" to ".*". - (goto-char (point-min)) - (while (search-forward "all" nil t) - (replace-match ".*" t t)) - (goto-char (point-min)) - ;; Deal with "not."s. - (if (looking-at "not.") - (progn - (setq not-match t) - (setq regexp - (concat "^" (buffer-substring 5 (point-max)) "$"))) - (setq regexp (concat "^" (buffer-substring 1 (point-max)) "$")) - (setq not-match nil)) - ;; Finally - if this resulting regexp matches the group name, - ;; we add this score file to the list of score files - ;; applicable to this group. - (when (or (and not-match - (ignore-errors - (not (string-match regexp group-trans)))) - (and (not not-match) - (ignore-errors (string-match regexp group-trans)))) - (push (car sfiles) ofiles))) - (setq sfiles (cdr sfiles))) - (gnus-kill-buffer (current-buffer)) - ;; Slight kludge here - the last score file returned should be - ;; the local score file, whether it exists or not. This is so - ;; that any score commands the user enters will go to the right - ;; file, and not end up in some global score file. - (let ((localscore (gnus-score-file-name group))) - (setq ofiles (cons localscore (delete localscore ofiles)))) - (gnus-sort-score-files (nreverse ofiles))))) - -(defun gnus-score-find-single (group) - "Return list containing the score file for GROUP." - (list (or gnus-newsgroup-adaptive-score-file - (gnus-score-file-name group gnus-adaptive-file-suffix)) - (gnus-score-file-name group))) - -(defun gnus-score-find-hierarchical (group) - "Return list of score files for GROUP. -This includes the score file for the group and all its parents." - (let* ((prefix (gnus-group-real-prefix group)) - (all (list nil)) - (group (gnus-group-real-name group)) - (start 0)) - (while (string-match "\\." group (1+ start)) - (setq start (match-beginning 0)) - (push (substring group 0 start) all)) - (push group all) - (setq all - (nconc - (mapcar (lambda (group) - (gnus-score-file-name group gnus-adaptive-file-suffix)) - (setq all (nreverse all))) - (mapcar 'gnus-score-file-name all))) - (if (equal prefix "") - all - (mapcar - (lambda (file) - (nnheader-translate-file-chars - (concat (file-name-directory file) prefix - (file-name-nondirectory file)))) - all)))) - -(defun gnus-score-file-rank (file) - "Return a number that says how specific score FILE is. -Destroys the current buffer." - (if (member file gnus-internal-global-score-files) - 0 - (when (string-match - (concat "^" (regexp-quote - (expand-file-name - (file-name-as-directory gnus-kill-files-directory)))) - file) - (setq file (substring file (match-end 0)))) - (insert file) - (goto-char (point-min)) - (let ((beg (point)) - elems) - (while (re-search-forward "[./]" nil t) - (push (buffer-substring beg (1- (point))) - elems)) - (erase-buffer) - (setq elems (delete "all" elems)) - (length elems)))) - -(defun gnus-sort-score-files (files) - "Sort FILES so that the most general files come first." - (with-temp-buffer - (let ((alist - (mapcar - (lambda (file) - (cons (inline (gnus-score-file-rank file)) file)) - files))) - (mapcar - (lambda (f) (cdr f)) - (sort alist 'car-less-than-car))))) - -(defun gnus-score-find-alist (group) - "Return list of score files for GROUP. -The list is determined from the variable `gnus-score-file-alist'." - (let ((alist gnus-score-file-multiple-match-alist) - score-files) - ;; if this group has been seen before, return the cached entry - (if (setq score-files (assoc group gnus-score-file-alist-cache)) - (cdr score-files) ;ensures caching groups with no matches - ;; handle the multiple match alist - (while alist - (when (string-match (caar alist) group) - (setq score-files - (nconc score-files (copy-sequence (cdar alist))))) - (setq alist (cdr alist))) - (setq alist gnus-score-file-single-match-alist) - ;; handle the single match alist - (while alist - (when (string-match (caar alist) group) - ;; progn used just in case ("regexp") has no files - ;; and score-files is still nil. -sj - ;; this can be construed as a "stop searching here" feature :> - ;; and used to simplify regexps in the single-alist - (setq score-files - (nconc score-files (copy-sequence (cdar alist)))) - (setq alist nil)) - (setq alist (cdr alist))) - ;; cache the score files - (push (cons group score-files) gnus-score-file-alist-cache) - score-files))) - -(defun gnus-all-score-files (&optional group) - "Return a list of all score files for the current group." - (let ((funcs gnus-score-find-score-files-function) - (group (or group gnus-newsgroup-name)) - score-files) - (when group - ;; Make sure funcs is a list. - (and funcs - (not (listp funcs)) - (setq funcs (list funcs))) - (when gnus-score-use-all-scores - ;; Get the initial score files for this group. - (when funcs - (setq score-files (nreverse (gnus-score-find-alist group)))) - ;; Add any home adapt files. - (let ((home (gnus-home-score-file group t))) - (when home - (push home score-files) - (setq gnus-newsgroup-adaptive-score-file home))) - ;; Check whether there is a `adapt-file' group parameter. - (let ((param-file (gnus-group-find-parameter group 'adapt-file))) - (when param-file - (push param-file score-files) - (setq gnus-newsgroup-adaptive-score-file param-file)))) - ;; Go through all the functions for finding score files (or actual - ;; scores) and add them to a list. - (while funcs - (when (functionp (car funcs)) - (setq score-files - (append score-files - (nreverse (funcall (car funcs) group))))) - (setq funcs (cdr funcs))) - (when gnus-score-use-all-scores - ;; Add any home score files. - (let ((home (gnus-home-score-file group))) - (when home - (push home score-files))) - ;; Check whether there is a `score-file' group parameter. - (let ((param-file (gnus-group-find-parameter group 'score-file))) - (when param-file - (push param-file score-files)))) - ;; Expand all files names. - (let ((files score-files)) - (while files - (when (stringp (car files)) - (setcar files (expand-file-name - (car files) gnus-kill-files-directory))) - (pop files))) - (setq score-files (nreverse score-files)) - ;; Remove any duplicate score files. - (while (and score-files - (member (car score-files) (cdr score-files))) - (pop score-files)) - (let ((files score-files)) - (while (cdr files) - (if (member (cadr files) (cddr files)) - (setcdr files (cddr files)) - (pop files)))) - ;; Do the scoring if there are any score files for this group. - score-files))) - -(defun gnus-possibly-score-headers (&optional trace) - "Do scoring if scoring is required." - (let ((score-files (gnus-all-score-files))) - (when score-files - (gnus-score-headers score-files trace)))) - -(defun gnus-score-file-name (newsgroup &optional suffix) - "Return the name of a score file for NEWSGROUP." - (let ((suffix (or suffix gnus-score-file-suffix))) - (nnheader-translate-file-chars - (cond - ((or (null newsgroup) - (string-equal newsgroup "")) - ;; The global score file is placed at top of the directory. - (expand-file-name suffix gnus-kill-files-directory)) - ((gnus-use-long-file-name 'not-score) - ;; Append ".SCORE" to newsgroup name. - (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup) - "." suffix) - gnus-kill-files-directory)) - (t - ;; Place "SCORE" under the hierarchical directory. - (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup) - "/" suffix) - gnus-kill-files-directory)))))) - -(defun gnus-score-search-global-directories (files) - "Scan all global score directories for score files." - ;; Set the variable `gnus-internal-global-score-files' to all - ;; available global score files. - (interactive (list gnus-global-score-files)) - (let (out) - (while files - ;; #### /$ Unix-specific? - (if (file-directory-p (car files)) - (setq out (nconc (directory-files - (car files) t - (concat (gnus-score-file-regexp) "$")))) - (push (car files) out)) - (setq files (cdr files))) - (setq gnus-internal-global-score-files out))) - -(defun gnus-score-default-fold-toggle () - "Toggle folding for new score file entries." - (interactive) - (setq gnus-score-default-fold (not gnus-score-default-fold)) - (if gnus-score-default-fold - (gnus-message 1 "New score file entries will be case insensitive.") - (gnus-message 1 "New score file entries will be case sensitive."))) - -;;; Home score file. - -(defun gnus-home-score-file (group &optional adapt) - "Return the home score file for GROUP. -If ADAPT, return the home adaptive file instead." - (let ((list (if adapt gnus-home-adapt-file gnus-home-score-file)) - elem found) - ;; Make sure we have a list. - (unless (listp list) - (setq list (list list))) - ;; Go through the list and look for matches. - (while (and (not found) - (setq elem (pop list))) - (setq found - (cond - ;; Simple string. - ((stringp elem) - elem) - ;; Function. - ((functionp elem) - (funcall elem group)) - ;; Regexp-file cons. - ((consp elem) - (when (string-match (gnus-globalify-regexp (car elem)) group) - (replace-match (cadr elem) t nil group)))))) - (when found - (setq found (nnheader-translate-file-chars found)) - (if (file-name-absolute-p found) - found - (nnheader-concat gnus-kill-files-directory found))))) - -(defun gnus-hierarchial-home-score-file (group) - "Return the score file of the top-level hierarchy of GROUP." - (if (string-match "^[^.]+\\." group) - (concat (match-string 0 group) gnus-score-file-suffix) - ;; Group name without any dots. - (concat group (if (gnus-use-long-file-name 'not-score) "." "/") - gnus-score-file-suffix))) - -(defun gnus-hierarchial-home-adapt-file (group) - "Return the adapt file of the top-level hierarchy of GROUP." - (if (string-match "^[^.]+\\." group) - (concat (match-string 0 group) gnus-adaptive-file-suffix) - ;; Group name without any dots. - (concat group (if (gnus-use-long-file-name 'not-score) "." "/") - gnus-adaptive-file-suffix))) - -(defun gnus-current-home-score-file (group) - "Return the \"current\" regular score file." - (car (nreverse (gnus-score-find-alist group)))) - -;;; -;;; Score decays -;;; - -(defun gnus-decay-score (score) - "Decay SCORE according to `gnus-score-decay-constant' and `gnus-score-decay-scale'." - (let ((n (- score - (* (if (< score 0) -1 1) - (min (abs score) - (max gnus-score-decay-constant - (* (abs score) - gnus-score-decay-scale))))))) - (if (and (featurep 'xemacs) - ;; XEmacs' floor can handle only the floating point - ;; number below the half of the maximum integer. - (> (abs n) (lsh -1 -2))) - (string-to-number - (car (split-string (number-to-string n) "\\."))) - (floor n)))) - -(defun gnus-decay-scores (alist day) - "Decay non-permanent scores in ALIST." - (let ((times (- (time-to-days (current-time)) day)) - kill entry updated score n) - (unless (zerop times) ;Done decays today already? - (while (setq entry (pop alist)) - (when (stringp (car entry)) - (setq entry (cdr entry)) - (while (setq kill (pop entry)) - (when (nth 2 kill) - (setq updated t) - (setq score (or (nth 1 kill) - gnus-score-interactive-default-score) - n times) - (while (natnump (decf n)) - (setq score (funcall gnus-decay-score-function score))) - (setcdr kill (cons score - (cdr (cdr kill))))))))) - ;; Return whether this score file needs to be saved. By Je-haysuss! - updated)) - -(defun gnus-score-regexp-bad-p (regexp) - "Test whether REGEXP is safe for Gnus scoring. -A regexp is unsafe if it matches newline or a buffer boundary. - -If the regexp is good, return nil. If the regexp is bad, return a -cons cell (SYM . STRING), where the symbol SYM is `new' or `bad'. -In the `new' case, the string is a safe replacement for REGEXP. -In the `bad' case, the string is a unsafe subexpression of REGEXP, -and we do not have a simple replacement to suggest. - -See Info node `(gnus)Scoring Tips' for examples of good regular expressions." - (let (case-fold-search) - (and - ;; First, try a relatively fast necessary condition. - ;; Notice ranges (like [^:] or [\t-\r]), \s>, \Sw, \W, \', \`: - (string-match "\n\\|\\\\[SsW`']\\|\\[\\^\\|[\0-\n]-" regexp) - ;; Now break the regexp into tokens, and check each: - (let ((tail regexp) ; remaining regexp to check - tok ; current token - bad ; nil, or bad subexpression - new ; nil, or replacement regexp so far - end) ; length of current token - (while (and (not bad) - (string-match - "\\`\\(\\\\[sS]?.\\|\\[\\^?]?[^]]*]\\|[^\\]\\)" - tail)) - (setq end (match-end 0) - tok (substring tail 0 end) - tail (substring tail end)) - (if;; Is token `bad' (matching newline or buffer ends)? - (or (member tok '("\n" "\\W" "\\`" "\\'")) - ;; This next handles "[...]", "\\s.", and "\\S.": - (and (> end 2) (string-match tok "\n"))) - (let ((newtok - ;; Try to suggest a replacement for tok ... - (cond ((string-equal tok "\\`") "^") ; or "\\(^\\)" - ((string-equal tok "\\'") "$") ; or "\\($\\)" - ((string-match "\\[\\^" tok) ; very common - (concat (substring tok 0 -1) "\n]"))))) - (if newtok - (setq new - (concat - (or new - ;; good prefix so far: - (substring regexp 0 (- (+ (length tail) end)))) - newtok)) - ;; No replacement idea, so give up: - (setq bad tok))) - ;; tok is good, may need to extend new - (and new (setq new (concat new tok))))) - ;; Now return a value: - (cond - (bad (cons 'bad bad)) - (new (cons 'new new)) - (t nil)))))) - -(provide 'gnus-score) - -;;; arch-tag: d3922589-764d-46ae-9954-9330fd192634 -;;; gnus-score.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-setup.el b/xemacs-packages/gnus/lisp/gnus-setup.el deleted file mode 100644 index 83a02d93..00000000 --- a/xemacs-packages/gnus/lisp/gnus-setup.el +++ /dev/null @@ -1,196 +0,0 @@ -;;; gnus-setup.el --- Initialization & Setup for Gnus 5 - -;; Copyright (C) 1995, 1996, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Steven L. Baur -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: -;; My head is starting to spin with all the different mail/news packages. -;; Stop The Madness! - -;; Given that Emacs Lisp byte codes may be diverging, it is probably best -;; not to byte compile this, and just arrange to have the .el loaded out -;; of .emacs. - -;;; Code: - -(eval-when-compile (require 'cl)) - -(defvar gnus-use-installed-gnus t - "*If non-nil use installed version of Gnus.") - -(defvar gnus-use-installed-mailcrypt (featurep 'xemacs) - "*If non-nil use installed version of mailcrypt.") - -(defvar gnus-emacs-lisp-directory (if (featurep 'xemacs) - "/usr/local/lib/xemacs/" - "/usr/local/share/emacs/") - "Directory where Emacs site lisp is located.") - -(defvar gnus-gnus-lisp-directory (concat gnus-emacs-lisp-directory - "gnus/lisp/") - "Directory where Gnus Emacs lisp is found.") - -(defvar gnus-mailcrypt-lisp-directory (concat gnus-emacs-lisp-directory - "site-lisp/mailcrypt/") - "Directory where Mailcrypt Emacs Lisp is found.") - -(defvar gnus-bbdb-lisp-directory (concat gnus-emacs-lisp-directory - "site-lisp/bbdb/") - "Directory where Big Brother Database is found.") - -(defvar gnus-use-mhe nil - "Set this if you want to use MH-E for mail reading.") -(defvar gnus-use-rmail nil - "Set this if you want to use RMAIL for mail reading.") -(defvar gnus-use-sendmail t - "Set this if you want to use SENDMAIL for mail reading.") -(defvar gnus-use-vm nil - "Set this if you want to use the VM package for mail reading.") -(defvar gnus-use-sc nil - "Set this if you want to use Supercite.") -(defvar gnus-use-mailcrypt t - "Set this if you want to use Mailcrypt for dealing with PGP messages.") -(defvar gnus-use-bbdb nil - "Set this if you want to use the Big Brother DataBase.") - -(when (and (not gnus-use-installed-gnus) - (null (member gnus-gnus-lisp-directory load-path))) - (push gnus-gnus-lisp-directory load-path)) - -;;; We can't do this until we know where Gnus is. -(require 'message) - -;;; Mailcrypt by -;;; Jin Choi -;;; Patrick LoPresti - -(when gnus-use-mailcrypt - (when (and (not gnus-use-installed-mailcrypt) - (null (member gnus-mailcrypt-lisp-directory load-path))) - (setq load-path (cons gnus-mailcrypt-lisp-directory load-path))) - (autoload 'mc-install-write-mode "mailcrypt" nil t) - (autoload 'mc-install-read-mode "mailcrypt" nil t) -;;; (add-hook 'message-mode-hook 'mc-install-write-mode) -;;; (add-hook 'gnus-summary-mode-hook 'mc-install-read-mode) - (when gnus-use-mhe - (add-hook 'mh-folder-mode-hook 'mc-install-read-mode) - (add-hook 'mh-letter-mode-hook 'mc-install-write-mode))) - -;;; BBDB by -;;; Jamie Zawinski - -(when gnus-use-bbdb - ;; bbdb will never be installed with emacs. - (when (null (member gnus-bbdb-lisp-directory load-path)) - (setq load-path (cons gnus-bbdb-lisp-directory load-path))) - (autoload 'bbdb "bbdb-com" - "Insidious Big Brother Database" t) - (autoload 'bbdb-name "bbdb-com" - "Insidious Big Brother Database" t) - (autoload 'bbdb-company "bbdb-com" - "Insidious Big Brother Database" t) - (autoload 'bbdb-net "bbdb-com" - "Insidious Big Brother Database" t) - (autoload 'bbdb-notes "bbdb-com" - "Insidious Big Brother Database" t) - - (when gnus-use-vm - (autoload 'bbdb-insinuate-vm "bbdb-vm" - "Hook BBDB into VM" t)) - - (when gnus-use-rmail - (autoload 'bbdb-insinuate-rmail "bbdb-rmail" - "Hook BBDB into RMAIL" t) - (add-hook 'rmail-mode-hook 'bbdb-insinuate-rmail)) - - (when gnus-use-mhe - (autoload 'bbdb-insinuate-mh "bbdb-mh" - "Hook BBDB into MH-E" t) - (add-hook 'mh-folder-mode-hook 'bbdb-insinuate-mh)) - - (autoload 'bbdb-insinuate-gnus "bbdb-gnus" - "Hook BBDB into Gnus" t) - (add-hook 'gnus-startup-hook 'bbdb-insinuate-gnus) - - (when gnus-use-sendmail - (autoload 'bbdb-insinuate-sendmail "bbdb" - "Insidious Big Brother Database" t) - (add-hook 'mail-setup-hook 'bbdb-insinuate-sendmail) - (add-hook 'message-setup-hook 'bbdb-insinuate-sendmail))) - -(when gnus-use-sc - (add-hook 'mail-citation-hook 'sc-cite-original) - (setq message-cite-function 'sc-cite-original) - (autoload 'sc-cite-original "supercite")) - -;;;### (autoloads (gnus gnus-slave gnus-no-server) "gnus" "lisp/gnus.el" (12473 2137)) -;;; Generated autoloads from lisp/gnus.el - -;; Don't redo this if autoloads already exist -(unless (fboundp 'gnus) - (autoload 'gnus-slave-no-server "gnus" "\ -Read network news as a slave without connecting to local server." t nil) - - (autoload 'gnus-no-server "gnus" "\ -Read network news. -If ARG is a positive number, Gnus will use that as the -startup level. If ARG is nil, Gnus will be started at level 2. -If ARG is non-nil and not a positive number, Gnus will -prompt the user for the name of an NNTP server to use. -As opposed to `gnus', this command will not connect to the local server." t nil) - - (autoload 'gnus-slave "gnus" "\ -Read news as a slave." t nil) - - (autoload 'gnus "gnus" "\ -Read network news. -If ARG is non-nil and a positive number, Gnus will use that as the -startup level. If ARG is non-nil and not a positive number, Gnus will -prompt the user for the name of an NNTP server to use." t nil) - -;;;*** - -;;; These have moved out of gnus.el into other files. -;;; FIX FIX FIX: should other things be in gnus-setup? or these not in it? - (autoload 'gnus-update-format "gnus-spec" "\ -Update the format specification near point." t nil) - - (autoload 'gnus-fetch-group "gnus-group" "\ -Start Gnus if necessary and enter GROUP. -Returns whether the fetching was successful or not." t nil) - - (defalias 'gnus-batch-kill 'gnus-batch-score) - - (autoload 'gnus-batch-score "gnus-kill" "\ -Run batched scoring. -Usage: emacs -batch -l gnus -f gnus-batch-score ... -Newsgroups is a list of strings in Bnews format. If you want to score -the comp hierarchy, you'd say \"comp.all\". If you would not like to -score the alt hierarchy, you'd say \"!alt.all\"." t nil)) - -(provide 'gnus-setup) - -(run-hooks 'gnus-setup-load-hook) - -;;; arch-tag: 08e4af93-8565-46bf-905c-36229400609d -;;; gnus-setup.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-sieve.el b/xemacs-packages/gnus/lisp/gnus-sieve.el deleted file mode 100644 index a6023c83..00000000 --- a/xemacs-packages/gnus/lisp/gnus-sieve.el +++ /dev/null @@ -1,241 +0,0 @@ -;;; gnus-sieve.el --- Utilities to manage sieve scripts for Gnus - -;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: NAGY Andras , -;; Simon Josefsson - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; Gnus glue to generate complete Sieve scripts from Gnus Group -;; Parameters with "if" test predicates. - -;;; Code: - -(require 'gnus) -(require 'gnus-sum) -(require 'format-spec) -(autoload 'sieve-mode "sieve-mode") -(eval-when-compile - (require 'sieve)) - -;; Variables - -(defgroup gnus-sieve nil - "Manage sieve scripts in Gnus." - :group 'gnus) - -(defcustom gnus-sieve-file "~/.sieve" - "Path to your Sieve script." - :type 'file - :group 'gnus-sieve) - -(defcustom gnus-sieve-region-start "\n## Begin Gnus Sieve Script\n" - "Line indicating the start of the autogenerated region in -your Sieve script." - :type 'string - :group 'gnus-sieve) - -(defcustom gnus-sieve-region-end "\n## End Gnus Sieve Script\n" - "Line indicating the end of the autogenerated region in -your Sieve script." - :type 'string - :group 'gnus-sieve) - -(defcustom gnus-sieve-select-method nil - "Which select method we generate the Sieve script for. - -For example: \"nnimap:mailbox\"" - :group 'gnus-sieve) - -(defcustom gnus-sieve-crosspost t - "Whether the generated Sieve script should do crossposting." - :type 'boolean - :group 'gnus-sieve) - -(defcustom gnus-sieve-update-shell-command "echo put %f | sieveshell %s" - "Shell command to execute after updating your Sieve script. The following -formatting characters are recognized: - -%f Script's file name (gnus-sieve-file) -%s Server name (from gnus-sieve-select-method)" - :type 'string - :group 'gnus-sieve) - -;;;###autoload -(defun gnus-sieve-update () - "Update the Sieve script in gnus-sieve-file, by replacing the region -between gnus-sieve-region-start and gnus-sieve-region-end with -\(gnus-sieve-script gnus-sieve-select-method gnus-sieve-crosspost\), then -execute gnus-sieve-update-shell-command. -See the documentation for these variables and functions for details." - (interactive) - (gnus-sieve-generate) - (save-buffer) - (shell-command - (format-spec gnus-sieve-update-shell-command - (format-spec-make ?f gnus-sieve-file - ?s (or (cadr (gnus-server-get-method - nil gnus-sieve-select-method)) - ""))))) - -;;;###autoload -(defun gnus-sieve-generate () - "Generate the Sieve script in gnus-sieve-file, by replacing the region -between gnus-sieve-region-start and gnus-sieve-region-end with -\(gnus-sieve-script gnus-sieve-select-method gnus-sieve-crosspost\). -See the documentation for these variables and functions for details." - (interactive) - (require 'sieve) - (find-file gnus-sieve-file) - (goto-char (point-min)) - (if (re-search-forward (regexp-quote gnus-sieve-region-start) nil t) - (delete-region (match-beginning 0) - (or (re-search-forward (regexp-quote - gnus-sieve-region-end) nil t) - (point))) - (insert sieve-template)) - (insert gnus-sieve-region-start - (gnus-sieve-script gnus-sieve-select-method gnus-sieve-crosspost) - gnus-sieve-region-end)) - -(defun gnus-sieve-guess-rule-for-article () - "Guess a sieve rule based on RFC822 article in buffer. -Return nil if no rule could be guessed." - (when (message-fetch-field "sender") - `(sieve address "sender" ,(message-fetch-field "sender")))) - -;;;###autoload -(defun gnus-sieve-article-add-rule () - (interactive) - (gnus-summary-select-article nil 'force) - (with-current-buffer gnus-original-article-buffer - (let ((rule (gnus-sieve-guess-rule-for-article)) - (info (gnus-get-info gnus-newsgroup-name))) - (if (null rule) - (error "Could not guess rule for article") - (gnus-info-set-params info (cons rule (gnus-info-params info))) - (message "Added rule in group %s for article: %s" gnus-newsgroup-name - rule))))) - -;; Internals - -;; FIXME: do proper quoting of " etc -(defun gnus-sieve-string-list (list) - "Convert an elisp string list to a Sieve string list. - -For example: -\(gnus-sieve-string-list '(\"to\" \"cc\")) - => \"[\\\"to\\\", \\\"cc\\\"]\" -" - (concat "[\"" (mapconcat 'identity list "\", \"") "\"]")) - -(defun gnus-sieve-test-list (list) - "Convert an elisp test list to a Sieve test list. - -For example: -\(gnus-sieve-test-list '((address \"sender\" \"boss@company.com\") (size :over 4K))) - => \"(address \\\"sender\\\" \\\"boss@company.com\\\", size :over 4K)\"" - (concat "(" (mapconcat 'gnus-sieve-test list ", ") ")")) - -;; FIXME: do proper quoting -(defun gnus-sieve-test-token (token) - "Convert an elisp test token to a Sieve test token. - -For example: -\(gnus-sieve-test-token 'address) - => \"address\" - -\(gnus-sieve-test-token \"sender\") - => \"\\\"sender\\\"\" - -\(gnus-sieve-test-token '(\"to\" \"cc\")) - => \"[\\\"to\\\", \\\"cc\\\"]\"" - (cond - ((symbolp token) ;; Keyword - (symbol-name token)) - - ((stringp token) ;; String - (concat "\"" token "\"")) - - ((and (listp token) ;; String list - (stringp (car token))) - (gnus-sieve-string-list token)) - - ((and (listp token) ;; Test list - (listp (car token))) - (gnus-sieve-test-list token)))) - -(defun gnus-sieve-test (test) - "Convert an elisp test to a Sieve test. - -For example: -\(gnus-sieve-test '(address \"sender\" \"sieve-admin@extundo.com\")) - => \"address \\\"sender\\\" \\\"sieve-admin@extundo.com\\\"\" - -\(gnus-sieve-test '(anyof ((header :contains (\"to\" \"cc\") \"my@address.com\") - (size :over 100K)))) - => \"anyof (header :contains [\\\"to\\\", \\\"cc\\\"] \\\"my@address.com\\\", - size :over 100K)\"" - (mapconcat 'gnus-sieve-test-token test " ")) - -(defun gnus-sieve-script (&optional method crosspost) - "Generate a Sieve script based on groups with select method METHOD -\(or all groups if nil\). Only groups having a `sieve' parameter are -considered. This parameter should contain an elisp test -\(see the documentation of gnus-sieve-test for details\). For each -such group, a Sieve IF control structure is generated, having the -test as the condition and { fileinto \"group.name\"; } as the body. - -If CROSSPOST is nil, each conditional body contains a \"stop\" command -which stops execution after a match is found. - -For example: If the INBOX.list.sieve group has the - - (sieve address \"sender\" \"sieve-admin@extundo.com\") - -group parameter, (gnus-sieve-script) results in: - - if address \"sender\" \"sieve-admin@extundo.com\" { - fileinto \"INBOX.list.sieve\"; - } - -This is returned as a string." - (let* ((newsrc (cdr gnus-newsrc-alist)) - script) - (dolist (info newsrc) - (when (or (not method) - (gnus-server-equal method (gnus-info-method info))) - (let* ((group (gnus-info-group info)) - (spec (gnus-group-find-parameter group 'sieve t))) - (when spec - (push (concat "if " (gnus-sieve-test spec) " {\n" - "\tfileinto \"" (gnus-group-real-name group) "\";\n" - (if crosspost - "" - "\tstop;\n") - "}") - script))))) - (mapconcat 'identity script "\n"))) - -(provide 'gnus-sieve) - -;;; arch-tag: 3b906527-c7f3-4c86-9e82-62e2697998a3 -;;; gnus-sieve.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-soup.el b/xemacs-packages/gnus/lisp/gnus-soup.el deleted file mode 100644 index 202bfedb..00000000 --- a/xemacs-packages/gnus/lisp/gnus-soup.el +++ /dev/null @@ -1,614 +0,0 @@ -;;; gnus-soup.el --- SOUP packet writing support for Gnus - -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Per Abrahamsen -;; Lars Magne Ingebrigtsen -;; Keywords: news, mail - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) -(require 'gnus-art) -(require 'message) -(require 'gnus-start) -(require 'gnus-range) - -(defgroup gnus-soup nil - "SOUP packet writing support for Gnus." - :group 'gnus) - -;;; User Variables: - -(defcustom gnus-soup-directory (nnheader-concat gnus-home-directory "SoupBrew/") - "Directory containing an unpacked SOUP packet." - :version "22.1" ;; Gnus 5.10.9 - :type 'directory - :group 'gnus-soup) - -(defcustom gnus-soup-replies-directory - (nnheader-concat gnus-soup-directory "SoupReplies/") - "Directory where Gnus will do processing of replies." - :version "22.1" ;; Gnus 5.10.9 - :type 'directory - :group 'gnus-soup) - -(defcustom gnus-soup-prefix-file "gnus-prefix" - "Name of the file where Gnus stores the last used prefix." - :version "22.1" ;; Gnus 5.10.9 - :type 'file - :group 'gnus-soup) - -(defcustom gnus-soup-packer "tar cf - %s | gzip > $HOME/Soupout%d.tgz" - "Format string command for packing a SOUP packet. -The SOUP files will be inserted where the %s is in the string. -This string MUST contain both %s and %d. The file number will be -inserted where %d appears." - :version "22.1" ;; Gnus 5.10.9 - :type 'string - :group 'gnus-soup) - -(defcustom gnus-soup-unpacker "gunzip -c %s | tar xvf -" - "Format string command for unpacking a SOUP packet. -The SOUP packet file name will be inserted at the %s." - :version "22.1" ;; Gnus 5.10.9 - :type 'string - :group 'gnus-soup) - -(defcustom gnus-soup-packet-directory gnus-home-directory - "Where gnus-soup will look for REPLIES packets." - :version "22.1" ;; Gnus 5.10.9 - :type 'directory - :group 'gnus-soup) - -(defcustom gnus-soup-packet-regexp "Soupin" - "Regular expression matching SOUP REPLIES packets in `gnus-soup-packet-directory'." - :version "22.1" ;; Gnus 5.10.9 - :type 'regexp - :group 'gnus-soup) - -(defcustom gnus-soup-ignored-headers "^Xref:" - "Regexp to match headers to be removed when brewing SOUP packets." - :version "22.1" ;; Gnus 5.10.9 - :type 'regexp - :group 'gnus-soup) - -;;; Internal Variables: - -(defvar gnus-soup-encoding-type ?u - "*Soup encoding type. -`u' is USENET news format, `m' is Unix mbox format, and `M' is MMDF mailbox -format.") - -(defvar gnus-soup-index-type ?c - "*Soup index type. -`n' means no index file and `c' means standard Cnews overview -format.") - -(defvar gnus-soup-areas nil) -(defvar gnus-soup-last-prefix nil) -(defvar gnus-soup-prev-prefix nil) -(defvar gnus-soup-buffers nil) - -;;; Access macros: - -(defmacro gnus-soup-area-prefix (area) - `(aref ,area 0)) -(defmacro gnus-soup-set-area-prefix (area prefix) - `(aset ,area 0 ,prefix)) -(defmacro gnus-soup-area-name (area) - `(aref ,area 1)) -(defmacro gnus-soup-area-encoding (area) - `(aref ,area 2)) -(defmacro gnus-soup-area-description (area) - `(aref ,area 3)) -(defmacro gnus-soup-area-number (area) - `(aref ,area 4)) -(defmacro gnus-soup-area-set-number (area value) - `(aset ,area 4 ,value)) - -(defmacro gnus-soup-encoding-format (encoding) - `(aref ,encoding 0)) -(defmacro gnus-soup-encoding-index (encoding) - `(aref ,encoding 1)) -(defmacro gnus-soup-encoding-kind (encoding) - `(aref ,encoding 2)) - -(defmacro gnus-soup-reply-prefix (reply) - `(aref ,reply 0)) -(defmacro gnus-soup-reply-kind (reply) - `(aref ,reply 1)) -(defmacro gnus-soup-reply-encoding (reply) - `(aref ,reply 2)) - -;;; Commands: - -(defun gnus-soup-send-replies () - "Unpack and send all replies in the reply packet." - (interactive) - (let ((packets (directory-files - gnus-soup-packet-directory t gnus-soup-packet-regexp))) - (while packets - (when (gnus-soup-send-packet (car packets)) - (delete-file (car packets))) - (setq packets (cdr packets))))) - -(defun gnus-soup-add-article (n) - "Add the current article to SOUP packet. -If N is a positive number, add the N next articles. -If N is a negative number, add the N previous articles. -If N is nil and any articles have been marked with the process mark, -move those articles instead." - (interactive "P") - (let* ((articles (gnus-summary-work-articles n)) - (tmp-buf (gnus-get-buffer-create "*soup work*")) - (area (gnus-soup-area gnus-newsgroup-name)) - (prefix (gnus-soup-area-prefix area)) - headers) - (buffer-disable-undo tmp-buf) - (save-excursion - (while articles - ;; Put the article in a buffer. - (set-buffer tmp-buf) - (when (gnus-request-article-this-buffer - (car articles) gnus-newsgroup-name) - (setq headers (nnheader-parse-head t)) - (save-restriction - (message-narrow-to-head) - (message-remove-header gnus-soup-ignored-headers t)) - (gnus-soup-store gnus-soup-directory prefix headers - gnus-soup-encoding-type - gnus-soup-index-type) - (gnus-soup-area-set-number - area (1+ (or (gnus-soup-area-number area) 0))) - ;; Mark article as read. - (set-buffer gnus-summary-buffer) - (gnus-summary-mark-as-read (car articles) gnus-souped-mark)) - (gnus-summary-remove-process-mark (car articles)) - (setq articles (cdr articles))) - (kill-buffer tmp-buf)) - (gnus-soup-save-areas) - (gnus-set-mode-line 'summary))) - -(defun gnus-soup-pack-packet () - "Make a SOUP packet from the SOUP areas." - (interactive) - (gnus-soup-read-areas) - (if (file-exists-p gnus-soup-directory) - (if (directory-files gnus-soup-directory nil "\\.MSG$") - (gnus-soup-pack gnus-soup-directory gnus-soup-packer) - (message "No files to pack.")) - (message "No such directory: %s" gnus-soup-directory))) - -(defun gnus-group-brew-soup (n) - "Make a soup packet from the current group. -Uses the process/prefix convention." - (interactive "P") - (let ((groups (gnus-group-process-prefix n))) - (while groups - (gnus-group-remove-mark (car groups)) - (gnus-soup-group-brew (car groups) t) - (setq groups (cdr groups))) - (gnus-soup-save-areas))) - -(defun gnus-brew-soup (&optional level) - "Go through all groups on LEVEL or less and make a soup packet." - (interactive "P") - (let ((level (or level gnus-level-subscribed)) - (newsrc (cdr gnus-newsrc-alist))) - (while newsrc - (when (<= (nth 1 (car newsrc)) level) - (gnus-soup-group-brew (caar newsrc) t)) - (setq newsrc (cdr newsrc))) - (gnus-soup-save-areas))) - -;;;###autoload -(defun gnus-batch-brew-soup () - "Brew a SOUP packet from groups mention on the command line. -Will use the remaining command line arguments as regular expressions -for matching on group names. - -For instance, if you want to brew on all the nnml groups, as well as -groups with \"emacs\" in the name, you could say something like: - -$ emacs -batch -f gnus-batch-brew-soup ^nnml \".*emacs.*\" - -Note -- this function hasn't been implemented yet." - (interactive) - nil) - -;;; Internal Functions: - -;; Store the current buffer. -(defun gnus-soup-store (directory prefix headers format index) - ;; Create the directory, if needed. - (gnus-make-directory directory) - (let* ((msg-buf (nnheader-find-file-noselect - (concat directory prefix ".MSG"))) - (idx-buf (if (= index ?n) - nil - (nnheader-find-file-noselect - (concat directory prefix ".IDX")))) - (article-buf (current-buffer)) - from head-line beg type) - (setq gnus-soup-buffers (cons msg-buf (delq msg-buf gnus-soup-buffers))) - (buffer-disable-undo msg-buf) - (when idx-buf - (push idx-buf gnus-soup-buffers) - (buffer-disable-undo idx-buf)) - (save-excursion - ;; Make sure the last char in the buffer is a newline. - (goto-char (point-max)) - (unless (= (current-column) 0) - (insert "\n")) - ;; Find the "from". - (goto-char (point-min)) - (setq from - (gnus-mail-strip-quoted-names - (or (mail-fetch-field "from") - (mail-fetch-field "really-from") - (mail-fetch-field "sender")))) - (goto-char (point-min)) - ;; Depending on what encoding is supposed to be used, we make - ;; a soup header. - (setq head-line - (cond - ((or (= gnus-soup-encoding-type ?u) - (= gnus-soup-encoding-type ?n)) ;;Gnus back compatibility. - (format "#! rnews %d\n" (buffer-size))) - ((= gnus-soup-encoding-type ?m) - (while (search-forward "\nFrom " nil t) - (replace-match "\n>From " t t)) - (concat "From " (or from "unknown") - " " (current-time-string) "\n")) - ((= gnus-soup-encoding-type ?M) - "\^a\^a\^a\^a\n") - (t (error "Unsupported type: %c" gnus-soup-encoding-type)))) - ;; Insert the soup header and the article in the MSG buf. - (set-buffer msg-buf) - (goto-char (point-max)) - (insert head-line) - (setq beg (point)) - (insert-buffer-substring article-buf) - ;; Insert the index in the IDX buf. - (cond ((= index ?c) - (set-buffer idx-buf) - (gnus-soup-insert-idx beg headers)) - ((/= index ?n) - (error "Unknown index type: %c" type))) - ;; Return the MSG buf. - msg-buf))) - -(defun gnus-soup-group-brew (group &optional not-all) - "Enter GROUP and add all articles to a SOUP package. -If NOT-ALL, don't pack ticked articles." - (let ((gnus-expert-user t) - (gnus-large-newsgroup nil) - (entry (gnus-gethash group gnus-newsrc-hashtb))) - (when (or (null entry) - (eq (car entry) t) - (and (car entry) - (> (car entry) 0)) - (and (not not-all) - (gnus-range-length (cdr (assq 'tick (gnus-info-marks - (nth 2 entry))))))) - (when (gnus-summary-read-group group nil t) - (setq gnus-newsgroup-processable - (reverse - (if (not not-all) - (append gnus-newsgroup-marked gnus-newsgroup-unreads) - gnus-newsgroup-unreads))) - (gnus-soup-add-article nil) - (gnus-summary-exit))))) - -(defun gnus-soup-insert-idx (offset header) - ;; [number subject from date id references chars lines xref] - (goto-char (point-max)) - (insert - (format "%d\t%s\t%s\t%s\t%s\t%s\t%d\t%s\t\t\n" - offset - (or (mail-header-subject header) "(none)") - (or (mail-header-from header) "(nobody)") - (or (mail-header-date header) "") - (or (mail-header-id header) - (concat "soup-dummy-id-" - (mapconcat - (lambda (time) (int-to-string time)) - (current-time) "-"))) - (or (mail-header-references header) "") - (or (mail-header-chars header) 0) - (or (mail-header-lines header) "0")))) - -(defun gnus-soup-save-areas () - "Write all SOUP buffers." - (interactive) - (gnus-soup-write-areas) - (save-excursion - (let (buf) - (while gnus-soup-buffers - (setq buf (car gnus-soup-buffers) - gnus-soup-buffers (cdr gnus-soup-buffers)) - (if (not (buffer-name buf)) - () - (set-buffer buf) - (when (buffer-modified-p) - (save-buffer)) - (kill-buffer (current-buffer))))) - (gnus-soup-write-prefixes))) - -(defun gnus-soup-write-prefixes () - (let ((prefixes gnus-soup-last-prefix) - prefix) - (save-excursion - (gnus-set-work-buffer) - (while (setq prefix (pop prefixes)) - (erase-buffer) - (insert (format "(setq gnus-soup-prev-prefix %d)\n" (cdr prefix))) - (let ((coding-system-for-write mm-text-coding-system)) - (gnus-write-buffer (concat (car prefix) gnus-soup-prefix-file))))))) - -(defun gnus-soup-pack (dir packer) - (let* ((files (mapconcat 'identity - '("AREAS" "*.MSG" "*.IDX" "INFO" - "LIST" "REPLIES" "COMMANDS" "ERRORS") - " ")) - (packer (if (< (string-match "%s" packer) - (string-match "%d" packer)) - (format packer files - (string-to-number (gnus-soup-unique-prefix dir))) - (format packer - (string-to-number (gnus-soup-unique-prefix dir)) - files))) - (dir (expand-file-name dir))) - (gnus-make-directory dir) - (setq gnus-soup-areas nil) - (gnus-message 4 "Packing %s..." packer) - (if (eq 0 (call-process shell-file-name - nil nil nil shell-command-switch - (concat "cd " dir " ; " packer))) - (progn - (call-process shell-file-name nil nil nil shell-command-switch - (concat "cd " dir " ; rm " files)) - (gnus-message 4 "Packing...done" packer)) - (error "Couldn't pack packet")))) - -(defun gnus-soup-parse-areas (file) - "Parse soup area file FILE. -The result is a of vectors, each containing one entry from the AREA file. -The vector contain five strings, - [prefix name encoding description number] -though the two last may be nil if they are missing." - (let (areas) - (when (file-exists-p file) - (save-excursion - (set-buffer (nnheader-find-file-noselect file 'force)) - (buffer-disable-undo) - (goto-char (point-min)) - (while (not (eobp)) - (push (vector (gnus-soup-field) - (gnus-soup-field) - (gnus-soup-field) - (and (eq (preceding-char) ?\t) - (gnus-soup-field)) - (and (eq (preceding-char) ?\t) - (string-to-number (gnus-soup-field)))) - areas) - (when (eq (preceding-char) ?\t) - (beginning-of-line 2))) - (kill-buffer (current-buffer)))) - areas)) - -(defun gnus-soup-parse-replies (file) - "Parse soup REPLIES file FILE. -The result is a of vectors, each containing one entry from the REPLIES -file. The vector contain three strings, [prefix name encoding]." - (let (replies) - (save-excursion - (set-buffer (nnheader-find-file-noselect file)) - (buffer-disable-undo) - (goto-char (point-min)) - (while (not (eobp)) - (push (vector (gnus-soup-field) (gnus-soup-field) - (gnus-soup-field)) - replies) - (when (eq (preceding-char) ?\t) - (beginning-of-line 2))) - (kill-buffer (current-buffer))) - replies)) - -(defun gnus-soup-field () - (prog1 - (buffer-substring (point) (progn (skip-chars-forward "^\t\n") (point))) - (forward-char 1))) - -(defun gnus-soup-read-areas () - (or gnus-soup-areas - (setq gnus-soup-areas - (gnus-soup-parse-areas (concat gnus-soup-directory "AREAS"))))) - -(defun gnus-soup-write-areas () - "Write the AREAS file." - (interactive) - (when gnus-soup-areas - (with-temp-file (concat gnus-soup-directory "AREAS") - (let ((areas gnus-soup-areas) - area) - (while (setq area (pop areas)) - (insert - (format - "%s\t%s\t%s%s\n" - (gnus-soup-area-prefix area) - (gnus-soup-area-name area) - (gnus-soup-area-encoding area) - (if (or (gnus-soup-area-description area) - (gnus-soup-area-number area)) - (concat "\t" (or (gnus-soup-area-description - area) "") - (if (gnus-soup-area-number area) - (concat "\t" (int-to-string - (gnus-soup-area-number area))) - "")) "")))))))) - -(defun gnus-soup-write-replies (dir areas) - "Write a REPLIES file in DIR containing AREAS." - (with-temp-file (concat dir "REPLIES") - (let (area) - (while (setq area (pop areas)) - (insert (format "%s\t%s\t%s\n" - (gnus-soup-reply-prefix area) - (gnus-soup-reply-kind area) - (gnus-soup-reply-encoding area))))))) - -(defun gnus-soup-area (group) - (gnus-soup-read-areas) - (let ((areas gnus-soup-areas) - (real-group (gnus-group-real-name group)) - area result) - (while areas - (setq area (car areas) - areas (cdr areas)) - (when (equal (gnus-soup-area-name area) real-group) - (setq result area))) - (unless result - (setq result - (vector (gnus-soup-unique-prefix) - real-group - (format "%c%c%c" - gnus-soup-encoding-type - gnus-soup-index-type - (if (gnus-member-of-valid 'mail group) ?m ?n)) - nil nil) - gnus-soup-areas (cons result gnus-soup-areas))) - result)) - -(defun gnus-soup-unique-prefix (&optional dir) - (let* ((dir (file-name-as-directory (or dir gnus-soup-directory))) - (entry (assoc dir gnus-soup-last-prefix)) - gnus-soup-prev-prefix) - (if entry - () - (when (file-exists-p (concat dir gnus-soup-prefix-file)) - (ignore-errors - (load (concat dir gnus-soup-prefix-file) nil t t))) - (push (setq entry (cons dir (or gnus-soup-prev-prefix 0))) - gnus-soup-last-prefix)) - (setcdr entry (1+ (cdr entry))) - (gnus-soup-write-prefixes) - (int-to-string (cdr entry)))) - -(defun gnus-soup-unpack-packet (dir unpacker packet) - "Unpack PACKET into DIR using UNPACKER. -Return whether the unpacking was successful." - (gnus-make-directory dir) - (gnus-message 4 "Unpacking: %s" (format unpacker packet)) - (prog1 - (eq 0 (call-process - shell-file-name nil nil nil shell-command-switch - (format "cd %s ; %s" (expand-file-name dir) - (format unpacker packet)))) - (gnus-message 4 "Unpacking...done"))) - -(defun gnus-soup-send-packet (packet) - (gnus-soup-unpack-packet - gnus-soup-replies-directory gnus-soup-unpacker packet) - (let ((replies (gnus-soup-parse-replies - (concat gnus-soup-replies-directory "REPLIES")))) - (save-excursion - (while replies - (let* ((msg-file (concat gnus-soup-replies-directory - (gnus-soup-reply-prefix (car replies)) - ".MSG")) - (msg-buf (and (file-exists-p msg-file) - (nnheader-find-file-noselect msg-file))) - (tmp-buf (gnus-get-buffer-create " *soup send*")) - beg end) - (cond - ((and (/= (gnus-soup-encoding-format - (gnus-soup-reply-encoding (car replies))) - ?u) - (/= (gnus-soup-encoding-format - (gnus-soup-reply-encoding (car replies))) - ?n)) ;; Gnus back compatibility. - (error "Unsupported encoding")) - ((null msg-buf) - t) - (t - (buffer-disable-undo msg-buf) - (set-buffer msg-buf) - (goto-char (point-min)) - (while (not (eobp)) - (unless (looking-at "#! *rnews +\\([0-9]+\\)") - (error "Bad header")) - (forward-line 1) - (setq beg (point) - end (+ (point) (string-to-number - (buffer-substring - (match-beginning 1) (match-end 1))))) - (switch-to-buffer tmp-buf) - (erase-buffer) - (mm-disable-multibyte) - (insert-buffer-substring msg-buf beg end) - (cond - ((string= (gnus-soup-reply-kind (car replies)) "news") - (gnus-message 5 "Sending news message to %s..." - (mail-fetch-field "newsgroups")) - (sit-for 1) - (let ((message-syntax-checks - 'dont-check-for-anything-just-trust-me) - (method (if (functionp message-post-method) - (funcall message-post-method) - message-post-method)) - result) - (run-hooks 'message-send-news-hook) - (gnus-open-server method) - (message "Sending news via %s..." - (gnus-server-string method)) - (unless (let ((mail-header-separator "")) - (gnus-request-post method)) - (message "Couldn't send message via news: %s" - (nnheader-get-report (car method)))))) - ((string= (gnus-soup-reply-kind (car replies)) "mail") - (gnus-message 5 "Sending mail to %s..." - (mail-fetch-field "to")) - (sit-for 1) - (let ((mail-header-separator "")) - (mm-with-unibyte-current-buffer - (funcall (or message-send-mail-real-function - message-send-mail-function))))) - (t - (error "Unknown reply kind"))) - (set-buffer msg-buf) - (goto-char end)) - (delete-file (buffer-file-name)) - (kill-buffer msg-buf) - (kill-buffer tmp-buf) - (gnus-message 4 "Sent packet")))) - (setq replies (cdr replies))) - t))) - -(provide 'gnus-soup) - -;;; arch-tag: eddfa69d-13e8-4aea-84ef-62a526ef185c -;;; gnus-soup.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-spec.el b/xemacs-packages/gnus/lisp/gnus-spec.el deleted file mode 100644 index b198f682..00000000 --- a/xemacs-packages/gnus/lisp/gnus-spec.el +++ /dev/null @@ -1,765 +0,0 @@ -;;; gnus-spec.el --- format spec functions for Gnus - -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) -(defvar gnus-newsrc-file-version) - -(require 'gnus) - -(defcustom gnus-use-correct-string-widths (featurep 'xemacs) - "*If non-nil, use correct functions for dealing with wide characters." - :version "22.1" - :group 'gnus-format - :type 'boolean) - -(defcustom gnus-make-format-preserve-properties (featurep 'xemacs) - "*If non-nil, use a replacement `format' function which preserves -text properties. This is only needed on XEmacs, as FSF Emacs does this anyway." - :version "22.1" - :group 'gnus-format - :type 'boolean) - -;;; Internal variables. - -(defvar gnus-summary-mark-positions nil) -(defvar gnus-group-mark-positions nil) -(defvar gnus-group-indentation "") - -;; Format specs. The chunks below are the machine-generated forms -;; that are to be evaled as the result of the default format strings. -;; We write them in here to get them byte-compiled. That way the -;; default actions will be quite fast, while still retaining the full -;; flexibility of the user-defined format specs. - -;; First we have lots of dummy defvars to let the compiler know these -;; are really dynamic variables. - -(defvar gnus-tmp-unread) -(defvar gnus-tmp-replied) -(defvar gnus-tmp-score-char) -(defvar gnus-tmp-indentation) -(defvar gnus-tmp-opening-bracket) -(defvar gnus-tmp-lines) -(defvar gnus-tmp-name) -(defvar gnus-tmp-closing-bracket) -(defvar gnus-tmp-subject-or-nil) -(defvar gnus-tmp-subject) -(defvar gnus-tmp-marked) -(defvar gnus-tmp-marked-mark) -(defvar gnus-tmp-subscribed) -(defvar gnus-tmp-process-marked) -(defvar gnus-tmp-number-of-unread) -(defvar gnus-tmp-group-name) -(defvar gnus-tmp-group) -(defvar gnus-tmp-article-number) -(defvar gnus-tmp-unread-and-unselected) -(defvar gnus-tmp-news-method) -(defvar gnus-tmp-news-server) -(defvar gnus-tmp-article-number) -(defvar gnus-mouse-face) -(defvar gnus-mouse-face-prop) -(defvar gnus-tmp-header) -(defvar gnus-tmp-from) - -(defun gnus-summary-line-format-spec () - (insert gnus-tmp-unread gnus-tmp-replied - gnus-tmp-score-char gnus-tmp-indentation) - (gnus-put-text-property - (point) - (progn - (insert - (format "%c%4s: %-23s%c" gnus-tmp-opening-bracket gnus-tmp-lines - (let ((val - (inline - (gnus-summary-from-or-to-or-newsgroups - gnus-tmp-header gnus-tmp-from)))) - (if (> (length val) 23) - (substring val 0 23) - val)) - gnus-tmp-closing-bracket)) - (point)) - gnus-mouse-face-prop gnus-mouse-face) - (insert " " gnus-tmp-subject-or-nil "\n")) - -(defvar gnus-summary-line-format-spec - (gnus-byte-code 'gnus-summary-line-format-spec)) - -(defun gnus-summary-dummy-line-format-spec () - (insert "* ") - (gnus-put-text-property - (point) - (progn - (insert ": :") - (point)) - gnus-mouse-face-prop gnus-mouse-face) - (insert " " gnus-tmp-subject "\n")) - -(defvar gnus-summary-dummy-line-format-spec - (gnus-byte-code 'gnus-summary-dummy-line-format-spec)) - -(defun gnus-group-line-format-spec () - (insert gnus-tmp-marked-mark gnus-tmp-subscribed - gnus-tmp-process-marked - gnus-group-indentation - (format "%5s: " gnus-tmp-number-of-unread)) - (gnus-put-text-property - (point) - (progn - (insert gnus-tmp-group "\n") - (1- (point))) - gnus-mouse-face-prop gnus-mouse-face)) -(defvar gnus-group-line-format-spec - (gnus-byte-code 'gnus-group-line-format-spec)) - -(defvar gnus-format-specs - `((version . ,emacs-version) - (gnus-version . ,(gnus-continuum-version)) - (group "%M\%S\%p\%P\%5y: %(%g%)%l\n" ,gnus-group-line-format-spec) - (summary-dummy "* %(: :%) %S\n" - ,gnus-summary-dummy-line-format-spec) - (summary "%U%R%z%I%(%[%4L: %-23,23f%]%) %s\n" - ,gnus-summary-line-format-spec)) - "Alist of format specs.") - -(defvar gnus-default-format-specs gnus-format-specs) - -(defvar gnus-article-mode-line-format-spec nil) -(defvar gnus-summary-mode-line-format-spec nil) -(defvar gnus-group-mode-line-format-spec nil) - -;;; Phew. All that gruft is over with, fortunately. - -;;;###autoload -(defun gnus-update-format (var) - "Update the format specification near point." - (interactive - (list - (save-excursion - (eval-defun nil) - ;; Find the end of the current word. - (re-search-forward "[ \t\n]" nil t) - ;; Search backward. - (when (re-search-backward "\\(gnus-[-a-z]+-line-format\\)" nil t) - (match-string 1))))) - (let* ((type (intern (progn (string-match "gnus-\\([-a-z]+\\)-line" var) - (match-string 1 var)))) - (entry (assq type gnus-format-specs)) - value spec) - (when entry - (setq gnus-format-specs (delq entry gnus-format-specs))) - (set - (intern (format "%s-spec" var)) - (gnus-parse-format (setq value (symbol-value (intern var))) - (symbol-value (intern (format "%s-alist" var))) - (not (string-match "mode" var)))) - (setq spec (symbol-value (intern (format "%s-spec" var)))) - (push (list type value spec) gnus-format-specs) - - (pop-to-buffer "*Gnus Format*") - (erase-buffer) - (lisp-interaction-mode) - (insert (gnus-pp-to-string spec)))) - -(defun gnus-update-format-specifications (&optional force &rest types) - "Update all (necessary) format specifications. -Return a list of updated types." - ;; Make the indentation array. - ;; See whether all the stored info needs to be flushed. - (when (or force - (not gnus-newsrc-file-version) - (not (equal (gnus-continuum-version) - (gnus-continuum-version gnus-newsrc-file-version))) - (not (equal emacs-version - (cdr (assq 'version gnus-format-specs))))) - (setq gnus-format-specs nil)) - ;; Flush the group format spec cache if it doesn't support decoded - ;; group names. - (when (memq 'group types) - (let ((spec (assq 'group gnus-format-specs))) - (unless (string-match " gnus-tmp-decoded-group[ )]" - (gnus-prin1-to-string (nth 2 spec))) - (setq gnus-format-specs (delq spec gnus-format-specs))))) - - ;; Go through all the formats and see whether they need updating. - (let (new-format entry type val updated) - (while (setq type (pop types)) - ;; Jump to the proper buffer to find out the value of the - ;; variable, if possible. (It may be buffer-local.) - (save-excursion - (let ((buffer (intern (format "gnus-%s-buffer" type)))) - (when (and (boundp buffer) - (setq val (symbol-value buffer)) - (gnus-buffer-exists-p val)) - (set-buffer val)) - (setq new-format (symbol-value - (intern (format "gnus-%s-line-format" type))))) - (setq entry (cdr (assq type gnus-format-specs))) - (if (and (car entry) - (equal (car entry) new-format)) - ;; Use the old format. - (set (intern (format "gnus-%s-line-format-spec" type)) - (cadr entry)) - ;; This is a new format. - (setq val - (if (not (stringp new-format)) - ;; This is a function call or something. - new-format - ;; This is a "real" format. - (gnus-parse-format - new-format - (symbol-value - (intern (format "gnus-%s-line-format-alist" type))) - (not (string-match "mode$" (symbol-name type)))))) - ;; Enter the new format spec into the list. - (if entry - (progn - (setcar (cdr entry) val) - (setcar entry new-format)) - (push (list type new-format val) gnus-format-specs)) - (set (intern (format "gnus-%s-line-format-spec" type)) val) - (push type updated)))) - - (unless (assq 'version gnus-format-specs) - (push (cons 'version emacs-version) gnus-format-specs)) - updated)) - -(defvar gnus-mouse-face-0 'highlight) -(defvar gnus-mouse-face-1 'highlight) -(defvar gnus-mouse-face-2 'highlight) -(defvar gnus-mouse-face-3 'highlight) -(defvar gnus-mouse-face-4 'highlight) - -(defun gnus-mouse-face-function (form type) - `(gnus-put-text-property - (point) (progn ,@form (point)) - gnus-mouse-face-prop - ,(if (equal type 0) - 'gnus-mouse-face - `(quote ,(symbol-value (intern (format "gnus-mouse-face-%d" type))))))) - -(defvar gnus-face-0 'bold) -(defvar gnus-face-1 'italic) -(defvar gnus-face-2 'bold-italic) -(defvar gnus-face-3 'bold) -(defvar gnus-face-4 'bold) - -(defun gnus-face-face-function (form type) - `(gnus-add-text-properties - (point) (progn ,@form (point)) - '(gnus-face t face ,(symbol-value (intern (format "gnus-face-%d" type)))))) - -(defun gnus-balloon-face-function (form type) - `(gnus-put-text-property - (point) (progn ,@form (point)) - ,(if (fboundp 'balloon-help-mode) - ''balloon-help - ''help-echo) - ,(intern (format "gnus-balloon-face-%d" type)))) - -(defun gnus-spec-tab (column) - (if (> column 0) - `(insert-char ? (max (- ,column (current-column)) 0)) - (let ((column (abs column))) - `(if (> (current-column) ,column) - (let ((end (point))) - (if (= (move-to-column ,column) ,column) - (delete-region (point) end) - (delete-region (1- (point)) end) - (insert " "))) - (insert-char ? (max (- ,column (current-column)) 0)))))) - -(defun gnus-correct-length (string) - "Return the correct width of STRING." - (let ((length 0)) - (mapcar (lambda (char) (incf length (gnus-char-width char))) string) - length)) - -(defun gnus-correct-substring (string start &optional end) - (let ((wstart 0) - (wend 0) - (wseek 0) - (seek 0) - (length (length string)) - (string (concat string "\0"))) - ;; Find the start position. - (while (and (< seek length) - (< wseek start)) - (incf wseek (gnus-char-width (aref string seek))) - (incf seek)) - (setq wstart seek) - ;; Find the end position. - (while (and (<= seek length) - (or (not end) - (<= wseek end))) - (incf wseek (gnus-char-width (aref string seek))) - (incf seek)) - (setq wend seek) - (substring string wstart (1- wend)))) - -(defun gnus-string-width-function () - (cond - (gnus-use-correct-string-widths - 'gnus-correct-length) - ((fboundp 'string-width) - 'string-width) - (t - 'length))) - -(defun gnus-substring-function () - (cond - (gnus-use-correct-string-widths - 'gnus-correct-substring) - ((fboundp 'string-width) - 'gnus-correct-substring) - (t - 'substring))) - -(defun gnus-tilde-max-form (el max-width) - "Return a form that limits EL to MAX-WIDTH." - (let ((max (abs max-width)) - (length-fun (gnus-string-width-function)) - (substring-fun (gnus-substring-function))) - (if (symbolp el) - `(if (> (,length-fun ,el) ,max) - ,(if (< max-width 0) - `(,substring-fun ,el (- (,length-fun ,el) ,max)) - `(,substring-fun ,el 0 ,max)) - ,el) - `(let ((val (eval ,el))) - (if (> (,length-fun val) ,max) - ,(if (< max-width 0) - `(,substring-fun val (- (,length-fun val) ,max)) - `(,substring-fun val 0 ,max)) - val))))) - -(defun gnus-tilde-cut-form (el cut-width) - "Return a form that cuts CUT-WIDTH off of EL." - (let ((cut (abs cut-width)) - (length-fun (gnus-string-width-function)) - (substring-fun (gnus-substring-function))) - (if (symbolp el) - `(if (> (,length-fun ,el) ,cut) - ,(if (< cut-width 0) - `(,substring-fun ,el 0 (- (,length-fun ,el) ,cut)) - `(,substring-fun ,el ,cut)) - ,el) - `(let ((val (eval ,el))) - (if (> (,length-fun val) ,cut) - ,(if (< cut-width 0) - `(,substring-fun val 0 (- (,length-fun val) ,cut)) - `(,substring-fun val ,cut)) - val))))) - -(defun gnus-tilde-ignore-form (el ignore-value) - "Return a form that is blank when EL is IGNORE-VALUE." - (if (symbolp el) - `(if (equal ,el ,ignore-value) - "" ,el) - `(let ((val (eval ,el))) - (if (equal val ,ignore-value) - "" val)))) - -(defun gnus-pad-form (el pad-width) - "Return a form that pads EL to PAD-WIDTH accounting for multi-column -characters correctly. This is because `format' may pad to columns or to -characters when given a pad value." - (let ((pad (abs pad-width)) - (side (< 0 pad-width)) - (length-fun (gnus-string-width-function))) - (if (symbolp el) - `(let ((need (- ,pad (,length-fun ,el)))) - (if (> need 0) - (concat ,(when side '(make-string need ?\ )) - ,el - ,(when (not side) '(make-string need ?\ ))) - ,el)) - `(let* ((val (eval ,el)) - (need (- ,pad (,length-fun val)))) - (if (> need 0) - (concat ,(when side '(make-string need ?\ )) - val - ,(when (not side) '(make-string need ?\ ))) - val))))) - -(defun gnus-parse-format (format spec-alist &optional insert) - ;; This function parses the FORMAT string with the help of the - ;; SPEC-ALIST and returns a list that can be eval'ed to return the - ;; string. If the FORMAT string contains the specifiers %( and %) - ;; the text between them will have the mouse-face text property. - ;; If the FORMAT string contains the specifiers %[ and %], the text between - ;; them will have the balloon-help text property. - (let ((case-fold-search nil)) - (if (string-match - "\\`\\(.*\\)%[0-9]?[{(«]\\(.*\\)%[0-9]?[»})]\\(.*\n?\\)\\'\\|%[-0-9]*=\\|%[-0-9]*\\*" - format) - (gnus-parse-complex-format format spec-alist) - ;; This is a simple format. - (gnus-parse-simple-format format spec-alist insert)))) - -(defun gnus-parse-complex-format (format spec-alist) - (let ((cursor-spec nil)) - (save-excursion - (gnus-set-work-buffer) - (insert format) - (goto-char (point-min)) - (while (re-search-forward "\"" nil t) - (replace-match "\\\"" nil t)) - (goto-char (point-min)) - (insert "(\"") - ;; Convert all font specs into font spec lists. - (while (re-search-forward "%\\([0-9]+\\)?\\([«»{}()]\\)" nil t) - (let ((number (if (match-beginning 1) - (match-string 1) "0")) - (delim (aref (match-string 2) 0))) - (if (or (= delim ?\() - (= delim ?\{) - (= delim ?\«)) - (replace-match (concat "\"(" - (cond ((= delim ?\() "mouse") - ((= delim ?\{) "face") - (t "balloon")) - " " number " \"") - t t) - (replace-match "\")\"")))) - (goto-char (point-max)) - (insert "\")") - ;; Convert point position commands. - (goto-char (point-min)) - (let ((case-fold-search nil)) - (while (re-search-forward "%\\([-0-9]+\\)?\\*" nil t) - (replace-match "\"(point)\"" t t) - (setq cursor-spec t))) - ;; Convert TAB commands. - (goto-char (point-min)) - (while (re-search-forward "%\\([-0-9]+\\)=" nil t) - (replace-match (format "\"(tab %s)\"" (match-string 1)) t t)) - ;; Convert the buffer into the spec. - (goto-char (point-min)) - (let ((form (read (current-buffer)))) - (if cursor-spec - `(let (gnus-position) - ,@(gnus-complex-form-to-spec form spec-alist) - (if gnus-position - (gnus-put-text-property gnus-position (1+ gnus-position) - 'gnus-position t))) - `(progn - ,@(gnus-complex-form-to-spec form spec-alist))))))) - -(defun gnus-complex-form-to-spec (form spec-alist) - (delq nil - (mapcar - (lambda (sform) - (cond - ((stringp sform) - (gnus-parse-simple-format sform spec-alist t)) - ((eq (car sform) 'point) - '(setq gnus-position (point))) - ((eq (car sform) 'tab) - (gnus-spec-tab (cadr sform))) - (t - (funcall (intern (format "gnus-%s-face-function" (car sform))) - (gnus-complex-form-to-spec (cddr sform) spec-alist) - (nth 1 sform))))) - form))) - - -(defun gnus-xmas-format (fstring &rest args) - "A version of `format' which preserves text properties. - -Required for XEmacs, where the built in `format' function strips all text -properties from both the format string and any inserted strings. - -Only supports the format sequence %s, and %% for inserting -literal % characters. A pad width and an optional - (to right pad) -are supported for %s." - (let ((re "%%\\|%\\(-\\)?\\([1-9][0-9]*\\)?s") - (n (length args))) - (with-temp-buffer - (insert fstring) - (goto-char (point-min)) - (while (re-search-forward re nil t) - (goto-char (match-end 0)) - (cond - ((string= (match-string 0) "%%") - (delete-char -1)) - (t - (if (null args) - (error 'wrong-number-of-arguments #'my-format n fstring)) - (let* ((minlen (string-to-number (or (match-string 2) ""))) - (arg (car args)) - (str (if (stringp arg) arg (format "%s" arg))) - (lpad (null (match-string 1))) - (padlen (max 0 (- minlen (length str))))) - (replace-match "") - (if lpad (insert-char ?\ padlen)) - (insert str) - (unless lpad (insert-char ?\ padlen)) - (setq args (cdr args)))))) - (buffer-string)))) - -(defun gnus-parse-simple-format (format spec-alist &optional insert) - ;; This function parses the FORMAT string with the help of the - ;; SPEC-ALIST and returns a list that can be eval'ed to return a - ;; string. - (let ((max-width 0) - spec flist fstring elem result dontinsert user-defined - type value pad-width spec-beg cut-width ignore-value - tilde-form tilde elem-type extended-spec) - (save-excursion - (gnus-set-work-buffer) - (insert format) - (goto-char (point-min)) - (while (re-search-forward "%" nil t) - (setq user-defined nil - spec-beg nil - pad-width nil - max-width nil - cut-width nil - ignore-value nil - tilde-form nil - extended-spec nil) - (setq spec-beg (1- (point))) - - ;; Parse this spec fully. - (while - (cond - ((looking-at "\\([-.0-9]+\\)\\(,[-0-9]+\\)?") - (setq pad-width (string-to-number (match-string 1))) - (when (match-beginning 2) - (setq max-width (string-to-number (buffer-substring - (1+ (match-beginning 2)) - (match-end 2))))) - (goto-char (match-end 0))) - ((looking-at "~") - (forward-char 1) - (setq tilde (read (current-buffer)) - type (car tilde) - value (cadr tilde)) - (cond - ((memq type '(pad pad-left)) - (setq pad-width value)) - ((eq type 'pad-right) - (setq pad-width (- value))) - ((memq type '(max-right max)) - (setq max-width value)) - ((eq type 'max-left) - (setq max-width (- value))) - ((memq type '(cut cut-left)) - (setq cut-width value)) - ((eq type 'cut-right) - (setq cut-width (- value))) - ((eq type 'ignore) - (setq ignore-value - (if (stringp value) value (format "%s" value)))) - ((eq type 'form) - (setq tilde-form value)) - (t - (error "Unknown tilde type: %s" tilde))) - t) - (t - nil))) - (cond - ;; User-defined spec -- find the spec name. - ((eq (setq spec (char-after)) ?u) - (forward-char 1) - (when (and (eq (setq user-defined (char-after)) ?&) - (looking-at "&\\([^;]+\\);")) - (setq user-defined (match-string 1)) - (goto-char (match-end 1)))) - ;; extended spec - ((and (eq spec ?&) (looking-at "&\\([^;]+\\);")) - (setq extended-spec (intern (match-string 1))) - (goto-char (match-end 1)))) - (forward-char 1) - (delete-region spec-beg (point)) - - ;; Now we have all the relevant data on this spec, so - ;; we start doing stuff. - (insert "%") - (if (eq spec ?%) - ;; "%%" just results in a "%". - (insert "%") - (cond - ;; Do tilde forms. - ((eq spec ?@) - (setq elem (list tilde-form ?s))) - ;; Treat user defined format specifiers specially. - (user-defined - (setq elem - (list - (list (intern (format - (if (stringp user-defined) - "gnus-user-format-function-%s" - "gnus-user-format-function-%c") - user-defined)) - 'gnus-tmp-header) - ?s))) - ;; Find the specification from `spec-alist'. - ((setq elem (cdr (assq (or extended-spec spec) spec-alist)))) - (t - (setq elem '("*" ?s)))) - (setq elem-type (cadr elem)) - ;; Insert the new format elements. - (when (and pad-width - (not (and (featurep 'xemacs) - gnus-use-correct-string-widths))) - (insert (number-to-string pad-width))) - ;; Create the form to be evaled. - (if (or max-width cut-width ignore-value - (and (featurep 'xemacs) - gnus-use-correct-string-widths)) - (progn - (insert ?s) - (let ((el (car elem))) - (cond ((= (cadr elem) ?c) - (setq el (list 'char-to-string el))) - ((= (cadr elem) ?d) - (setq el (list 'int-to-string el)))) - (when ignore-value - (setq el (gnus-tilde-ignore-form el ignore-value))) - (when cut-width - (setq el (gnus-tilde-cut-form el cut-width))) - (when max-width - (setq el (gnus-tilde-max-form el max-width))) - (when pad-width - (setq el (gnus-pad-form el pad-width))) - (push el flist))) - (insert elem-type) - (push (car elem) flist)))) - (setq fstring (buffer-substring-no-properties (point-min) (point-max)))) - - ;; Do some postprocessing to increase efficiency. - (setq - result - (cond - ;; Emptiness. - ((string= fstring "") - nil) - ;; Not a format string. - ((not (string-match "%" fstring)) - (list fstring)) - ;; A format string with just a single string spec. - ((string= fstring "%s") - (list (car flist))) - ;; A single character. - ((string= fstring "%c") - (list (car flist))) - ;; A single number. - ((string= fstring "%d") - (setq dontinsert t) - (if insert - (list `(princ ,(car flist))) - (list `(int-to-string ,(car flist))))) - ;; Just lots of chars and strings. - ((string-match "\\`\\(%[cs]\\)+\\'" fstring) - (nreverse flist)) - ;; A single string spec at the beginning of the spec. - ((string-match "\\`%[sc][^%]+\\'" fstring) - (list (car flist) (substring fstring 2))) - ;; A single string spec in the middle of the spec. - ((string-match "\\`\\([^%]+\\)%[sc]\\([^%]+\\)\\'" fstring) - (list (match-string 1 fstring) (car flist) (match-string 2 fstring))) - ;; A single string spec in the end of the spec. - ((string-match "\\`\\([^%]+\\)%[sc]\\'" fstring) - (list (match-string 1 fstring) (car flist))) - ;; Only string (and %) specs (XEmacs only!) - ((and (featurep 'xemacs) - gnus-make-format-preserve-properties - (string-match - "\\`\\([^%]*\\(%%\\|%-?\\([1-9][0-9]*\\)?s\\)\\)*[^%]*\\'" - fstring)) - (list (cons 'gnus-xmas-format (cons fstring (nreverse flist))))) - ;; A more complex spec. - (t - (list (cons 'format (cons fstring (nreverse flist))))))) - - (if insert - (when result - (if dontinsert - result - (cons 'insert result))) - (cond ((stringp result) - result) - ((consp result) - (cons 'concat result)) - (t ""))))) - -(defun gnus-eval-format (format &optional alist props) - "Eval the format variable FORMAT, using ALIST. -If PROPS, insert the result." - (let ((form (gnus-parse-format format alist props))) - (if props - (gnus-add-text-properties (point) (progn (eval form) (point)) props) - (eval form)))) - -(defun gnus-compile () - "Byte-compile the user-defined format specs." - (interactive) - (require 'bytecomp) - (let ((entries gnus-format-specs) - (byte-compile-warnings '(unresolved callargs redefine)) - entry gnus-tmp-func) - (save-excursion - (gnus-message 7 "Compiling format specs...") - - (while entries - (setq entry (pop entries)) - (if (memq (car entry) '(gnus-version version)) - (setq gnus-format-specs (delq entry gnus-format-specs)) - (let ((form (caddr entry))) - (when (and (listp form) - ;; Under GNU Emacs, it's (byte-code ...) - (not (eq 'byte-code (car form))) - ;; Under XEmacs, it's (funcall #) - (not (and (eq 'funcall (car form)) - (byte-code-function-p (cadr form))))) - (defalias 'gnus-tmp-func `(lambda () ,form)) - (byte-compile 'gnus-tmp-func) - (setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func)))))) - - (push (cons 'version emacs-version) gnus-format-specs) - ;; Mark the .newsrc.eld file as "dirty". - (gnus-dribble-touch) - (gnus-message 7 "Compiling user specs...done")))) - -(defun gnus-set-format (type &optional insertable) - (set (intern (format "gnus-%s-line-format-spec" type)) - (gnus-parse-format - (symbol-value (intern (format "gnus-%s-line-format" type))) - (symbol-value (intern (format "gnus-%s-line-format-alist" type))) - insertable))) - -(provide 'gnus-spec) - -;; Local Variables: -;; coding: iso-8859-1 -;; End: - -;;; arch-tag: a4328fa1-1f84-4b09-97ad-4b5767cfd50f -;;; gnus-spec.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-srvr.el b/xemacs-packages/gnus/lisp/gnus-srvr.el deleted file mode 100644 index e5ecae7e..00000000 --- a/xemacs-packages/gnus/lisp/gnus-srvr.el +++ /dev/null @@ -1,980 +0,0 @@ -;;; gnus-srvr.el --- virtual server support for Gnus - -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) -(require 'gnus-spec) -(require 'gnus-group) -(require 'gnus-int) -(require 'gnus-range) - -(defcustom gnus-server-mode-hook nil - "Hook run in `gnus-server-mode' buffers." - :group 'gnus-server - :type 'hook) - -(defcustom gnus-server-exit-hook nil - "Hook run when exiting the server buffer." - :group 'gnus-server - :type 'hook) - -(defcustom gnus-server-line-format " {%(%h:%w%)} %s%a\n" - "Format of server lines. -It works along the same lines as a normal formatting string, -with some simple extensions. - -The following specs are understood: - -%h backend -%n name -%w address -%s status -%a agent covered - -General format specifiers can also be used. -See Info node `(gnus)Formatting Variables'." - :link '(custom-manual "(gnus)Formatting Variables") - :group 'gnus-server-visual - :type 'string) - -(defcustom gnus-server-mode-line-format "Gnus: %%b" - "The format specification for the server mode line." - :group 'gnus-server-visual - :type 'string) - -(defcustom gnus-server-browse-in-group-buffer nil - "Whether server browsing should take place in the group buffer. -If nil, a faster, but more primitive, buffer is used instead." - :version "22.1" - :group 'gnus-server-visual - :type 'boolean) - -;;; Internal variables. - -(defvar gnus-inserted-opened-servers nil) - -(defvar gnus-server-line-format-alist - `((?h gnus-tmp-how ?s) - (?n gnus-tmp-name ?s) - (?w gnus-tmp-where ?s) - (?s gnus-tmp-status ?s) - (?a gnus-tmp-agent ?s))) - -(defvar gnus-server-mode-line-format-alist - `((?S gnus-tmp-news-server ?s) - (?M gnus-tmp-news-method ?s) - (?u gnus-tmp-user-defined ?s))) - -(defvar gnus-server-line-format-spec nil) -(defvar gnus-server-mode-line-format-spec nil) -(defvar gnus-server-killed-servers nil) - -(defvar gnus-server-mode-map) - -(defvar gnus-server-menu-hook nil - "*Hook run after the creation of the server mode menu.") - -(defun gnus-server-make-menu-bar () - (gnus-turn-off-edit-menu 'server) - (unless (boundp 'gnus-server-server-menu) - (easy-menu-define - gnus-server-server-menu gnus-server-mode-map "" - '("Server" - ["Add..." gnus-server-add-server t] - ["Browse" gnus-server-read-server t] - ["Scan" gnus-server-scan-server t] - ["List" gnus-server-list-servers t] - ["Kill" gnus-server-kill-server t] - ["Yank" gnus-server-yank-server t] - ["Copy" gnus-server-copy-server t] - ["Edit" gnus-server-edit-server t] - ["Regenerate" gnus-server-regenerate-server t] - ["Exit" gnus-server-exit t])) - - (easy-menu-define - gnus-server-connections-menu gnus-server-mode-map "" - '("Connections" - ["Open" gnus-server-open-server t] - ["Close" gnus-server-close-server t] - ["Offline" gnus-server-offline-server t] - ["Deny" gnus-server-deny-server t] - "---" - ["Open All" gnus-server-open-all-servers t] - ["Close All" gnus-server-close-all-servers t] - ["Reset All" gnus-server-remove-denials t])) - - (gnus-run-hooks 'gnus-server-menu-hook))) - -(defvar gnus-server-mode-map nil) -(put 'gnus-server-mode 'mode-class 'special) - -(unless gnus-server-mode-map - (setq gnus-server-mode-map (make-sparse-keymap)) - (suppress-keymap gnus-server-mode-map) - - (gnus-define-keys gnus-server-mode-map - " " gnus-server-read-server-in-server-buffer - "\r" gnus-server-read-server - gnus-mouse-2 gnus-server-pick-server - "q" gnus-server-exit - "l" gnus-server-list-servers - "k" gnus-server-kill-server - "y" gnus-server-yank-server - "c" gnus-server-copy-server - "a" gnus-server-add-server - "e" gnus-server-edit-server - "s" gnus-server-scan-server - - "O" gnus-server-open-server - "\M-o" gnus-server-open-all-servers - "C" gnus-server-close-server - "\M-c" gnus-server-close-all-servers - "D" gnus-server-deny-server - "L" gnus-server-offline-server - "R" gnus-server-remove-denials - - "n" next-line - "p" previous-line - - "g" gnus-server-regenerate-server - - "\C-c\C-i" gnus-info-find-node - "\C-c\C-b" gnus-bug)) - -(defface gnus-server-agent - '((((class color) (background light)) (:foreground "PaleTurquoise" :bold t)) - (((class color) (background dark)) (:foreground "PaleTurquoise" :bold t)) - (t (:bold t))) - "Face used for displaying AGENTIZED servers" - :group 'gnus-server-visual) -;; backward-compatibility alias -(put 'gnus-server-agent-face 'face-alias 'gnus-server-agent) - -(defface gnus-server-opened - '((((class color) (background light)) (:foreground "Green3" :bold t)) - (((class color) (background dark)) (:foreground "Green1" :bold t)) - (t (:bold t))) - "Face used for displaying OPENED servers" - :group 'gnus-server-visual) -;; backward-compatibility alias -(put 'gnus-server-opened-face 'face-alias 'gnus-server-opened) - -(defface gnus-server-closed - '((((class color) (background light)) (:foreground "Steel Blue" :italic t)) - (((class color) (background dark)) - (:foreground "Light Steel Blue" :italic t)) - (t (:italic t))) - "Face used for displaying CLOSED servers" - :group 'gnus-server-visual) -;; backward-compatibility alias -(put 'gnus-server-closed-face 'face-alias 'gnus-server-closed) - -(defface gnus-server-denied - '((((class color) (background light)) (:foreground "Red" :bold t)) - (((class color) (background dark)) (:foreground "Pink" :bold t)) - (t (:inverse-video t :bold t))) - "Face used for displaying DENIED servers" - :group 'gnus-server-visual) -;; backward-compatibility alias -(put 'gnus-server-denied-face 'face-alias 'gnus-server-denied) - -(defface gnus-server-offline - '((((class color) (background light)) (:foreground "Orange" :bold t)) - (((class color) (background dark)) (:foreground "Yellow" :bold t)) - (t (:inverse-video t :bold t))) - "Face used for displaying OFFLINE servers" - :group 'gnus-server-visual) -;; backward-compatibility alias -(put 'gnus-server-offline-face 'face-alias 'gnus-server-offline) - -(defvar gnus-server-font-lock-keywords - '(("(\\(agent\\))" 1 'gnus-server-agent) - ("(\\(opened\\))" 1 'gnus-server-opened) - ("(\\(closed\\))" 1 'gnus-server-closed) - ("(\\(offline\\))" 1 'gnus-server-offline) - ("(\\(denied\\))" 1 'gnus-server-denied))) - -(defun gnus-server-mode () - "Major mode for listing and editing servers. - -All normal editing commands are switched off. -\\ -For more in-depth information on this mode, read the manual -\(`\\[gnus-info-find-node]'). - -The following commands are available: - -\\{gnus-server-mode-map}" - (interactive) - (when (gnus-visual-p 'server-menu 'menu) - (gnus-server-make-menu-bar)) - (kill-all-local-variables) - (gnus-simplify-mode-line) - (setq major-mode 'gnus-server-mode) - (setq mode-name "Server") - (gnus-set-default-directory) - (setq mode-line-process nil) - (use-local-map gnus-server-mode-map) - (buffer-disable-undo) - (setq truncate-lines t) - (setq buffer-read-only t) - (if (featurep 'xemacs) - (put 'gnus-server-mode 'font-lock-defaults '(gnus-server-font-lock-keywords t)) - (set (make-local-variable 'font-lock-defaults) - '(gnus-server-font-lock-keywords t))) - (gnus-run-mode-hooks 'gnus-server-mode-hook)) - -(defun gnus-server-insert-server-line (gnus-tmp-name method) - (let* ((gnus-tmp-how (car method)) - (gnus-tmp-where (nth 1 method)) - (elem (assoc method gnus-opened-servers)) - (gnus-tmp-status - (cond - ((eq (nth 1 elem) 'denied) "(denied)") - ((eq (nth 1 elem) 'offline) "(offline)") - (t - (condition-case nil - (if (or (gnus-server-opened method) - (eq (nth 1 elem) 'ok)) - "(opened)" - "(closed)") - ((error) "(error)"))))) - (gnus-tmp-agent (if (and gnus-agent - (gnus-agent-method-p method)) - " (agent)" - ""))) - (beginning-of-line) - (gnus-add-text-properties - (point) - (prog1 (1+ (point)) - ;; Insert the text. - (eval gnus-server-line-format-spec)) - (list 'gnus-server (intern gnus-tmp-name) - 'gnus-named-server (intern (gnus-method-to-server method)))))) - -(defun gnus-enter-server-buffer () - "Set up the server buffer." - (gnus-server-setup-buffer) - (gnus-configure-windows 'server) - (gnus-server-prepare)) - -(defun gnus-server-setup-buffer () - "Initialize the server buffer." - (unless (get-buffer gnus-server-buffer) - (save-excursion - (set-buffer (gnus-get-buffer-create gnus-server-buffer)) - (gnus-server-mode) - (when gnus-carpal - (gnus-carpal-setup-buffer 'server))))) - -(defun gnus-server-prepare () - (gnus-set-format 'server-mode) - (gnus-set-format 'server t) - (let ((alist gnus-server-alist) - (buffer-read-only nil) - (opened gnus-opened-servers) - done server op-ser) - (erase-buffer) - (setq gnus-inserted-opened-servers nil) - ;; First we do the real list of servers. - (while alist - (unless (member (cdar alist) done) - (push (cdar alist) done) - (setq server (pop alist)) - (when (and server (car server) (cdr server)) - (gnus-server-insert-server-line (car server) (cdr server)))) - (when (member (cdar alist) done) - (pop alist))) - ;; Then we insert the list of servers that have been opened in - ;; this session. - (while opened - (when (and (not (member (caar opened) done)) - ;; Just ignore ephemeral servers. - (not (member (caar opened) gnus-ephemeral-servers))) - (push (caar opened) done) - (gnus-server-insert-server-line - (setq op-ser (format "%s:%s" (caaar opened) (nth 1 (caar opened)))) - (caar opened)) - (push (list op-ser (caar opened)) gnus-inserted-opened-servers)) - (setq opened (cdr opened)))) - (goto-char (point-min)) - (gnus-server-position-point)) - -(defun gnus-server-server-name () - (let ((server (get-text-property (gnus-point-at-bol) 'gnus-server))) - (and server (symbol-name server)))) - -(defun gnus-server-named-server () - "Returns a server name that matches one of the names returned by -gnus-method-to-server." - (let ((server (get-text-property (gnus-point-at-bol) 'gnus-named-server))) - (and server (symbol-name server)))) - -(defalias 'gnus-server-position-point 'gnus-goto-colon) - -(defconst gnus-server-edit-buffer "*Gnus edit server*") - -(defun gnus-server-update-server (server) - (save-excursion - (set-buffer gnus-server-buffer) - (let* ((buffer-read-only nil) - (entry (assoc server gnus-server-alist)) - (oentry (assoc (gnus-server-to-method server) - gnus-opened-servers))) - (when entry - (gnus-dribble-enter - (concat "(gnus-server-set-info \"" server "\" '" - (gnus-prin1-to-string (cdr entry)) ")\n"))) - (when (or entry oentry) - ;; Buffer may be narrowed. - (save-restriction - (widen) - (when (gnus-server-goto-server server) - (gnus-delete-line)) - (if entry - (gnus-server-insert-server-line (car entry) (cdr entry)) - (gnus-server-insert-server-line - (format "%s:%s" (caar oentry) (nth 1 (car oentry))) - (car oentry))) - (gnus-server-position-point)))))) - -(defun gnus-server-set-info (server info) - ;; Enter a select method into the virtual server alist. - (when (and server info) - (gnus-dribble-enter - (concat "(gnus-server-set-info \"" server "\" '" - (gnus-prin1-to-string info) ")")) - (let* ((server (nth 1 info)) - (entry (assoc server gnus-server-alist)) - (cached (assoc server gnus-server-method-cache))) - (if cached - (setq gnus-server-method-cache - (delq cached gnus-server-method-cache))) - (if entry (setcdr entry info) - (setq gnus-server-alist - (nconc gnus-server-alist (list (cons server info)))))))) - -;;; Interactive server functions. - -(defun gnus-server-kill-server (server) - "Kill the server on the current line." - (interactive (list (gnus-server-server-name))) - (unless (gnus-server-goto-server server) - (if server (error "No such server: %s" server) - (error "No server on the current line"))) - (unless (assoc server gnus-server-alist) - (error "Read-only server %s" server)) - (gnus-dribble-touch) - (let ((buffer-read-only nil)) - (gnus-delete-line)) - (push (assoc server gnus-server-alist) gnus-server-killed-servers) - (setq gnus-server-alist (delq (car gnus-server-killed-servers) - gnus-server-alist)) - (let ((groups (gnus-groups-from-server server))) - (when (and groups - (gnus-yes-or-no-p - (format "Kill all %s groups from this server? " - (length groups)))) - (dolist (group groups) - (setq gnus-newsrc-alist - (delq (assoc group gnus-newsrc-alist) - gnus-newsrc-alist)) - (when gnus-group-change-level-function - (funcall gnus-group-change-level-function - group gnus-level-killed 3))))) - (gnus-server-position-point)) - -(defun gnus-server-yank-server () - "Yank the previously killed server." - (interactive) - (unless gnus-server-killed-servers - (error "No killed servers to be yanked")) - (let ((alist gnus-server-alist) - (server (gnus-server-server-name)) - (killed (car gnus-server-killed-servers))) - (if (not server) - (setq gnus-server-alist (nconc gnus-server-alist (list killed))) - (if (string= server (caar gnus-server-alist)) - (push killed gnus-server-alist) - (while (and (cdr alist) - (not (string= server (caadr alist)))) - (setq alist (cdr alist))) - (if alist - (setcdr alist (cons killed (cdr alist))) - (setq gnus-server-alist (list killed))))) - (gnus-server-update-server (car killed)) - (setq gnus-server-killed-servers (cdr gnus-server-killed-servers)) - (gnus-server-position-point))) - -(defun gnus-server-exit () - "Return to the group buffer." - (interactive) - (gnus-run-hooks 'gnus-server-exit-hook) - (gnus-kill-buffer (current-buffer)) - (gnus-configure-windows 'group t)) - -(defun gnus-server-list-servers () - "List all available servers." - (interactive) - (let ((cur (gnus-server-server-name))) - (gnus-server-prepare) - (if cur (gnus-server-goto-server cur) - (goto-char (point-max)) - (forward-line -1)) - (gnus-server-position-point))) - -(defun gnus-server-set-status (method status) - "Make METHOD have STATUS." - (let ((entry (assoc method gnus-opened-servers))) - (if entry - (setcar (cdr entry) status) - (push (list method status) gnus-opened-servers)))) - -(defun gnus-opened-servers-remove (method) - "Remove METHOD from the list of opened servers." - (setq gnus-opened-servers (delq (assoc method gnus-opened-servers) - gnus-opened-servers))) - -(defun gnus-server-open-server (server) - "Force an open of SERVER." - (interactive (list (gnus-server-server-name))) - (let ((method (gnus-server-to-method server))) - (unless method - (error "No such server: %s" server)) - (gnus-server-set-status method 'ok) - (prog1 - (or (gnus-open-server method) - (progn (message "Couldn't open %s" server) nil)) - (gnus-server-update-server server) - (gnus-server-position-point)))) - -(defun gnus-server-open-all-servers () - "Open all servers." - (interactive) - (let ((servers gnus-inserted-opened-servers)) - (while servers - (gnus-server-open-server (car (pop servers)))))) - -(defun gnus-server-close-server (server) - "Close SERVER." - (interactive (list (gnus-server-server-name))) - (let ((method (gnus-server-to-method server))) - (unless method - (error "No such server: %s" server)) - (gnus-server-set-status method 'closed) - (prog1 - (gnus-close-server method) - (gnus-server-update-server server) - (gnus-server-position-point)))) - -(defun gnus-server-offline-server (server) - "Set SERVER to offline." - (interactive (list (gnus-server-server-name))) - (let ((method (gnus-server-to-method server))) - (unless method - (error "No such server: %s" server)) - (prog1 - (gnus-close-server method) - (gnus-server-set-status method 'offline) - (gnus-server-update-server server) - (gnus-server-position-point)))) - -(defun gnus-server-close-all-servers () - "Close all servers." - (interactive) - (dolist (server gnus-inserted-opened-servers) - (gnus-server-close-server (car server)))) - -(defun gnus-server-deny-server (server) - "Make sure SERVER will never be attempted opened." - (interactive (list (gnus-server-server-name))) - (let ((method (gnus-server-to-method server))) - (unless method - (error "No such server: %s" server)) - (gnus-server-set-status method 'denied)) - (gnus-server-update-server server) - (gnus-server-position-point) - t) - -(defun gnus-server-remove-denials () - "Make all denied servers into closed servers." - (interactive) - (dolist (server gnus-opened-servers) - (when (eq (nth 1 server) 'denied) - (setcar (nthcdr 1 server) 'closed))) - (gnus-server-list-servers)) - -(defun gnus-server-copy-server (from to) - (interactive - (list - (or (gnus-server-server-name) - (error "No server on the current line")) - (read-string "Copy to: "))) - (unless from - (error "No server on current line")) - (unless (and to (not (string= to ""))) - (error "No name to copy to")) - (when (assoc to gnus-server-alist) - (error "%s already exists" to)) - (unless (gnus-server-to-method from) - (error "%s: no such server" from)) - (let ((to-entry (cons from (gnus-copy-sequence - (gnus-server-to-method from))))) - (setcar to-entry to) - (setcar (nthcdr 2 to-entry) to) - (push to-entry gnus-server-killed-servers) - (gnus-server-yank-server))) - -(defun gnus-server-add-server (how where) - (interactive - (list (intern (completing-read "Server method: " - gnus-valid-select-methods nil t)) - (read-string "Server name: "))) - (when (assq where gnus-server-alist) - (error "Server with that name already defined")) - (push (list where how where) gnus-server-killed-servers) - (gnus-server-yank-server)) - -(defun gnus-server-goto-server (server) - "Jump to a server line." - (interactive - (list (completing-read "Goto server: " gnus-server-alist nil t))) - (let ((to (text-property-any (point-min) (point-max) - 'gnus-server (intern server)))) - (when to - (goto-char to) - (gnus-server-position-point)))) - -(defun gnus-server-edit-server (server) - "Edit the server on the current line." - (interactive (list (gnus-server-server-name))) - (unless server - (error "No server on current line")) - (unless (assoc server gnus-server-alist) - (error "This server can't be edited")) - (let ((info (cdr (assoc server gnus-server-alist)))) - (gnus-close-server info) - (gnus-edit-form - info "Editing the server." - `(lambda (form) - (gnus-server-set-info ,server form) - (gnus-server-list-servers) - (gnus-server-position-point))))) - -(defun gnus-server-scan-server (server) - "Request a scan from the current server." - (interactive (list (gnus-server-server-name))) - (let ((method (gnus-server-to-method server))) - (if (not (gnus-get-function method 'request-scan)) - (error "Server %s can't scan" (car method)) - (gnus-message 3 "Scanning %s..." server) - (gnus-request-scan nil method) - (gnus-message 3 "Scanning %s...done" server)))) - -(defun gnus-server-read-server-in-server-buffer (server) - "Browse a server in server buffer." - (interactive (list (gnus-server-server-name))) - (let (gnus-server-browse-in-group-buffer) - (gnus-server-read-server server))) - -(defun gnus-server-read-server (server) - "Browse a server." - (interactive (list (gnus-server-server-name))) - (let ((buf (current-buffer))) - (prog1 - (gnus-browse-foreign-server server buf) - (save-excursion - (set-buffer buf) - (gnus-server-update-server (gnus-server-server-name)) - (gnus-server-position-point))))) - -(defun gnus-server-pick-server (e) - (interactive "e") - (mouse-set-point e) - (gnus-server-read-server (gnus-server-server-name))) - - -;;; -;;; Browse Server Mode -;;; - -(defvar gnus-browse-menu-hook nil - "*Hook run after the creation of the browse mode menu.") - -(defvar gnus-browse-mode-hook nil) -(defvar gnus-browse-mode-map nil) -(put 'gnus-browse-mode 'mode-class 'special) - -(unless gnus-browse-mode-map - (setq gnus-browse-mode-map (make-keymap)) - (suppress-keymap gnus-browse-mode-map) - - (gnus-define-keys - gnus-browse-mode-map - " " gnus-browse-read-group - "=" gnus-browse-select-group - "n" gnus-browse-next-group - "p" gnus-browse-prev-group - "\177" gnus-browse-prev-group - [delete] gnus-browse-prev-group - "N" gnus-browse-next-group - "P" gnus-browse-prev-group - "\M-n" gnus-browse-next-group - "\M-p" gnus-browse-prev-group - "\r" gnus-browse-select-group - "u" gnus-browse-unsubscribe-current-group - "l" gnus-browse-exit - "L" gnus-browse-exit - "q" gnus-browse-exit - "Q" gnus-browse-exit - "d" gnus-browse-describe-group - "\C-c\C-c" gnus-browse-exit - "?" gnus-browse-describe-briefly - - "\C-c\C-i" gnus-info-find-node - "\C-c\C-b" gnus-bug)) - -(defun gnus-browse-make-menu-bar () - (gnus-turn-off-edit-menu 'browse) - (unless (boundp 'gnus-browse-menu) - (easy-menu-define - gnus-browse-menu gnus-browse-mode-map "" - '("Browse" - ["Subscribe" gnus-browse-unsubscribe-current-group t] - ["Read" gnus-browse-read-group t] - ["Select" gnus-browse-select-group t] - ["Describe" gnus-browse-describe-group t] - ["Next" gnus-browse-next-group t] - ["Prev" gnus-browse-prev-group t] - ["Exit" gnus-browse-exit t])) - (gnus-run-hooks 'gnus-browse-menu-hook))) - -(defvar gnus-browse-current-method nil) -(defvar gnus-browse-return-buffer nil) - -(defvar gnus-browse-buffer "*Gnus Browse Server*") - -(defun gnus-browse-foreign-server (server &optional return-buffer) - "Browse the server SERVER." - (setq gnus-browse-current-method (gnus-server-to-method server)) - (setq gnus-browse-return-buffer return-buffer) - (let* ((method gnus-browse-current-method) - (orig-select-method gnus-select-method) - (gnus-select-method method) - groups group) - (gnus-message 5 "Connecting to %s..." (nth 1 method)) - (cond - ((not (gnus-check-server method)) - (gnus-message - 1 "Unable to contact server %s: %s" (nth 1 method) - (gnus-status-message method)) - nil) - ((not - (prog2 - (gnus-message 6 "Reading active file...") - (gnus-request-list method) - (gnus-message 6 "Reading active file...done"))) - (gnus-message - 1 "Couldn't request list: %s" (gnus-status-message method)) - nil) - (t - (with-current-buffer nntp-server-buffer - (let ((cur (current-buffer))) - (goto-char (point-min)) - (unless (string= gnus-ignored-newsgroups "") - (delete-matching-lines gnus-ignored-newsgroups)) - ;; We treat NNTP as a special case to avoid problems with - ;; garbage group names like `"foo' that appear in some badly - ;; managed active files. -jh. - (if (eq (car method) 'nntp) - (while (not (eobp)) - (ignore-errors - (push (cons - (buffer-substring - (point) - (progn - (skip-chars-forward "^ \t") - (point))) - (let ((last (read cur))) - (cons (read cur) last))) - groups)) - (forward-line)) - (while (not (eobp)) - (ignore-errors - (push (cons - (if (eq (char-after) ?\") - (read cur) - (let ((p (point)) (name "")) - (skip-chars-forward "^ \t\\\\") - (setq name (buffer-substring p (point))) - (while (eq (char-after) ?\\) - (setq p (1+ (point))) - (forward-char 2) - (skip-chars-forward "^ \t\\\\") - (setq name (concat name (buffer-substring - p (point))))) - name)) - (let ((last (read cur))) - (cons (read cur) last))) - groups)) - (forward-line))))) - (setq groups (sort groups - (lambda (l1 l2) - (string< (car l1) (car l2))))) - (if gnus-server-browse-in-group-buffer - (let* ((gnus-select-method orig-select-method) - (gnus-group-listed-groups - (mapcar (lambda (group) - (let ((name - (gnus-group-prefixed-name - (car group) method))) - (gnus-set-active name (cdr group)) - name)) - groups))) - (gnus-configure-windows 'group) - (funcall gnus-group-prepare-function - gnus-level-killed 'ignore 1 'ignore)) - (gnus-get-buffer-create gnus-browse-buffer) - (when gnus-carpal - (gnus-carpal-setup-buffer 'browse)) - (gnus-configure-windows 'browse) - (buffer-disable-undo) - (let ((buffer-read-only nil)) - (erase-buffer)) - (gnus-browse-mode) - (setq mode-line-buffer-identification - (list - (format - "Gnus: %%b {%s:%s}" (car method) (cadr method)))) - (let ((buffer-read-only nil) - name - (prefix (let ((gnus-select-method orig-select-method)) - (gnus-group-prefixed-name "" method)))) - (while (setq group (pop groups)) - (gnus-add-text-properties - (point) - (prog1 (1+ (point)) - (insert - (format "%c%7d: %s\n" - (let ((level (gnus-group-level - (concat prefix (setq name (car group)))))) - (cond - ((<= level gnus-level-subscribed) ? ) - ((<= level gnus-level-unsubscribed) ?U) - ((= level gnus-level-zombie) ?Z) - (t ?K))) - (max 0 (- (1+ (cddr group)) (cadr group))) - (mm-decode-coding-string - name - (inline (gnus-group-name-charset method name)))))) - (list 'gnus-group name)))) - (switch-to-buffer (current-buffer))) - (goto-char (point-min)) - (gnus-group-position-point) - (gnus-message 5 "Connecting to %s...done" (nth 1 method)) - t)))) - -(defun gnus-browse-mode () - "Major mode for browsing a foreign server. - -All normal editing commands are switched off. - -\\ -The only things you can do in this buffer is - -1) `\\[gnus-browse-unsubscribe-current-group]' to subscribe to a group. -The group will be inserted into the group buffer upon exit from this -buffer. - -2) `\\[gnus-browse-read-group]' to read a group ephemerally. - -3) `\\[gnus-browse-exit]' to return to the group buffer." - (interactive) - (kill-all-local-variables) - (when (gnus-visual-p 'browse-menu 'menu) - (gnus-browse-make-menu-bar)) - (gnus-simplify-mode-line) - (setq major-mode 'gnus-browse-mode) - (setq mode-name "Browse Server") - (setq mode-line-process nil) - (use-local-map gnus-browse-mode-map) - (buffer-disable-undo) - (setq truncate-lines t) - (gnus-set-default-directory) - (setq buffer-read-only t) - (gnus-run-mode-hooks 'gnus-browse-mode-hook)) - -(defun gnus-browse-read-group (&optional no-article number) - "Enter the group at the current line. -If NUMBER, fetch this number of articles." - (interactive "P") - (let ((group (gnus-browse-group-name))) - (if (or (not (gnus-get-info group)) - (gnus-ephemeral-group-p group)) - (unless (gnus-group-read-ephemeral-group - group gnus-browse-current-method nil - (cons (current-buffer) 'browse) - nil nil nil number) - (error "Couldn't enter %s" group)) - (unless (gnus-group-read-group nil no-article group) - (error "Couldn't enter %s" group))))) - -(defun gnus-browse-select-group (&optional number) - "Select the current group. -If NUMBER, fetch this number of articles." - (interactive "P") - (gnus-browse-read-group 'no number)) - -(defun gnus-browse-next-group (n) - "Go to the next group." - (interactive "p") - (prog1 - (forward-line n) - (gnus-group-position-point))) - -(defun gnus-browse-prev-group (n) - "Go to the next group." - (interactive "p") - (gnus-browse-next-group (- n))) - -(defun gnus-browse-unsubscribe-current-group (arg) - "(Un)subscribe to the next ARG groups." - (interactive "p") - (when (eobp) - (error "No group at current line")) - (let ((ward (if (< arg 0) -1 1)) - (arg (abs arg))) - (while (and (> arg 0) - (not (eobp)) - (gnus-browse-unsubscribe-group) - (zerop (gnus-browse-next-group ward))) - (decf arg)) - (gnus-group-position-point) - (when (/= 0 arg) - (gnus-message 7 "No more newsgroups")) - arg)) - -(defun gnus-browse-group-name () - (save-excursion - (beginning-of-line) - (let ((name (get-text-property (point) 'gnus-group))) - (when (re-search-forward ": \\(.*\\)$" (gnus-point-at-eol) t) - (concat (gnus-method-to-server-name gnus-browse-current-method) ":" - (or name - (match-string-no-properties 1))))))) - -(defun gnus-browse-describe-group (group) - "Describe the current group." - (interactive (list (gnus-browse-group-name))) - (gnus-group-describe-group nil group)) - -(defun gnus-browse-unsubscribe-group () - "Toggle subscription of the current group in the browse buffer." - (let ((sub nil) - (buffer-read-only nil) - group) - (save-excursion - (beginning-of-line) - ;; If this group it killed, then we want to subscribe it. - (unless (eq (char-after) ? ) - (setq sub t)) - (setq group (gnus-browse-group-name)) - (when (gnus-server-equal gnus-browse-current-method "native") - (setq group (gnus-group-real-name group))) - (if sub - (progn - ;; Make sure the group has been properly removed before we - ;; subscribe to it. - (if (gnus-ephemeral-group-p group) - (gnus-kill-ephemeral-group group)) - ;; We need to discern between killed/zombie groups and - ;; just unsubscribed ones. - (gnus-group-change-level - (or (gnus-group-entry group) - (list t group gnus-level-default-subscribed - nil nil (if (gnus-server-equal - gnus-browse-current-method "native") - nil - (gnus-method-simplify - gnus-browse-current-method)))) - gnus-level-default-subscribed (gnus-group-level group) - (and (car (nth 1 gnus-newsrc-alist)) - (gnus-gethash (car (nth 1 gnus-newsrc-alist)) - gnus-newsrc-hashtb)) - (null (gnus-group-entry group))) - (delete-char 1) - (insert ? )) - (gnus-group-change-level - group gnus-level-unsubscribed gnus-level-default-subscribed) - (delete-char 1) - (insert ?U))) - t)) - -(defun gnus-browse-exit () - "Quit browsing and return to the group buffer." - (interactive) - (when (eq major-mode 'gnus-browse-mode) - (gnus-kill-buffer (current-buffer))) - ;; Insert the newly subscribed groups in the group buffer. - (save-excursion - (set-buffer gnus-group-buffer) - (gnus-group-list-groups nil)) - (if gnus-browse-return-buffer - (gnus-configure-windows 'server 'force) - (gnus-configure-windows 'group 'force))) - -(defun gnus-browse-describe-briefly () - "Give a one line description of the group mode commands." - (interactive) - (gnus-message 6 - (substitute-command-keys "\\\\[gnus-group-next-group]:Forward \\[gnus-group-prev-group]:Backward \\[gnus-browse-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-browse-describe-briefly]:This help"))) - -(defun gnus-server-regenerate-server () - "Issue a command to the server to regenerate all its data structures." - (interactive) - (let ((server (gnus-server-server-name))) - (unless server - (error "No server on the current line")) - (condition-case () - (gnus-get-function (gnus-server-to-method server) - 'request-regenerate) - (error - (error "This backend doesn't support regeneration"))) - (gnus-message 5 "Requesting regeneration of %s..." server) - (unless (gnus-open-server server) - (error "Couldn't open server")) - (if (gnus-request-regenerate server) - (gnus-message 5 "Requesting regeneration of %s...done" server) - (gnus-message 5 "Couldn't regenerate %s" server)))) - -(provide 'gnus-srvr) - -;;; arch-tag: c0117f64-27ca-475d-9406-8da6854c7a25 -;;; gnus-srvr.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-start.el b/xemacs-packages/gnus/lisp/gnus-start.el deleted file mode 100644 index 572658d3..00000000 --- a/xemacs-packages/gnus/lisp/gnus-start.el +++ /dev/null @@ -1,3126 +0,0 @@ -;;; gnus-start.el --- startup functions for Gnus - -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) -(require 'gnus-win) -(require 'gnus-int) -(require 'gnus-spec) -(require 'gnus-range) -(require 'gnus-util) -(autoload 'message-make-date "message") -(autoload 'gnus-agent-read-servers-validate "gnus-agent") -(autoload 'gnus-agent-save-local "gnus-agent") -(autoload 'gnus-agent-possibly-alter-active "gnus-agent") - -(eval-when-compile - (require 'cl) - - (defvar gnus-agent-covered-methods nil) - (defvar gnus-agent-file-loading-local nil) - (defvar gnus-agent-file-loading-cache nil)) - -(defcustom gnus-startup-file (nnheader-concat gnus-home-directory ".newsrc") - "Your `.newsrc' file. -`.newsrc-SERVER' will be used instead if that exists." - :group 'gnus-start - :type 'file) - -(defcustom gnus-backup-startup-file 'never - "Whether to create backup files. -This variable takes the same values as the `version-control' -variable." - :version "22.1" - :group 'gnus-start - :type '(choice (const :tag "Never" never) - (const :tag "If existing" nil) - (other :tag "Always" t))) - -(defcustom gnus-save-startup-file-via-temp-buffer t - "Whether to write the startup file contents to a buffer then save -the buffer or write directly to the file. The buffer is faster -because all of the contents are written at once. The direct write -uses considerably less memory." - :version "22.1" - :group 'gnus-start - :type '(choice (const :tag "Write via buffer" t) - (const :tag "Write directly to file" nil))) - -(defcustom gnus-init-file (nnheader-concat gnus-home-directory ".gnus") - "Your Gnus Emacs-Lisp startup file name. -If a file with the `.el' or `.elc' suffixes exists, it will be read instead." - :group 'gnus-start - :type 'file) - -(defcustom gnus-site-init-file - (condition-case nil - (concat (file-name-directory - (directory-file-name installation-directory)) - "site-lisp/gnus-init") - (error nil)) - "The site-wide Gnus Emacs-Lisp startup file name, or nil if none. -If a file with the `.el' or `.elc' suffixes exists, it will be read instead." - :group 'gnus-start - :type '(choice file (const nil))) - -(defcustom gnus-default-subscribed-newsgroups nil - "List of newsgroups to subscribe, when a user runs Gnus the first time. -The value should be a list of strings. -If it is t, Gnus will not do anything special the first time it is -started; it'll just use the normal newsgroups subscription methods." - :group 'gnus-start - :type '(choice (repeat string) (const :tag "Nothing special" t))) - -(defcustom gnus-use-dribble-file t - "*Non-nil means that Gnus will use a dribble file to store user updates. -If Emacs should crash without saving the .newsrc files, complete -information can be restored from the dribble file." - :group 'gnus-dribble-file - :type 'boolean) - -(defcustom gnus-dribble-directory nil - "*The directory where dribble files will be saved. -If this variable is nil, the directory where the .newsrc files are -saved will be used." - :group 'gnus-dribble-file - :type '(choice directory (const nil))) - -(defcustom gnus-check-new-newsgroups 'ask-server - "*Non-nil means that Gnus will run `gnus-find-new-newsgroups' at startup. -This normally finds new newsgroups by comparing the active groups the -servers have already reported with those Gnus already knows, either alive -or killed. - -When any of the following are true, `gnus-find-new-newsgroups' will instead -ask the servers (primary, secondary, and archive servers) to list new -groups since the last time it checked: - 1. This variable is `ask-server'. - 2. This variable is a list of select methods (see below). - 3. `gnus-read-active-file' is nil or `some'. - 4. A prefix argument is given to `gnus-find-new-newsgroups' interactively. - -Thus, if this variable is `ask-server' or a list of select methods or -`gnus-read-active-file' is nil or `some', then the killed list is no -longer necessary, so you could safely set `gnus-save-killed-list' to nil. - -This variable can be a list of select methods which Gnus will query with -the `ask-server' method in addition to the primary, secondary, and archive -servers. - -Eg. - (setq gnus-check-new-newsgroups - '((nntp \"some.server\") (nntp \"other.server\"))) - -If this variable is nil, then you have to tell Gnus explicitly to -check for new newsgroups with \\\\[gnus-find-new-newsgroups]." - :group 'gnus-start - :type '(choice (const :tag "no" nil) - (const :tag "by brute force" t) - (const :tag "ask servers" ask-server) - (repeat :menu-tag "ask additional servers" - :tag "ask additional servers" - :value ((nntp "")) - (sexp :format "%v")))) - -(defcustom gnus-check-bogus-newsgroups nil - "*Non-nil means that Gnus will check and remove bogus newsgroup at startup. -If this variable is nil, then you have to tell Gnus explicitly to -check for bogus newsgroups with \\\\[gnus-group-check-bogus-groups]." - :group 'gnus-start-server - :type 'boolean) - -(defcustom gnus-read-active-file 'some - "*Non-nil means that Gnus will read the entire active file at startup. -If this variable is nil, Gnus will only know about the groups in your -`.newsrc' file. - -If this variable is `some', Gnus will try to only read the relevant -parts of the active file from the server. Not all servers support -this, and it might be quite slow with other servers, but this should -generally be faster than both the t and nil value. - -If you set this variable to nil or `some', you probably still want to -be told about new newsgroups that arrive. To do that, set -`gnus-check-new-newsgroups' to `ask-server'. This may not work -properly with all servers." - :group 'gnus-start-server - :type '(choice (const nil) - (const some) - (const t))) - -(defconst gnus-level-subscribed 5 - "Groups with levels less than or equal to this variable are subscribed.") - -(defconst gnus-level-unsubscribed 7 - "Groups with levels less than or equal to this variable are unsubscribed. - -Groups with levels less than `gnus-level-subscribed', which -should be less than this variable, are subscribed. Groups with -levels from `gnus-level-subscribed' (exclusive) upto this -variable (inclusive) are unsubscribed. See also -`gnus-level-zombie', `gnus-level-killed' and the Info node `Group -Levels' for details.") - -(defconst gnus-level-zombie 8 - "Groups with this level are zombie groups.") - -(defconst gnus-level-killed 9 - "Groups with this level are killed.") - -(defcustom gnus-level-default-subscribed 3 - "*New subscribed groups will be subscribed at this level." - :group 'gnus-group-levels - :type 'integer) - -(defcustom gnus-level-default-unsubscribed 6 - "*New unsubscribed groups will be unsubscribed at this level." - :group 'gnus-group-levels - :type 'integer) - -(defcustom gnus-activate-level (1+ gnus-level-subscribed) - "*Groups higher than this level won't be activated on startup. -Setting this variable to something low might save lots of time when -you have many groups that you aren't interested in." - :group 'gnus-group-levels - :type 'integer) - -(defcustom gnus-activate-foreign-newsgroups 4 - "*If nil, Gnus will not check foreign newsgroups at startup. -If it is non-nil, it should be a number between one and nine. Foreign -newsgroups that have a level lower or equal to this number will be -activated on startup. For instance, if you want to active all -subscribed newsgroups, but not the rest, you'd set this variable to -`gnus-level-subscribed'. - -If you subscribe to lots of newsgroups from different servers, startup -might take a while. By setting this variable to nil, you'll save time, -but you won't be told how many unread articles there are in the -groups." - :group 'gnus-group-levels - :type '(choice integer - (const :tag "none" nil))) - -(defcustom gnus-read-newsrc-file t - "*Non-nil means that Gnus will read the `.newsrc' file. -Gnus always reads its own startup file, which is called -\".newsrc.eld\". The file called \".newsrc\" is in a format that can -be readily understood by other newsreaders. If you don't plan on -using other newsreaders, set this variable to nil to save some time on -entry." - :version "21.1" - :group 'gnus-newsrc - :type 'boolean) - -(defcustom gnus-save-newsrc-file t - "*Non-nil means that Gnus will save the `.newsrc' file. -Gnus always saves its own startup file, which is called -\".newsrc.eld\". The file called \".newsrc\" is in a format that can -be readily understood by other newsreaders. If you don't plan on -using other newsreaders, set this variable to nil to save some time on -exit." - :group 'gnus-newsrc - :type 'boolean) - -(defcustom gnus-save-killed-list t - "*If non-nil, save the list of killed groups to the startup file. -If you set this variable to nil, you'll save both time (when starting -and quitting) and space (both memory and disk), but it will also mean -that Gnus has no record of which groups are new and which are old, so -the automatic new newsgroups subscription methods become meaningless. - -You should always set `gnus-check-new-newsgroups' to `ask-server' or -nil if you set this variable to nil. - -This variable can also be a regexp. In that case, all groups that do -not match this regexp will be removed before saving the list." - :group 'gnus-newsrc - :type '(radio (sexp :format "Non-nil\n" - :match (lambda (widget value) - (and value (not (stringp value)))) - :value t) - (const nil) - regexp)) - -(defcustom gnus-ignored-newsgroups - (mapconcat 'identity - '("^to\\." ; not "real" groups - "^[0-9. \t]+\\( \\|$\\)" ; all digits in name - "^[\"][]\"[#'()]" ; bogus characters - ) - "\\|") - "*A regexp to match uninteresting newsgroups in the active file. -Any lines in the active file matching this regular expression are -removed from the newsgroup list before anything else is done to it, -thus making them effectively non-existent." - :group 'gnus-group-new - :type 'regexp) - -(defcustom gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies - "*Function(s) called with a group name when new group is detected. -A few pre-made functions are supplied: `gnus-subscribe-randomly' -inserts new groups at the beginning of the list of groups; -`gnus-subscribe-alphabetically' inserts new groups in strict -alphabetic order; `gnus-subscribe-hierarchically' inserts new groups -in hierarchical newsgroup order; `gnus-subscribe-interactively' asks -for your decision; `gnus-subscribe-killed' kills all new groups; -`gnus-subscribe-zombies' will make all new groups into zombies; -`gnus-subscribe-topics' will enter groups into the topics that -claim them." - :group 'gnus-group-new - :type '(radio (function-item gnus-subscribe-randomly) - (function-item gnus-subscribe-alphabetically) - (function-item gnus-subscribe-hierarchically) - (function-item gnus-subscribe-interactively) - (function-item gnus-subscribe-killed) - (function-item gnus-subscribe-zombies) - (function-item gnus-subscribe-topics) - function - (repeat function))) - -(defcustom gnus-subscribe-newsgroup-hooks nil - "*Hooks run after you subscribe to a new group. -The hooks will be called with new group's name as argument." - :version "22.1" - :group 'gnus-group-new - :type 'hook) - -(defcustom gnus-subscribe-options-newsgroup-method - 'gnus-subscribe-alphabetically - "*Function(s) called to subscribe newsgroups mentioned on \"options -n\" lines. -If, for instance, you want to subscribe to all newsgroups in the -\"no\" and \"alt\" hierarchies, you'd put the following in your -.newsrc file: - -options -n no.all alt.all - -Gnus will then subscribe all new newsgroups in these hierarchies -with the subscription method in this variable." - :group 'gnus-group-new - :type '(radio (function-item gnus-subscribe-randomly) - (function-item gnus-subscribe-alphabetically) - (function-item gnus-subscribe-hierarchically) - (function-item gnus-subscribe-interactively) - (function-item gnus-subscribe-killed) - (function-item gnus-subscribe-zombies) - (function-item gnus-subscribe-topics) - function - (repeat function))) - -(defcustom gnus-subscribe-hierarchical-interactive nil - "*If non-nil, Gnus will offer to subscribe hierarchically. -When a new hierarchy appears, Gnus will ask the user: - -'alt.binaries': Do you want to subscribe to this hierarchy? ([d]ys): - -If the user pressed `d', Gnus will descend the hierarchy, `y' will -subscribe to all newsgroups in the hierarchy and `s' will skip this -hierarchy in its entirety." - :group 'gnus-group-new - :type 'boolean) - -(defcustom gnus-auto-subscribed-groups - "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl\\|^nnmaildir" - "*All new groups that match this regexp will be subscribed automatically. -Note that this variable only deals with new groups. It has no effect -whatsoever on old groups. - -New groups that match this regexp will not be handled by -`gnus-subscribe-newsgroup-method'. Instead, they will -be subscribed using `gnus-subscribe-options-newsgroup-method'." - :group 'gnus-group-new - :type 'regexp) - -(defcustom gnus-options-subscribe nil - "*All new groups matching this regexp will be subscribed unconditionally. -Note that this variable deals only with new newsgroups. This variable -does not affect old newsgroups. - -New groups that match this regexp will not be handled by -`gnus-subscribe-newsgroup-method'. Instead, they will -be subscribed using `gnus-subscribe-options-newsgroup-method'." - :group 'gnus-group-new - :type '(choice regexp - (const :tag "none" nil))) - -(defcustom gnus-options-not-subscribe nil - "*All new groups matching this regexp will be ignored. -Note that this variable deals only with new newsgroups. This variable -does not affect old (already subscribed) newsgroups." - :group 'gnus-group-new - :type '(choice regexp - (const :tag "none" nil))) - -(defcustom gnus-modtime-botch nil - "*Non-nil means .newsrc should be deleted prior to save. -Its use is due to the bogus appearance that .newsrc was modified on -disc." - :group 'gnus-newsrc - :type 'boolean) - -(defcustom gnus-check-bogus-groups-hook nil - "A hook run after removing bogus groups." - :group 'gnus-start-server - :type 'hook) - -(defcustom gnus-startup-hook nil - "A hook called at startup. -This hook is called after Gnus is connected to the NNTP server." - :group 'gnus-start - :type 'hook) - -(defcustom gnus-before-startup-hook nil - "A hook called at before startup. -This hook is called as the first thing when Gnus is started." - :group 'gnus-start - :type 'hook) - -(defcustom gnus-started-hook nil - "A hook called as the last thing after startup." - :group 'gnus-start - :type 'hook) - -(defcustom gnus-setup-news-hook - '(gnus-fixup-nnimap-unread-after-getting-new-news) - "A hook after reading the .newsrc file, but before generating the buffer." - :group 'gnus-start - :type 'hook) - -(defcustom gnus-get-top-new-news-hook nil - "A hook run just before Gnus checks for new news globally." - :version "22.1" - :group 'gnus-group-new - :type 'hook) - -(defcustom gnus-get-new-news-hook nil - "A hook run just before Gnus checks for new news." - :group 'gnus-group-new - :type 'hook) - -(defcustom gnus-after-getting-new-news-hook - '(gnus-display-time-event-handler - gnus-fixup-nnimap-unread-after-getting-new-news) - "*A hook run after Gnus checks for new news when Gnus is already running." - :group 'gnus-group-new - :type 'hook) - -(defcustom gnus-read-newsrc-el-hook nil - "A hook called after reading the newsrc.eld? file." - :group 'gnus-newsrc - :type 'hook) - -(defcustom gnus-save-newsrc-hook nil - "A hook called before saving any of the newsrc files." - :group 'gnus-newsrc - :type 'hook) - -(defcustom gnus-save-quick-newsrc-hook nil - "A hook called just before saving the quick newsrc file. -Can be used to turn version control on or off." - :group 'gnus-newsrc - :type 'hook) - -(defcustom gnus-save-standard-newsrc-hook nil - "A hook called just before saving the standard newsrc file. -Can be used to turn version control on or off." - :group 'gnus-newsrc - :type 'hook) - -(defcustom gnus-group-mode-hook nil - "Hook for Gnus group mode." - :group 'gnus-group-various - :options '(gnus-topic-mode) - :type 'hook) - -(defcustom gnus-always-read-dribble-file nil - "Unconditionally read the dribble file." - :group 'gnus-newsrc - :type 'boolean) - -;;; Internal variables - -(defvar gnus-ding-file-coding-system mm-universal-coding-system - "Coding system for ding file.") - -(defvar gnus-newsrc-file-version nil) -(defvar gnus-override-subscribe-method nil) -(defvar gnus-dribble-buffer nil) -(defvar gnus-newsrc-options nil - "Options line in the .newsrc file.") - -(defvar gnus-newsrc-options-n nil - "List of regexps representing groups to be subscribed/ignored unconditionally.") - -(defvar gnus-newsrc-last-checked-date nil - "Date Gnus last asked server for new newsgroups.") - -(defvar gnus-current-startup-file nil - "Startup file for the current host.") - -;; Byte-compiler warning. -(defvar gnus-group-line-format) - -;; Suggested by Brian Edmonds . -(defvar gnus-init-inhibit nil) -(defun gnus-read-init-file (&optional inhibit-next) - ;; Don't load .gnus if the -q option was used. - (when init-file-user - (if gnus-init-inhibit - (setq gnus-init-inhibit nil) - (setq gnus-init-inhibit inhibit-next) - (dolist (file (list gnus-site-init-file gnus-init-file)) - (when (and file - (locate-library file)) - (if (or debug-on-error debug-on-quit) - (load file nil t) - (condition-case var - (load file nil t) - (error - (error "Error in %s: %s" file (cadr var)))))))))) - -;; For subscribing new newsgroup - -(defun gnus-subscribe-hierarchical-interactive (groups) - (let ((groups (sort groups 'string<)) - prefixes prefix start ans group starts) - (while groups - (setq prefixes (list "^")) - (while (and groups prefixes) - (while (not (string-match (car prefixes) (car groups))) - (setq prefixes (cdr prefixes))) - (setq prefix (car prefixes)) - (setq start (1- (length prefix))) - (if (and (string-match "[^\\.]\\." (car groups) start) - (cdr groups) - (setq prefix - (concat "^" (substring (car groups) 0 (match-end 0)))) - (string-match prefix (cadr groups))) - (progn - (push prefix prefixes) - (message "Descend hierarchy %s? ([y]nsq): " - (substring prefix 1 (1- (length prefix)))) - (while (not (memq (setq ans (read-char-exclusive)) - '(?y ?\n ?\r ?n ?s ?q))) - (ding) - (message "Descend hierarchy %s? ([y]nsq): " - (substring prefix 1 (1- (length prefix))))) - (cond ((= ans ?n) - (while (and groups - (string-match prefix - (setq group (car groups)))) - (push group gnus-killed-list) - (gnus-sethash group group gnus-killed-hashtb) - (setq groups (cdr groups))) - (setq starts (cdr starts))) - ((= ans ?s) - (while (and groups - (string-match prefix - (setq group (car groups)))) - (gnus-sethash group group gnus-killed-hashtb) - (gnus-subscribe-alphabetically (car groups)) - (setq groups (cdr groups))) - (setq starts (cdr starts))) - ((= ans ?q) - (while groups - (setq group (car groups)) - (push group gnus-killed-list) - (gnus-sethash group group gnus-killed-hashtb) - (setq groups (cdr groups)))) - (t nil))) - (message "Subscribe %s? ([n]yq)" (car groups)) - (while (not (memq (setq ans (read-char-exclusive)) - '(?y ?\n ?\r ?q ?n))) - (ding) - (message "Subscribe %s? ([n]yq)" (car groups))) - (setq group (car groups)) - (cond ((= ans ?y) - (gnus-subscribe-alphabetically (car groups)) - (gnus-sethash group group gnus-killed-hashtb)) - ((= ans ?q) - (while groups - (setq group (car groups)) - (push group gnus-killed-list) - (gnus-sethash group group gnus-killed-hashtb) - (setq groups (cdr groups)))) - (t - (push group gnus-killed-list) - (gnus-sethash group group gnus-killed-hashtb))) - (setq groups (cdr groups))))))) - -(defun gnus-subscribe-randomly (newsgroup) - "Subscribe new NEWSGROUP by making it the first newsgroup." - (gnus-subscribe-newsgroup newsgroup)) - -(defun gnus-subscribe-alphabetically (newgroup) - "Subscribe new NEWGROUP and insert it in alphabetical order." - (let ((groups (cdr gnus-newsrc-alist)) - before) - (while (and (not before) groups) - (if (string< newgroup (caar groups)) - (setq before (caar groups)) - (setq groups (cdr groups)))) - (gnus-subscribe-newsgroup newgroup before))) - -(defun gnus-subscribe-hierarchically (newgroup) - "Subscribe new NEWGROUP and insert it in hierarchical newsgroup order." - ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams) - (save-excursion - (set-buffer (nnheader-find-file-noselect gnus-current-startup-file)) - (prog1 - (let ((groupkey newgroup) before) - (while (and (not before) groupkey) - (goto-char (point-min)) - (let ((groupkey-re - (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]"))) - (while (and (re-search-forward groupkey-re nil t) - (progn - (setq before (match-string 1)) - (string< before newgroup))))) - ;; Remove tail of newsgroup name (eg. a.b.c -> a.b) - (setq groupkey - (when (string-match "^\\(.*\\)\\.[^.]+$" groupkey) - (substring groupkey (match-beginning 1) (match-end 1))))) - (gnus-subscribe-newsgroup newgroup before)) - (kill-buffer (current-buffer))))) - -(defun gnus-subscribe-interactively (group) - "Subscribe the new GROUP interactively. -It is inserted in hierarchical newsgroup order if subscribed. If not, -it is killed." - (if (gnus-y-or-n-p (format "Subscribe new newsgroup %s? " group)) - (gnus-subscribe-hierarchically group) - (push group gnus-killed-list))) - -(defun gnus-subscribe-zombies (group) - "Make the new GROUP into a zombie group." - (push group gnus-zombie-list)) - -(defun gnus-subscribe-killed (group) - "Make the new GROUP a killed group." - (push group gnus-killed-list)) - -(defun gnus-subscribe-newsgroup (newsgroup &optional next) - "Subscribe new NEWSGROUP. -If NEXT is non-nil, it is inserted before NEXT. Otherwise it is made -the first newsgroup." - (save-excursion - (goto-char (point-min)) - ;; We subscribe the group by changing its level to `subscribed'. - (gnus-group-change-level - newsgroup gnus-level-default-subscribed - gnus-level-killed (gnus-gethash (or next "dummy.group") - gnus-newsrc-hashtb)) - (gnus-message 5 "Subscribe newsgroup: %s" newsgroup) - (run-hook-with-args 'gnus-subscribe-newsgroup-hooks newsgroup) - t)) - -(defun gnus-read-active-file-p () - "Say whether the active file has been read from `gnus-select-method'." - (memq gnus-select-method gnus-have-read-active-file)) - -;;; General various misc type functions. - -;; Silence byte-compiler. -(eval-when-compile - (defvar gnus-current-headers) - (defvar gnus-thread-indent-array) - (defvar gnus-newsgroup-name) - (defvar gnus-newsgroup-headers) - (defvar gnus-group-list-mode) - (defvar gnus-group-mark-positions) - (defvar gnus-newsgroup-data) - (defvar gnus-newsgroup-unreads) - (defvar nnoo-state-alist) - (defvar gnus-current-select-method) - (defvar mail-sources) - (defvar nnmail-scan-directory-mail-source-once) - (defvar nnmail-split-history) - (defvar nnmail-spool-file)) - -(defun gnus-close-all-servers () - "Close all servers." - (interactive) - (dolist (server gnus-opened-servers) - (gnus-close-server (car server)))) - -(defun gnus-clear-system () - "Clear all variables and buffers." - ;; Clear Gnus variables. - (let ((variables (remove 'gnus-format-specs gnus-variable-list))) - (while variables - (set (car variables) nil) - (setq variables (cdr variables)))) - ;; Clear other internal variables. - (setq gnus-list-of-killed-groups nil - gnus-have-read-active-file nil - gnus-agent-covered-methods nil - gnus-agent-file-loading-local nil - gnus-agent-file-loading-cache nil - gnus-server-method-cache nil - gnus-newsrc-alist nil - gnus-newsrc-hashtb nil - gnus-killed-list nil - gnus-zombie-list nil - gnus-killed-hashtb nil - gnus-active-hashtb nil - gnus-moderated-hashtb nil - gnus-description-hashtb nil - gnus-current-headers nil - gnus-thread-indent-array nil - gnus-newsgroup-headers nil - gnus-newsgroup-name nil - gnus-server-alist nil - gnus-group-list-mode nil - gnus-opened-servers nil - gnus-group-mark-positions nil - gnus-newsgroup-data nil - gnus-newsgroup-unreads nil - nnoo-state-alist nil - gnus-current-select-method nil - nnmail-split-history nil - gnus-ephemeral-servers nil) - (gnus-shutdown 'gnus) - ;; Kill the startup file. - (and gnus-current-startup-file - (get-file-buffer gnus-current-startup-file) - (kill-buffer (get-file-buffer gnus-current-startup-file))) - ;; Clear the dribble buffer. - (gnus-dribble-clear) - ;; Kill global KILL file buffer. - (when (get-file-buffer (gnus-newsgroup-kill-file nil)) - (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil)))) - (gnus-kill-buffer nntp-server-buffer) - ;; Kill Gnus buffers. - (dolist (buffer (gnus-buffers)) - (gnus-kill-buffer buffer)) - ;; Remove Gnus frames. - (gnus-kill-gnus-frames)) - -(defun gnus-no-server-1 (&optional arg slave) - "Read network news. -If ARG is a positive number, Gnus will use that as the startup -level. If ARG is nil, Gnus will be started at level 2 -\(`gnus-level-default-subscribed' minus one). If ARG is non-nil -and not a positive number, Gnus will prompt the user for the name -of an NNTP server to use. As opposed to \\[gnus], this command -will not connect to the local server." - (interactive "P") - (let ((val (or arg (1- gnus-level-default-subscribed)))) - (gnus val t slave) - (make-local-variable 'gnus-group-use-permanent-levels) - (setq gnus-group-use-permanent-levels val))) - -(defun gnus-1 (&optional arg dont-connect slave) - "Read network news. -If ARG is non-nil and a positive number, Gnus will use that as the -startup level. If ARG is non-nil and not a positive number, Gnus will -prompt the user for the name of an NNTP server to use." - (interactive "P") - - (if (gnus-alive-p) - (progn - (switch-to-buffer gnus-group-buffer) - (gnus-group-get-new-news - (and (numberp arg) - (> arg 0) - (max (car gnus-group-list-mode) arg)))) - - (gnus-clear-system) - (gnus-splash) - (gnus-run-hooks 'gnus-before-startup-hook) - (nnheader-init-server-buffer) - (setq gnus-slave slave) - (gnus-read-init-file) - (if gnus-agent - (gnus-agentize)) - - (when gnus-simple-splash - (setq gnus-simple-splash nil) - (cond - ((featurep 'xemacs) - (gnus-xmas-splash)) - (window-system - (gnus-x-splash)))) - - (let ((level (and (numberp arg) (> arg 0) arg)) - did-connect) - (unwind-protect - (progn - (unless dont-connect - (setq did-connect - (gnus-start-news-server (and arg (not level)))))) - (if (and (not dont-connect) - (not did-connect)) - (gnus-group-quit) - (gnus-run-hooks 'gnus-startup-hook) - ;; NNTP server is successfully open. - - ;; Find the current startup file name. - (setq gnus-current-startup-file - (gnus-make-newsrc-file gnus-startup-file)) - - ;; Read the dribble file. - (when (or gnus-slave gnus-use-dribble-file) - (gnus-dribble-read-file)) - - ;; Allow using GroupLens predictions. - (when gnus-use-grouplens - (bbb-login) - (add-hook 'gnus-summary-mode-hook 'gnus-grouplens-mode)) - - ;; Do the actual startup. - (if gnus-agent - (gnus-request-create-group "queue" '(nndraft ""))) - (gnus-request-create-group "drafts" '(nndraft "")) - (gnus-setup-news nil level dont-connect) - (gnus-run-hooks 'gnus-setup-news-hook) - (gnus-start-draft-setup) - ;; Generate the group buffer. - (gnus-group-list-groups level) - (gnus-group-first-unread-group) - (gnus-configure-windows 'group) - (gnus-group-set-mode-line) - (gnus-run-hooks 'gnus-started-hook)))))) - -(defun gnus-start-draft-setup () - "Make sure the draft group exists." - (gnus-request-create-group "drafts" '(nndraft "")) - (unless (gnus-gethash "nndraft:drafts" gnus-newsrc-hashtb) - (gnus-message 3 "Subscribing drafts group") - (let ((gnus-level-default-subscribed 1)) - (gnus-subscribe-group "nndraft:drafts" nil '(nndraft "")))) - (unless (equal (gnus-group-get-parameter "nndraft:drafts" 'gnus-dummy t) - '((gnus-draft-mode))) - (gnus-message 3 "Setting up drafts group") - (gnus-group-set-parameter - "nndraft:drafts" 'gnus-dummy '((gnus-draft-mode))))) - - -;;; -;;; Dribble file -;;; - -(defvar gnus-dribble-ignore nil) -(defvar gnus-dribble-eval-file nil) - -(defun gnus-dribble-file-name () - "Return the dribble file for the current .newsrc." - (concat - (if gnus-dribble-directory - (concat (file-name-as-directory gnus-dribble-directory) - (file-name-nondirectory gnus-current-startup-file)) - gnus-current-startup-file) - "-dribble")) - -(defun gnus-dribble-enter (string) - "Enter STRING into the dribble buffer." - (when (and (not gnus-dribble-ignore) - gnus-dribble-buffer - (buffer-name gnus-dribble-buffer)) - (let ((obuf (current-buffer))) - (set-buffer gnus-dribble-buffer) - (goto-char (point-max)) - (insert string "\n") - ;; This has been commented by Josh Huber - ;; It causes problems with both XEmacs and Emacs 21, and doesn't - ;; seem to be of much value. (FIXME: remove this after we make sure - ;; it's not needed). - ;; (set-window-point (get-buffer-window (current-buffer)) (point-max)) - (bury-buffer gnus-dribble-buffer) - (save-excursion - (set-buffer gnus-group-buffer) - (gnus-group-set-mode-line)) - (set-buffer obuf)))) - -(defun gnus-dribble-touch () - "Touch the dribble buffer." - (gnus-dribble-enter "")) - -(defun gnus-dribble-read-file () - "Read the dribble file from disk." - (let ((dribble-file (gnus-dribble-file-name))) - (save-excursion - (set-buffer (setq gnus-dribble-buffer - (gnus-get-buffer-create - (file-name-nondirectory dribble-file)))) - (set (make-local-variable 'file-precious-flag) t) - (erase-buffer) - (setq buffer-file-name dribble-file) - (auto-save-mode t) - (buffer-disable-undo) - (bury-buffer (current-buffer)) - (set-buffer-modified-p nil) - (let ((auto (make-auto-save-file-name)) - (gnus-dribble-ignore t) - (purpose nil) - modes) - (when (or (file-exists-p auto) (file-exists-p dribble-file)) - ;; Load whichever file is newest -- the auto save file - ;; or the "real" file. - (if (file-newer-than-file-p auto dribble-file) - (nnheader-insert-file-contents auto) - (nnheader-insert-file-contents dribble-file)) - (unless (zerop (buffer-size)) - (set-buffer-modified-p t)) - ;; Set the file modes to reflect the .newsrc file modes. - (save-buffer) - (when (and (file-exists-p gnus-current-startup-file) - (file-exists-p dribble-file) - (setq modes (file-modes gnus-current-startup-file))) - (set-file-modes dribble-file modes)) - (goto-char (point-min)) - (when (search-forward "Gnus was exited on purpose" nil t) - (setq purpose t)) - ;; Possibly eval the file later. - (when (or gnus-always-read-dribble-file - (gnus-y-or-n-p - (if purpose - "Gnus exited on purpose without saving; read auto-save file anyway? " - "Gnus auto-save file exists. Do you want to read it? "))) - (setq gnus-dribble-eval-file t))))))) - -(defun gnus-dribble-eval-file () - (when gnus-dribble-eval-file - (setq gnus-dribble-eval-file nil) - (save-excursion - (let ((gnus-dribble-ignore t)) - (set-buffer gnus-dribble-buffer) - (eval-buffer (current-buffer)))))) - -(defun gnus-dribble-delete-file () - (when (file-exists-p (gnus-dribble-file-name)) - (delete-file (gnus-dribble-file-name))) - (when gnus-dribble-buffer - (save-excursion - (set-buffer gnus-dribble-buffer) - (let ((auto (make-auto-save-file-name))) - (when (file-exists-p auto) - (delete-file auto)) - (erase-buffer) - (set-buffer-modified-p nil))))) - -(defun gnus-dribble-save () - (when (and gnus-dribble-buffer - (buffer-name gnus-dribble-buffer)) - (save-excursion - (set-buffer gnus-dribble-buffer) - (save-buffer)))) - -(defun gnus-dribble-clear () - (when (gnus-buffer-exists-p gnus-dribble-buffer) - (save-excursion - (set-buffer gnus-dribble-buffer) - (erase-buffer) - (set-buffer-modified-p nil) - (setq buffer-saved-size (buffer-size))))) - - -;;; -;;; Active & Newsrc File Handling -;;; - -(defun gnus-setup-news (&optional rawfile level dont-connect) - "Setup news information. -If RAWFILE is non-nil, the .newsrc file will also be read. -If LEVEL is non-nil, the news will be set up at level LEVEL." - (require 'nnmail) - (let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile)))) - ;; Binding this variable will inhibit multiple fetchings - ;; of the same mail source. - (nnmail-fetched-sources (list t))) - - (when init - ;; Clear some variables to re-initialize news information. - (setq gnus-newsrc-alist nil - gnus-active-hashtb nil) - ;; Read the newsrc file and create `gnus-newsrc-hashtb'. - (gnus-read-newsrc-file rawfile)) - - ;; Make sure the archive server is available to all and sundry. - (when gnus-message-archive-method - (unless (assoc "archive" gnus-server-alist) - (let ((method (or (and (stringp gnus-message-archive-method) - (gnus-server-to-method - gnus-message-archive-method)) - gnus-message-archive-method))) - ;; Check whether the archive method is writable. - (unless (or (stringp method) - (memq 'respool (assoc (format "%s" (car method)) - gnus-valid-select-methods))) - (setq method "archive")) ;; The default. - (push (if (stringp method) - `("archive" - nnfolder - ,method - (nnfolder-directory - ,(nnheader-concat message-directory method)) - (nnfolder-active-file - ,(nnheader-concat message-directory - (concat method "/active"))) - (nnfolder-get-new-mail nil) - (nnfolder-inhibit-expiry t)) - (cons "archive" method)) - gnus-server-alist)))) - - ;; If we don't read the complete active file, we fill in the - ;; hashtb here. - (when (or (null gnus-read-active-file) - (eq gnus-read-active-file 'some)) - (gnus-update-active-hashtb-from-killed)) - - ;; Validate agent covered methods now that gnus-server-alist has - ;; been initialized. - ;; NOTE: This is here for one purpose only. By validating the - ;; agentized server's, it converts the old 5.10.3, and earlier, - ;; format to the current format. That enables the agent code - ;; within gnus-read-active-file to function correctly. - (if gnus-agent - (gnus-agent-read-servers-validate)) - - ;; Read the active file and create `gnus-active-hashtb'. - ;; If `gnus-read-active-file' is nil, then we just create an empty - ;; hash table. The partial filling out of the hash table will be - ;; done in `gnus-get-unread-articles'. - (and gnus-read-active-file - (not level) - (gnus-read-active-file nil dont-connect)) - - (unless gnus-active-hashtb - (setq gnus-active-hashtb (gnus-make-hashtable 4096))) - - ;; Initialize the cache. - (when gnus-use-cache - (gnus-cache-open)) - - ;; Possibly eval the dribble file. - (and init - (or gnus-use-dribble-file gnus-slave) - (gnus-dribble-eval-file)) - - ;; Slave Gnusii should then clear the dribble buffer. - (when (and init gnus-slave) - (gnus-dribble-clear)) - - (gnus-update-format-specifications) - - ;; See whether we need to read the description file. - (when (and (boundp 'gnus-group-line-format) - (stringp gnus-group-line-format) - (let ((case-fold-search nil)) - (string-match "%[-,0-9]*D" gnus-group-line-format)) - (not gnus-description-hashtb) - (not dont-connect) - gnus-read-active-file) - (gnus-read-all-descriptions-files)) - - ;; Find new newsgroups and treat them. - (when (and init gnus-check-new-newsgroups (not level) - (gnus-check-server gnus-select-method) - (not gnus-slave) - gnus-plugged) - (gnus-find-new-newsgroups)) - - ;; Check and remove bogus newsgroups. - (when (and init gnus-check-bogus-newsgroups - gnus-read-active-file (not level) - (gnus-server-opened gnus-select-method)) - (gnus-check-bogus-newsgroups)) - - ;; We might read in new NoCeM messages here. - (when (and (not dont-connect) - gnus-use-nocem - (or (and (numberp gnus-use-nocem) - (numberp level) - (>= level gnus-use-nocem)) - (not level))) - (gnus-nocem-scan-groups)) - - ;; Read any slave files. - (gnus-master-read-slave-newsrc) - - ;; Find the number of unread articles in each non-dead group. - (let ((gnus-read-active-file (and (not level) gnus-read-active-file))) - (gnus-get-unread-articles level)))) - -(defun gnus-call-subscribe-functions (method group) - "Call METHOD to subscribe GROUP. -If no function returns `non-nil', call `gnus-subscribe-zombies'." - (unless (cond - ((functionp method) - (funcall method group)) - ((listp method) - (catch 'found - (dolist (func method) - (if (funcall func group) - (throw 'found t))) - nil)) - (t nil)) - (gnus-subscribe-zombies group))) - -(defun gnus-find-new-newsgroups (&optional arg) - "Search for new newsgroups and add them. -Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method'. -The `-n' option line from .newsrc is respected. - -With 1 C-u, use the `ask-server' method to query the server for new -groups. -With 2 C-u's, use most complete method possible to query the server -for new groups, and subscribe the new groups as zombies." - (interactive "p") - (let* ((gnus-subscribe-newsgroup-method - gnus-subscribe-newsgroup-method) - (check (cond - ((or (and (= (or arg 1) 4) - (not (listp gnus-check-new-newsgroups))) - (null gnus-read-active-file) - (eq gnus-read-active-file 'some)) - 'ask-server) - ((= (or arg 1) 16) - (setq gnus-subscribe-newsgroup-method - 'gnus-subscribe-zombies) - t) - (t gnus-check-new-newsgroups)))) - (unless (gnus-check-first-time-used) - (if (or (consp check) - (eq check 'ask-server)) - ;; Ask the server for new groups. - (gnus-ask-server-for-new-groups) - ;; Go through the active hashtb and look for new groups. - (let ((groups 0) - group new-newsgroups) - (gnus-message 5 "Looking for new newsgroups...") - (unless gnus-have-read-active-file - (gnus-read-active-file)) - (setq gnus-newsrc-last-checked-date (message-make-date)) - (unless gnus-killed-hashtb - (gnus-make-hashtable-from-killed)) - ;; Go though every newsgroup in `gnus-active-hashtb' and compare - ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'. - (mapatoms - (lambda (sym) - (if (or (null (setq group (symbol-name sym))) - (not (boundp sym)) - (null (symbol-value sym)) - (gnus-gethash group gnus-killed-hashtb) - (gnus-gethash group gnus-newsrc-hashtb)) - () - (let ((do-sub (gnus-matches-options-n group))) - (cond - ((eq do-sub 'subscribe) - (setq groups (1+ groups)) - (gnus-sethash group group gnus-killed-hashtb) - (gnus-call-subscribe-functions - gnus-subscribe-options-newsgroup-method group)) - ((eq do-sub 'ignore) - nil) - (t - (setq groups (1+ groups)) - (gnus-sethash group group gnus-killed-hashtb) - (if gnus-subscribe-hierarchical-interactive - (push group new-newsgroups) - (gnus-call-subscribe-functions - gnus-subscribe-newsgroup-method group))))))) - gnus-active-hashtb) - (when new-newsgroups - (gnus-subscribe-hierarchical-interactive new-newsgroups)) - (if (> groups 0) - (gnus-message 5 "%d new newsgroup%s arrived." - groups (if (> groups 1) "s have" " has")) - (gnus-message 5 "No new newsgroups."))))))) - -(defun gnus-matches-options-n (group) - ;; Returns `subscribe' if the group is to be unconditionally - ;; subscribed, `ignore' if it is to be ignored, and nil if there is - ;; no match for the group. - - ;; First we check the two user variables. - (cond - ((and gnus-options-subscribe - (string-match gnus-options-subscribe group)) - 'subscribe) - ((and gnus-auto-subscribed-groups - (string-match gnus-auto-subscribed-groups group)) - 'subscribe) - ((and gnus-options-not-subscribe - (string-match gnus-options-not-subscribe group)) - 'ignore) - ;; Then we go through the list that was retrieved from the .newsrc - ;; file. This list has elements on the form - ;; `(REGEXP . {ignore,subscribe})'. The first match found (the list - ;; is in the reverse order of the options line) is returned. - (t - (let ((regs gnus-newsrc-options-n)) - (while (and regs - (not (string-match (caar regs) group))) - (setq regs (cdr regs))) - (and regs (cdar regs)))))) - -(defun gnus-ask-server-for-new-groups () - (let* ((new-date (message-make-date)) - (date (or gnus-newsrc-last-checked-date new-date)) - (methods (cons gnus-select-method - (nconc - (when (gnus-archive-server-wanted-p) - (list "archive")) - (append - (and (consp gnus-check-new-newsgroups) - gnus-check-new-newsgroups) - gnus-secondary-select-methods)))) - (groups 0) - group new-newsgroups got-new method hashtb - gnus-override-subscribe-method) - (unless gnus-killed-hashtb - (gnus-make-hashtable-from-killed)) - ;; Go through both primary and secondary select methods and - ;; request new newsgroups. - (while (setq method (gnus-server-get-method nil (pop methods))) - (setq new-newsgroups nil - gnus-override-subscribe-method method) - (when (and (gnus-check-server method) - (gnus-request-newgroups date method)) - (save-excursion - (setq got-new t - hashtb (gnus-make-hashtable 100)) - (set-buffer nntp-server-buffer) - ;; Enter all the new groups into a hashtable. - (gnus-active-to-gnus-format method hashtb 'ignore)) - ;; Now all new groups from `method' are in `hashtb'. - (mapatoms - (lambda (group-sym) - (if (or (null (setq group (symbol-name group-sym))) - (not (boundp group-sym)) - (null (symbol-value group-sym)) - (gnus-gethash group gnus-newsrc-hashtb) - (member group gnus-zombie-list) - (member group gnus-killed-list)) - ;; The group is already known. - () - ;; Make this group active. - (when (symbol-value group-sym) - (gnus-set-active group (symbol-value group-sym))) - ;; Check whether we want it or not. - (let ((do-sub (gnus-matches-options-n group))) - (cond - ((eq do-sub 'subscribe) - (incf groups) - (gnus-sethash group group gnus-killed-hashtb) - (gnus-call-subscribe-functions - gnus-subscribe-options-newsgroup-method group)) - ((eq do-sub 'ignore) - nil) - (t - (incf groups) - (gnus-sethash group group gnus-killed-hashtb) - (if gnus-subscribe-hierarchical-interactive - (push group new-newsgroups) - (gnus-call-subscribe-functions - gnus-subscribe-newsgroup-method group))))))) - hashtb)) - (when new-newsgroups - (gnus-subscribe-hierarchical-interactive new-newsgroups))) - (if (> groups 0) - (gnus-message 5 "%d new newsgroup%s arrived" - groups (if (> groups 1) "s have" " has")) - (gnus-message 5 "No new newsgroups")) - (when got-new - (setq gnus-newsrc-last-checked-date new-date)) - got-new)) - -(defun gnus-check-first-time-used () - (catch 'ended - ;; First check if any of the following files exist. If they do, - ;; it's not the first time the user has used Gnus. - (dolist (file (list (concat gnus-current-startup-file ".el") - (concat gnus-current-startup-file ".eld") - (concat gnus-startup-file ".el") - (concat gnus-startup-file ".eld"))) - (when (file-exists-p file) - (throw 'ended nil))) - (gnus-message 6 "First time user; subscribing you to default groups") - (unless (gnus-read-active-file-p) - (let ((gnus-read-active-file t)) - (gnus-read-active-file))) - (setq gnus-newsrc-last-checked-date (message-make-date)) - ;; Subscribe to the default newsgroups. - (let ((groups (or gnus-default-subscribed-newsgroups - gnus-backup-default-subscribed-newsgroups)) - group) - (if (eq groups t) - ;; If t, we subscribe (or not) all groups as if they were new. - (mapatoms - (lambda (sym) - (when (setq group (symbol-name sym)) - (let ((do-sub (gnus-matches-options-n group))) - (cond - ((eq do-sub 'subscribe) - (gnus-sethash group group gnus-killed-hashtb) - (gnus-call-subscribe-functions - gnus-subscribe-options-newsgroup-method group)) - ((eq do-sub 'ignore) - nil) - (t - (push group gnus-killed-list)))))) - gnus-active-hashtb) - (dolist (group groups) - ;; Only subscribe the default groups that are activated. - (when (gnus-active group) - (gnus-group-change-level - group gnus-level-default-subscribed gnus-level-killed))) - (save-excursion - (set-buffer gnus-group-buffer) - ;; Don't error if the group already exists. This happens when a - ;; first-time user types 'F'. -- didier - (gnus-group-make-help-group t)) - (when gnus-novice-user - (gnus-message 7 "`A k' to list killed groups")))))) - -(defun gnus-subscribe-group (group &optional previous method) - "Subscribe GROUP and put it after PREVIOUS." - (gnus-group-change-level - (if method - (list t group gnus-level-default-subscribed nil nil method) - group) - gnus-level-default-subscribed gnus-level-killed previous t) - t) - -;; `gnus-group-change-level' is the fundamental function for changing -;; subscription levels of newsgroups. This might mean just changing -;; from level 1 to 2, which is pretty trivial, from 2 to 6 or back -;; again, which subscribes/unsubscribes a group, which is equally -;; trivial. Changing from 1-7 to 8-9 means that you kill a group, and -;; from 8-9 to 1-7 means that you remove the group from the list of -;; killed (or zombie) groups and add them to the (kinda) subscribed -;; groups. And last but not least, moving from 8 to 9 and 9 to 8, -;; which is trivial. -;; ENTRY can either be a string (newsgroup name) or a list (if -;; FROMKILLED is t, it's a list on the format (NUM INFO-LIST), -;; otherwise it's a list in the format of the `gnus-newsrc-hashtb' -;; entries. -;; LEVEL is the new level of the group, OLDLEVEL is the old level and -;; PREVIOUS is the group (in hashtb entry format) to insert this group -;; after. -(defun gnus-group-change-level (entry level &optional oldlevel - previous fromkilled) - (let (group info active num) - ;; Glean what info we can from the arguments - (if (consp entry) - (if fromkilled (setq group (nth 1 entry)) - (setq group (car (nth 2 entry)))) - (setq group entry)) - (when (and (stringp entry) - oldlevel - (< oldlevel gnus-level-zombie)) - (setq entry (gnus-gethash entry gnus-newsrc-hashtb))) - (if (and (not oldlevel) - (consp entry)) - (setq oldlevel (gnus-info-level (nth 2 entry))) - (setq oldlevel (or oldlevel gnus-level-killed))) - (when (stringp previous) - (setq previous (gnus-gethash previous gnus-newsrc-hashtb))) - - (if (and (>= oldlevel gnus-level-zombie) - (gnus-gethash group gnus-newsrc-hashtb)) - ;; We are trying to subscribe a group that is already - ;; subscribed. - () ; Do nothing. - - (unless (gnus-ephemeral-group-p group) - (gnus-dribble-enter - (format "(gnus-group-change-level %S %S %S %S %S)" - group level oldlevel (car (nth 2 previous)) fromkilled))) - - ;; Then we remove the newgroup from any old structures, if needed. - ;; If the group was killed, we remove it from the killed or zombie - ;; list. If not, and it is in fact going to be killed, we remove - ;; it from the newsrc hash table and assoc. - (cond - ((>= oldlevel gnus-level-zombie) - ;; oldlevel could be wrong. - (setq gnus-zombie-list (delete group gnus-zombie-list)) - (setq gnus-killed-list (delete group gnus-killed-list))) - (t - (when (and (>= level gnus-level-zombie) - entry) - (gnus-sethash (car (nth 2 entry)) nil gnus-newsrc-hashtb) - (when (nth 3 entry) - (setcdr (gnus-gethash (car (nth 3 entry)) - gnus-newsrc-hashtb) - (cdr entry))) - (setcdr (cdr entry) (cdddr entry))))) - - ;; Finally we enter (if needed) the list where it is supposed to - ;; go, and change the subscription level. If it is to be killed, - ;; we enter it into the killed or zombie list. - (cond - ((>= level gnus-level-zombie) - ;; Remove from the hash table. - (gnus-sethash group nil gnus-newsrc-hashtb) - ;; We do not enter foreign groups into the list of dead - ;; groups. - (unless (gnus-group-foreign-p group) - (if (= level gnus-level-zombie) - (push group gnus-zombie-list) - (if (= oldlevel gnus-level-killed) - ;; Remove from active hashtb. - (unintern group gnus-active-hashtb) - ;; Don't add it into killed-list if it was killed. - (push group gnus-killed-list))))) - (t - ;; If the list is to be entered into the newsrc assoc, and - ;; it was killed, we have to create an entry in the newsrc - ;; hashtb format and fix the pointers in the newsrc assoc. - (if (< oldlevel gnus-level-zombie) - ;; It was alive, and it is going to stay alive, so we - ;; just change the level and don't change any pointers or - ;; hash table entries. - (setcar (cdaddr entry) level) - (if (listp entry) - (setq info (cdr entry) - num (car entry)) - (setq active (gnus-active group)) - (setq num - (if active (- (1+ (cdr active)) (car active)) t)) - ;; Shorten the select method if possible, if we need to - ;; store it at all (native groups). - (let ((method (gnus-method-simplify - (or gnus-override-subscribe-method - (gnus-group-method group))))) - (if method - (setq info (list group level nil nil method)) - (setq info (list group level nil))))) - (unless previous - (setq previous - (let ((p gnus-newsrc-alist)) - (while (cddr p) - (setq p (cdr p))) - p))) - (setq entry (cons info (cddr previous))) - (if (cdr previous) - (progn - (setcdr (cdr previous) entry) - (gnus-sethash group (cons num (cdr previous)) - gnus-newsrc-hashtb)) - (setcdr previous entry) - (gnus-sethash group (cons num previous) - gnus-newsrc-hashtb)) - (when (cdr entry) - (setcdr (gnus-gethash (caadr entry) gnus-newsrc-hashtb) entry)) - (gnus-dribble-enter - (format - "(gnus-group-set-info '%S)" info))))) - (when gnus-group-change-level-function - (funcall gnus-group-change-level-function - group level oldlevel previous))))) - -(defun gnus-kill-newsgroup (newsgroup) - "Obsolete function. Kills a newsgroup." - (gnus-group-change-level - (gnus-gethash newsgroup gnus-newsrc-hashtb) gnus-level-killed)) - -(defun gnus-check-bogus-newsgroups (&optional confirm) - "Remove bogus newsgroups. -If CONFIRM is non-nil, the user has to confirm the deletion of every -newsgroup." - (let ((newsrc (cdr gnus-newsrc-alist)) - bogus group entry info) - (gnus-message 5 "Checking bogus newsgroups...") - (unless (gnus-read-active-file-p) - (gnus-read-active-file t)) - (when (gnus-read-active-file-p) - ;; Find all bogus newsgroup that are subscribed. - (while newsrc - (setq info (pop newsrc) - group (gnus-info-group info)) - (unless (or (gnus-active group) ; Active - (and (gnus-info-method info) - (not (gnus-secondary-method-p - (gnus-info-method info))))) ; Foreign - ;; Found a bogus newsgroup. - (push group bogus))) - (if confirm - (map-y-or-n-p - "Remove bogus group %s? " - (lambda (group) - ;; Remove all bogus subscribed groups by first killing them, and - ;; then removing them from the list of killed groups. - (when (setq entry (gnus-gethash group gnus-newsrc-hashtb)) - (gnus-group-change-level entry gnus-level-killed) - (setq gnus-killed-list (delete group gnus-killed-list)))) - bogus '("group" "groups" "remove")) - (while (setq group (pop bogus)) - ;; Remove all bogus subscribed groups by first killing them, and - ;; then removing them from the list of killed groups. - (when (setq entry (gnus-gethash group gnus-newsrc-hashtb)) - (gnus-group-change-level entry gnus-level-killed) - (setq gnus-killed-list (delete group gnus-killed-list))))) - ;; Then we remove all bogus groups from the list of killed and - ;; zombie groups. They are removed without confirmation. - (let ((dead-lists '(gnus-killed-list gnus-zombie-list)) - killed) - (while dead-lists - (setq killed (symbol-value (car dead-lists))) - (while killed - (unless (gnus-active (setq group (pop killed))) - ;; The group is bogus. - ;; !!!Slow as hell. - (set (car dead-lists) - (delete group (symbol-value (car dead-lists)))))) - (setq dead-lists (cdr dead-lists)))) - (gnus-run-hooks 'gnus-check-bogus-groups-hook) - (gnus-message 5 "Checking bogus newsgroups...done")))) - -(defun gnus-check-duplicate-killed-groups () - "Remove duplicates from the list of killed groups." - (interactive) - (let ((killed gnus-killed-list)) - (while killed - (gnus-message 9 "%d" (length killed)) - (setcdr killed (delete (car killed) (cdr killed))) - (setq killed (cdr killed))))) - -;; We want to inline a function from gnus-cache, so we cheat here: -(eval-when-compile - (defvar gnus-cache-active-hashtb) - (defun gnus-cache-possibly-alter-active (group active) - "Alter the ACTIVE info for GROUP to reflect the articles in the cache." - (when gnus-cache-active-hashtb - (let ((cache-active (gnus-gethash group gnus-cache-active-hashtb))) - (when cache-active - (when (< (car cache-active) (car active)) - (setcar active (car cache-active))) - (when (> (cdr cache-active) (cdr active)) - (setcdr active (cdr cache-active)))))))) - -(defun gnus-activate-group (group &optional scan dont-check method) - "Check whether a group has been activated or not. -If SCAN, request a scan of that group as well." - (let ((method (or method (inline (gnus-find-method-for-group group)))) - active) - (and (inline (gnus-check-server method)) - ;; We escape all bugs and quit here to make it possible to - ;; continue if a group is so out-there that it reports bugs - ;; and stuff. - (progn - (and scan - (gnus-check-backend-function 'request-scan (car method)) - (gnus-request-scan group method)) - t) - (if (or debug-on-error debug-on-quit) - (inline (gnus-request-group group dont-check method)) - (condition-case nil - (inline (gnus-request-group group dont-check method)) - ;;(error nil) - (quit - (message "Quit activating %s" group) - nil))) - (unless dont-check - (setq active (gnus-parse-active)) - ;; If there are no articles in the group, the GROUP - ;; command may have responded with the `(0 . 0)'. We - ;; ignore this if we already have an active entry - ;; for the group. - (if (and (zerop (car active)) - (zerop (cdr active)) - (gnus-active group)) - (gnus-active group) - - ;; If a cache is present, we may have to alter the active info. - (when gnus-use-cache - (inline (gnus-cache-possibly-alter-active - group active))) - - ;; If the agent is enabled, we may have to alter the active info. - (when gnus-agent - (gnus-agent-possibly-alter-active group active)) - - (gnus-set-active group active) - ;; Return the new active info. - active))))) - -(defun gnus-get-unread-articles-in-group (info active &optional update) - (when (and info active) - ;; Allow the backend to update the info in the group. - (when (and update - (gnus-request-update-info - info (inline (gnus-find-method-for-group - (gnus-info-group info))))) - (gnus-activate-group (gnus-info-group info) nil t)) - - (let* ((range (gnus-info-read info)) - (num 0)) - - ;; These checks are present in gnus-activate-group but skipped - ;; due to setting dont-check in the preceeding call. - - ;; If a cache is present, we may have to alter the active info. - (when (and gnus-use-cache info) - (inline (gnus-cache-possibly-alter-active - (gnus-info-group info) active))) - - ;; If the agent is enabled, we may have to alter the active info. - (when (and gnus-agent info) - (gnus-agent-possibly-alter-active (gnus-info-group info) active info)) - - ;; Modify the list of read articles according to what articles - ;; are available; then tally the unread articles and add the - ;; number to the group hash table entry. - (cond - ((zerop (cdr active)) - (setq num 0)) - ((not range) - (setq num (- (1+ (cdr active)) (car active)))) - ((not (listp (cdr range))) - ;; Fix a single (num . num) range according to the - ;; active hash table. - ;; Fix by Carsten Bormann . - (and (< (cdr range) (car active)) (setcdr range (1- (car active)))) - (and (> (cdr range) (cdr active)) (setcdr range (cdr active))) - ;; Compute number of unread articles. - (setq num (max 0 (- (cdr active) (- (1+ (cdr range)) (car range)))))) - (t - ;; The read list is a list of ranges. Fix them according to - ;; the active hash table. - ;; First peel off any elements that are below the lower - ;; active limit. - (while (and (cdr range) - (>= (car active) - (or (and (atom (cadr range)) (cadr range)) - (caadr range)))) - (if (numberp (car range)) - (setcar range - (cons (car range) - (or (and (numberp (cadr range)) - (cadr range)) - (cdadr range)))) - (setcdr (car range) - (or (and (numberp (nth 1 range)) (nth 1 range)) - (cdadr range)))) - (setcdr range (cddr range))) - ;; Adjust the first element to be the same as the lower limit. - (when (and (not (atom (car range))) - (< (cdar range) (car active))) - (setcdr (car range) (1- (car active)))) - ;; Then we want to peel off any elements that are higher - ;; than the upper active limit. - (let ((srange range)) - ;; Go past all valid elements. - (while (and (cdr srange) - (<= (or (and (atom (cadr srange)) - (cadr srange)) - (caadr srange)) - (cdr active))) - (setq srange (cdr srange))) - (when (cdr srange) - ;; Nuke all remaining invalid elements. - (setcdr srange nil)) - - ;; Adjust the final element. - (when (and (not (atom (car srange))) - (> (cdar srange) (cdr active))) - (setcdr (car srange) (cdr active)))) - ;; Compute the number of unread articles. - (while range - (setq num (+ num (- (1+ (or (and (atom (car range)) (car range)) - (cdar range))) - (or (and (atom (car range)) (car range)) - (caar range))))) - (setq range (cdr range))) - (setq num (max 0 (- (cdr active) num))))) - ;; Set the number of unread articles. - (when (and info - (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb)) - (setcar (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb) num)) - num))) - -;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb' -;; and compute how many unread articles there are in each group. -(defun gnus-get-unread-articles (&optional level) - (setq gnus-server-method-cache nil) - (let* ((newsrc (cdr gnus-newsrc-alist)) - (level (or level gnus-activate-level (1+ gnus-level-subscribed))) - (foreign-level - (min - (cond ((and gnus-activate-foreign-newsgroups - (not (numberp gnus-activate-foreign-newsgroups))) - (1+ gnus-level-subscribed)) - ((numberp gnus-activate-foreign-newsgroups) - gnus-activate-foreign-newsgroups) - (t 0)) - level)) - (methods-cache nil) - (type-cache nil) - scanned-methods info group active method retrieve-groups cmethod - method-type) - (gnus-message 6 "Checking new news...") - - (while newsrc - (setq active (gnus-active (setq group (gnus-info-group - (setq info (pop newsrc)))))) - - ;; Check newsgroups. If the user doesn't want to check them, or - ;; they can't be checked (for instance, if the news server can't - ;; be reached) we just set the number of unread articles in this - ;; newsgroup to t. This means that Gnus thinks that there are - ;; unread articles, but it has no idea how many. - - ;; To be more explicit: - ;; >0 for an active group with messages - ;; 0 for an active group with no unread messages - ;; nil for non-foreign groups that the user has requested not be checked - ;; t for unchecked foreign groups or bogus groups, or groups that can't - ;; be checked, for one reason or other. - (when (setq method (gnus-info-method info)) - (if (setq cmethod (assoc method methods-cache)) - (setq method (cdr cmethod)) - (setq cmethod (inline (gnus-server-get-method nil method))) - (push (cons method cmethod) methods-cache) - (setq method cmethod))) - (when (and method - (not (setq method-type (cdr (assoc method type-cache))))) - (setq method-type - (cond - ((gnus-secondary-method-p method) - 'secondary) - ((inline (gnus-server-equal gnus-select-method method)) - 'primary) - (t - 'foreign))) - (push (cons method method-type) type-cache)) - - (cond ((and method (eq method-type 'foreign)) - ;; These groups are foreign. Check the level. - (when (and (<= (gnus-info-level info) foreign-level) - (setq active (gnus-activate-group group 'scan))) - ;; Let the Gnus agent save the active file. - (when (and gnus-agent active (gnus-online method)) - (gnus-agent-save-group-info - method (gnus-group-real-name group) active)) - (unless (inline (gnus-virtual-group-p group)) - (inline (gnus-close-group group))) - (when (fboundp (intern (concat (symbol-name (car method)) - "-request-update-info"))) - (inline (gnus-request-update-info info method))))) - ;; These groups are native or secondary. - ((> (gnus-info-level info) level) - ;; We don't want these groups. - (setq active 'ignore)) - ;; Activate groups. - ((not gnus-read-active-file) - (if (gnus-check-backend-function 'retrieve-groups group) - ;; if server support gnus-retrieve-groups we push - ;; the group onto retrievegroups for later checking - (if (assoc method retrieve-groups) - (setcdr (assoc method retrieve-groups) - (cons group (cdr (assoc method retrieve-groups)))) - (push (list method group) retrieve-groups)) - ;; hack: `nnmail-get-new-mail' changes the mail-source depending - ;; on the group, so we must perform a scan for every group - ;; if the users has any directory mail sources. - ;; hack: if `nnmail-scan-directory-mail-source-once' is non-nil, - ;; for it scan all spool files even when the groups are - ;; not required. - (if (and - (or nnmail-scan-directory-mail-source-once - (null (assq 'directory - (or mail-sources - (if (listp nnmail-spool-file) - nnmail-spool-file - (list nnmail-spool-file)))))) - (member method scanned-methods)) - (setq active (gnus-activate-group group)) - (setq active (gnus-activate-group group 'scan)) - (push method scanned-methods)) - (when active - (gnus-close-group group))))) - - ;; Get the number of unread articles in the group. - (cond - ((eq active 'ignore) - ;; Don't do anything. - ) - (active - (inline (gnus-get-unread-articles-in-group info active t))) - (t - ;; The group couldn't be reached, so we nix out the number of - ;; unread articles and stuff. - (gnus-set-active group nil) - (let ((tmp (gnus-gethash group gnus-newsrc-hashtb))) - (when tmp - (setcar tmp t)))))) - - ;; iterate through groups on methods which support gnus-retrieve-groups - ;; and fetch a partial active file and use it to find new news. - (dolist (rg retrieve-groups) - (let ((method (or (car rg) gnus-select-method)) - (groups (cdr rg))) - (when (gnus-check-server method) - ;; Request that the backend scan its incoming messages. - (when (gnus-check-backend-function 'request-scan (car method)) - (gnus-request-scan nil method)) - (gnus-read-active-file-2 - (mapcar (lambda (group) (gnus-group-real-name group)) groups) - method) - (dolist (group groups) - (cond - ((setq active (gnus-active (gnus-info-group - (setq info (gnus-get-info group))))) - (inline (gnus-get-unread-articles-in-group info active t))) - (t - ;; The group couldn't be reached, so we nix out the number of - ;; unread articles and stuff. - (gnus-set-active group nil) - (setcar (gnus-gethash group gnus-newsrc-hashtb) t))))))) - - (gnus-message 6 "Checking new news...done"))) - -;; Create a hash table out of the newsrc alist. The `car's of the -;; alist elements are used as keys. -(defun gnus-make-hashtable-from-newsrc-alist () - (let ((alist gnus-newsrc-alist) - (ohashtb gnus-newsrc-hashtb) - prev) - (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist))) - (setq alist - (setq prev (setq gnus-newsrc-alist - (if (equal (caar gnus-newsrc-alist) - "dummy.group") - gnus-newsrc-alist - (cons (list "dummy.group" 0 nil) alist))))) - (while alist - (gnus-sethash - (caar alist) - ;; Preserve number of unread articles in groups. - (cons (and ohashtb (car (gnus-gethash (caar alist) ohashtb))) - prev) - gnus-newsrc-hashtb) - (setq prev alist - alist (cdr alist))))) - -(defun gnus-make-hashtable-from-killed () - "Create a hash table from the killed and zombie lists." - (let ((lists '(gnus-killed-list gnus-zombie-list)) - list) - (setq gnus-killed-hashtb - (gnus-make-hashtable - (+ (length gnus-killed-list) (length gnus-zombie-list)))) - (while lists - (setq list (symbol-value (pop lists))) - (while list - (gnus-sethash (car list) (pop list) gnus-killed-hashtb))))) - -(defun gnus-parse-active () - "Parse active info in the nntp server buffer." - (save-excursion - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - ;; Parse the result we got from `gnus-request-group'. - (when (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+") - (goto-char (match-beginning 1)) - (cons (read (current-buffer)) - (read (current-buffer)))))) - -(defun gnus-make-articles-unread (group articles) - "Mark ARTICLES in GROUP as unread." - (let* ((info (nth 2 (or (gnus-gethash group gnus-newsrc-hashtb) - (gnus-gethash (gnus-group-real-name group) - gnus-newsrc-hashtb)))) - (ranges (gnus-info-read info)) - news article) - (while articles - (when (gnus-member-of-range - (setq article (pop articles)) ranges) - (push article news))) - (when news - ;; Enter this list into the group info. - (gnus-info-set-read - info (gnus-remove-from-range (gnus-info-read info) (nreverse news))) - - ;; Set the number of unread articles in gnus-newsrc-hashtb. - (gnus-get-unread-articles-in-group info (gnus-active group)) - - ;; Insert the change into the group buffer and the dribble file. - (gnus-group-update-group group t)))) - -(defun gnus-make-ascending-articles-unread (group articles) - "Mark ascending ARTICLES in GROUP as unread." - (let* ((entry (or (gnus-gethash group gnus-newsrc-hashtb) - (gnus-gethash (gnus-group-real-name group) - gnus-newsrc-hashtb))) - (info (nth 2 entry)) - (ranges (gnus-info-read info)) - (r ranges) - modified) - - (while articles - (let ((article (pop articles))) ; get the next article to remove from ranges - (while (let ((range (car ranges))) ; note the current range - (if (atom range) ; single value range - (cond ((not range) - ;; the articles extend past the end of the ranges - ;; OK - I'm done - (setq articles nil)) - ((< range article) - ;; this range preceeds the article. Leave the range unmodified. - (pop ranges) - ranges) - ((= range article) - ;; this range exactly matches the article; REMOVE THE RANGE. - ;; NOTE: When the range being removed is the last range, the list is corrupted by inserting null at its end. - (setcar ranges (cadr ranges)) - (setcdr ranges (cddr ranges)) - (setq modified (if (car ranges) t 'remove-null)) - nil)) - (let ((min (car range)) - (max (cdr range))) - ;; I have a min/max range to consider - (cond ((> min max) ; invalid range introduced by splitter - (setcar ranges (cadr ranges)) - (setcdr ranges (cddr ranges)) - (setq modified (if (car ranges) t 'remove-null)) - ranges) - ((= min max) - ;; replace min/max range with a single-value range - (setcar ranges min) - ranges) - ((< max article) - ;; this range preceeds the article. Leave the range unmodified. - (pop ranges) - ranges) - ((< article min) - ;; this article preceeds the range. Return null to move to the - ;; next article - nil) - (t - ;; this article splits the range into two parts - (setcdr ranges (cons (cons (1+ article) max) (cdr ranges))) - (setcdr range (1- article)) - (setq modified t) - ranges)))))))) - - (when modified - (when (eq modified 'remove-null) - (setq r (delq nil r))) - ;; Enter this list into the group info. - (gnus-info-set-read info r) - - ;; Set the number of unread articles in gnus-newsrc-hashtb. - (gnus-get-unread-articles-in-group info (gnus-active group)) - - ;; Insert the change into the group buffer and the dribble file. - (gnus-group-update-group group t)))) - -;; Enter all dead groups into the hashtb. -(defun gnus-update-active-hashtb-from-killed () - (let ((hashtb (setq gnus-active-hashtb (gnus-make-hashtable 4096))) - (lists (list gnus-killed-list gnus-zombie-list)) - killed) - (while lists - (setq killed (car lists)) - (while killed - (gnus-sethash (car killed) nil hashtb) - (setq killed (cdr killed))) - (setq lists (cdr lists))))) - -(defun gnus-get-killed-groups () - "Go through the active hashtb and mark all unknown groups as killed." - ;; First make sure active file has been read. - (unless (gnus-read-active-file-p) - (let ((gnus-read-active-file t)) - (gnus-read-active-file))) - (unless gnus-killed-hashtb - (gnus-make-hashtable-from-killed)) - ;; Go through all newsgroups that are known to Gnus - enlarge kill list. - (mapatoms - (lambda (sym) - (let ((groups 0) - (group (symbol-name sym))) - (if (or (null group) - (gnus-gethash group gnus-killed-hashtb) - (gnus-gethash group gnus-newsrc-hashtb)) - () - (let ((do-sub (gnus-matches-options-n group))) - (if (or (eq do-sub 'subscribe) (eq do-sub 'ignore)) - () - (setq groups (1+ groups)) - (push group gnus-killed-list) - (gnus-sethash group group gnus-killed-hashtb)))))) - gnus-active-hashtb) - (gnus-dribble-touch)) - -;; Get the active file(s) from the backend(s). -(defun gnus-read-active-file (&optional force not-native) - (gnus-group-set-mode-line) - (let ((methods - (mapcar - (lambda (m) (if (stringp m) (gnus-server-get-method nil m) m)) - (append - (if (and (not not-native) - (gnus-check-server gnus-select-method)) - ;; The native server is available. - (cons gnus-select-method gnus-secondary-select-methods) - ;; The native server is down, so we just do the - ;; secondary ones. - gnus-secondary-select-methods) - ;; Also read from the archive server. - (when (gnus-archive-server-wanted-p) - (list "archive"))))) - method) - (setq gnus-have-read-active-file nil) - (save-excursion - (set-buffer nntp-server-buffer) - (while (setq method (pop methods)) - ;; Only do each method once, in case the methods appear more - ;; than once in this list. - (unless (member method methods) - (if (or debug-on-error debug-on-quit) - (gnus-read-active-file-1 method force) - (condition-case () - (gnus-read-active-file-1 method force) - ;; We catch C-g so that we can continue past servers - ;; that do not respond. - (quit - (message "Quit reading the active file") - nil)))))))) - -(defun gnus-read-active-file-1 (method force) - (let (where mesg) - (setq where (nth 1 method) - mesg (format "Reading active file%s via %s..." - (if (and where (not (zerop (length where)))) - (concat " from " where) "") - (car method))) - (gnus-message 5 mesg) - (when (gnus-check-server method) - ;; Request that the backend scan its incoming messages. - (when (gnus-check-backend-function 'request-scan (car method)) - (gnus-request-scan nil method)) - (cond - ((and (eq gnus-read-active-file 'some) - (gnus-check-backend-function 'retrieve-groups (car method)) - (not force)) - (let ((newsrc (cdr gnus-newsrc-alist)) - (gmethod (gnus-server-get-method nil method)) - groups info) - (while (setq info (pop newsrc)) - (when (inline - (gnus-server-equal - (inline - (gnus-find-method-for-group - (gnus-info-group info) info)) - gmethod)) - (push (gnus-group-real-name (gnus-info-group info)) - groups))) - (gnus-read-active-file-2 groups method))) - ((null method) - t) - (t - (if (not (gnus-request-list method)) - (unless (equal method gnus-message-archive-method) - (gnus-error 1 "Cannot read active file from %s server" - (car method))) - (gnus-message 5 mesg) - (gnus-active-to-gnus-format method gnus-active-hashtb nil t) - ;; We mark this active file as read. - (push method gnus-have-read-active-file) - (gnus-message 5 "%sdone" mesg))))))) - -(defun gnus-read-active-file-2 (groups method) - "Read an active file for GROUPS in METHOD using `gnus-retrieve-groups'." - (when groups - (save-excursion - (set-buffer nntp-server-buffer) - (gnus-check-server method) - (let ((list-type (gnus-retrieve-groups groups method))) - (cond ((not list-type) - (gnus-error - 1.2 "Cannot read partial active file from %s server." - (car method))) - ((eq list-type 'active) - (gnus-active-to-gnus-format method gnus-active-hashtb nil t)) - (t - (gnus-groups-to-gnus-format method gnus-active-hashtb t))))))) - -;; Read an active file and place the results in `gnus-active-hashtb'. -(defun gnus-active-to-gnus-format (&optional method hashtb ignore-errors - real-active) - (unless method - (setq method gnus-select-method)) - (let ((cur (current-buffer)) - (hashtb (or hashtb - (if (and gnus-active-hashtb - (not (equal method gnus-select-method))) - gnus-active-hashtb - (setq gnus-active-hashtb - (if (equal method gnus-select-method) - (gnus-make-hashtable - (count-lines (point-min) (point-max))) - (gnus-make-hashtable 4096))))))) - ;; Delete unnecessary lines. - (goto-char (point-min)) - (cond - ((string= gnus-ignored-newsgroups "") - (delete-matching-lines "^to\\.")) - (t - (delete-matching-lines (concat "^to\\.\\|" gnus-ignored-newsgroups)))) - - (goto-char (point-min)) - (unless (re-search-forward "[\\\"]" nil t) - ;; Make the group names readable as a lisp expression even if they - ;; contain special characters. - (goto-char (point-max)) - (while (re-search-backward "[][';?()#]" nil t) - (insert ?\\))) - - ;; Let the Gnus agent save the active file. - (when (and gnus-agent real-active (gnus-online method)) - (gnus-agent-save-active method)) - - ;; If these are groups from a foreign select method, we insert the - ;; group prefix in front of the group names. - (when (not (gnus-server-equal - (gnus-server-get-method nil method) - (gnus-server-get-method nil gnus-select-method))) - (let ((prefix (gnus-group-prefixed-name "" method))) - (goto-char (point-min)) - (while (and (not (eobp)) - (progn - (when (= (following-char) ?\") - (forward-char 1)) - (insert prefix) - (zerop (forward-line 1))))))) - ;; Store the active file in a hash table. - (goto-char (point-min)) - (let (group max min) - (while (not (eobp)) - (condition-case () - (progn - (narrow-to-region (point) (gnus-point-at-eol)) - ;; group gets set to a symbol interned in the hash table - ;; (what a hack!!) - jwz - (setq group (let ((obarray hashtb)) (read cur))) - ;; ### The extended group name scheme makes - ;; the previous optimization strategy sort of pointless... - (when (stringp group) - (setq group (intern group hashtb))) - (if (and (numberp (setq max (read cur))) - (numberp (setq min (read cur))) - (progn - (skip-chars-forward " \t") - (not - (or (eq (char-after) ?=) - (eq (char-after) ?x) - (eq (char-after) ?j))))) - (progn - (set group (cons min max)) - ;; if group is moderated, stick in moderation table - (when (eq (char-after) ?m) - (unless gnus-moderated-hashtb - (setq gnus-moderated-hashtb (gnus-make-hashtable))) - (gnus-sethash (symbol-name group) t - gnus-moderated-hashtb))) - (set group nil))) - (error - (and group - (symbolp group) - (set group nil)) - (unless ignore-errors - (gnus-message 3 "Warning - invalid active: %s" - (buffer-substring - (gnus-point-at-bol) (gnus-point-at-eol)))))) - (widen) - (forward-line 1))))) - -(defun gnus-groups-to-gnus-format (method &optional hashtb real-active) - ;; Parse a "groups" active file. - (let ((cur (current-buffer)) - (hashtb (or hashtb - (if (and method gnus-active-hashtb) - gnus-active-hashtb - (setq gnus-active-hashtb - (gnus-make-hashtable - (count-lines (point-min) (point-max))))))) - (prefix (and method - (not (gnus-server-equal - (gnus-server-get-method nil method) - (gnus-server-get-method nil gnus-select-method))) - (gnus-group-prefixed-name "" method)))) - - ;; Let the Gnus agent save the active file. - (if (and gnus-agent - real-active - (gnus-online method) - (gnus-agent-method-p method)) - (progn - (gnus-agent-save-active method) - (gnus-active-to-gnus-format method hashtb nil real-active)) - - (goto-char (point-min)) - ;; We split this into to separate loops, one with the prefix - ;; and one without to speed the reading up somewhat. - (if prefix - (let (min max opoint group) - (while (not (eobp)) - (condition-case () - (progn - (read cur) (read cur) - (setq min (read cur) - max (read cur) - opoint (point)) - (skip-chars-forward " \t") - (insert prefix) - (goto-char opoint) - (set (let ((obarray hashtb)) (read cur)) - (cons min max))) - (error (and group (symbolp group) (set group nil)))) - (forward-line 1))) - (let (min max group) - (while (not (eobp)) - (condition-case () - (when (eq (char-after) ?2) - (read cur) (read cur) - (setq min (read cur) - max (read cur)) - (set (setq group (let ((obarray hashtb)) (read cur))) - (cons min max))) - (error (and group (symbolp group) (set group nil)))) - (forward-line 1))))))) - -(defun gnus-read-newsrc-file (&optional force) - "Read startup file. -If FORCE is non-nil, the .newsrc file is read." - ;; Reset variables that might be defined in the .newsrc.eld file. - (let ((variables (remove 'gnus-format-specs gnus-variable-list))) - (while variables - (set (car variables) nil) - (setq variables (cdr variables)))) - (let* ((newsrc-file gnus-current-startup-file) - (quick-file (concat newsrc-file ".el"))) - (save-excursion - ;; We always load the .newsrc.eld file. If always contains - ;; much information that can not be gotten from the .newsrc - ;; file (ticked articles, killed groups, foreign methods, etc.) - (gnus-read-newsrc-el-file quick-file) - - (when (and gnus-read-newsrc-file - (file-exists-p gnus-current-startup-file) - (or force - (and (file-newer-than-file-p newsrc-file quick-file) - (file-newer-than-file-p newsrc-file - (concat quick-file "d"))) - (not gnus-newsrc-alist))) - ;; We read the .newsrc file. Note that if there if a - ;; .newsrc.eld file exists, it has already been read, and - ;; the `gnus-newsrc-hashtb' has been created. While reading - ;; the .newsrc file, Gnus will only use the information it - ;; can find there for changing the data already read - - ;; i. e., reading the .newsrc file will not trash the data - ;; already read (except for read articles). - (save-excursion - (gnus-message 5 "Reading %s..." newsrc-file) - (set-buffer (nnheader-find-file-noselect newsrc-file)) - (buffer-disable-undo) - (gnus-newsrc-to-gnus-format) - (kill-buffer (current-buffer)) - (gnus-message 5 "Reading %s...done" newsrc-file))) - - ;; Convert old to new. - (gnus-convert-old-newsrc)))) - -(defun gnus-convert-old-newsrc () - "Convert old newsrc formats into the current format, if needed." - (let ((fcv (and gnus-newsrc-file-version - (gnus-continuum-version gnus-newsrc-file-version))) - (gcv (gnus-continuum-version))) - (when fcv - ;; A newsrc file was loaded. - (let (prompt-displayed - (converters - (sort - (mapcar (lambda (date-func) - (cons (gnus-continuum-version (car date-func)) - date-func)) - ;; This is a list of converters that must be run - ;; to bring the newsrc file up to the current - ;; version. If you create an incompatibility - ;; with older versions, you should create an - ;; entry here. The entry should consist of the - ;; current gnus version (hardcoded so that it - ;; doesn't change with each release) and the - ;; function that must be applied to convert the - ;; previous version into the current version. - '(("September Gnus v0.1" nil - gnus-convert-old-ticks) - ("Oort Gnus v0.08" "legacy-gnus-agent" - gnus-agent-convert-to-compressed-agentview) - ("Gnus v5.10.7" "legacy-gnus-agent" - gnus-agent-unlist-expire-days) - ("Gnus v5.10.7" "legacy-gnus-agent" - gnus-agent-unhook-expire-days))) - #'car-less-than-car))) - ;; Skip converters older than the file version - (while (and converters (>= fcv (caar converters))) - (pop converters)) - - ;; Perform converters to bring older version up to date. - (when (and converters (< fcv (caar converters))) - (while (and converters (< fcv (caar converters)) - (<= (caar converters) gcv)) - (let* ((converter-spec (pop converters)) - (convert-to (nth 1 converter-spec)) - (load-from (nth 2 converter-spec)) - (func (nth 3 converter-spec))) - (when (and load-from - (not (fboundp func))) - (load load-from t)) - (or prompt-displayed - (not (gnus-convert-converter-needs-prompt func)) - (while (let (c - (cursor-in-echo-area t) - (echo-keystrokes 0)) - (message "Convert gnus from version '%s' to '%s'? (n/y/?)" - gnus-newsrc-file-version gnus-version) - (setq c (read-char-exclusive)) - - (cond ((or (eq c ?n) (eq c ?N)) - (error "Can not start gnus without converting")) - ((or (eq c ?y) (eq c ?Y)) - (setq prompt-displayed t) - nil) - ((eq c ?\?) - (message "This conversion is irreversible. \ - To be safe, you should backup your files before proceeding.") - (sit-for 5) - t) - (t - (gnus-message 3 "Ignoring unexpected input") - (sit-for 3) - t))))) - - (funcall func convert-to))) - (gnus-dribble-enter - (format ";Converted gnus from version '%s' to '%s'." - gnus-newsrc-file-version gnus-version))))))) - -(defun gnus-convert-mark-converter-prompt (converter no-prompt) - "Indicate whether CONVERTER requires gnus-convert-old-newsrc to - display the conversion prompt. NO-PROMPT may be nil (prompt), - t (no prompt), or any form that can be called as a function. - The form should return either t or nil." - (put converter 'gnus-convert-no-prompt no-prompt)) - -(defun gnus-convert-converter-needs-prompt (converter) - (let ((no-prompt (get converter 'gnus-convert-no-prompt))) - (not (if (memq no-prompt '(t nil)) - no-prompt - (funcall no-prompt))))) - -(defun gnus-convert-old-ticks (converting-to) - (let ((newsrc (cdr gnus-newsrc-alist)) - marks info dormant ticked) - (while (setq info (pop newsrc)) - (when (setq marks (gnus-info-marks info)) - (setq dormant (cdr (assq 'dormant marks)) - ticked (cdr (assq 'tick marks))) - (when (or dormant ticked) - (gnus-info-set-read - info - (gnus-add-to-range - (gnus-info-read info) - (nconc (gnus-uncompress-range dormant) - (gnus-uncompress-range ticked))))))))) - -(defun gnus-load (file) - "Load FILE, but in such a way that read errors can be reported." - (with-temp-buffer - (insert-file-contents file) - (while (not (eobp)) - (condition-case type - (let ((form (read (current-buffer)))) - (eval form)) - (error - (unless (eq (car type) 'end-of-file) - (let ((error (format "Error in %s line %d" file - (count-lines (point-min) (point))))) - (ding) - (unless (gnus-yes-or-no-p (concat error "; continue? ")) - (error "%s" error))))))))) - -(defun gnus-read-newsrc-el-file (file) - (let ((ding-file (concat file "d"))) - (when (file-exists-p ding-file) - ;; We always, always read the .eld file. - (gnus-message 5 "Reading %s..." ding-file) - (let (gnus-newsrc-assoc) - (let ((coding-system-for-read gnus-ding-file-coding-system)) - (gnus-load ding-file)) - ;; Older versions of `gnus-format-specs' are no longer valid - ;; in Oort Gnus 0.01. - (let ((version - (and gnus-newsrc-file-version - (gnus-continuum-version gnus-newsrc-file-version)))) - (when (or (not version) - (< version 5.090009)) - (setq gnus-format-specs gnus-default-format-specs))) - (when gnus-newsrc-assoc - (setq gnus-newsrc-alist gnus-newsrc-assoc)))) - (gnus-make-hashtable-from-newsrc-alist) - (when (file-newer-than-file-p file ding-file) - ;; Old format quick file - (gnus-message 5 "Reading %s..." file) - ;; The .el file is newer than the .eld file, so we read that one - ;; as well. - (gnus-read-old-newsrc-el-file file))) - (gnus-run-hooks 'gnus-read-newsrc-el-hook)) - -;; Parse the old-style quick startup file -(defun gnus-read-old-newsrc-el-file (file) - (let (newsrc killed marked group m info) - (prog1 - (let ((gnus-killed-assoc nil) - gnus-marked-assoc gnus-newsrc-alist gnus-newsrc-assoc) - (prog1 - (ignore-errors - (load file t t t)) - (setq newsrc gnus-newsrc-assoc - killed gnus-killed-assoc - marked gnus-marked-assoc))) - (setq gnus-newsrc-alist nil) - (while (setq group (pop newsrc)) - (if (setq info (gnus-get-info (car group))) - (progn - (gnus-info-set-read info (cddr group)) - (gnus-info-set-level - info (if (nth 1 group) gnus-level-default-subscribed - gnus-level-default-unsubscribed)) - (push info gnus-newsrc-alist)) - (push (setq info - (list (car group) - (if (nth 1 group) gnus-level-default-subscribed - gnus-level-default-unsubscribed) - (cddr group))) - gnus-newsrc-alist)) - ;; Copy marks into info. - (when (setq m (assoc (car group) marked)) - (unless (nthcdr 3 info) - (nconc info (list nil))) - (gnus-info-set-marks - info (list (cons 'tick (gnus-compress-sequence - (sort (cdr m) '<) t)))))) - (setq newsrc killed) - (while newsrc - (setcar newsrc (caar newsrc)) - (setq newsrc (cdr newsrc))) - (setq gnus-killed-list killed)) - ;; The .el file version of this variable does not begin with - ;; "options", while the .eld version does, so we just add it if it - ;; isn't there. - (when - gnus-newsrc-options - (when (not (string-match "^ *options" gnus-newsrc-options)) - (setq gnus-newsrc-options (concat "options " gnus-newsrc-options))) - (when (not (string-match "\n$" gnus-newsrc-options)) - (setq gnus-newsrc-options (concat gnus-newsrc-options "\n"))) - ;; Finally, if we read some options lines, we parse them. - (unless (string= gnus-newsrc-options "") - (gnus-newsrc-parse-options gnus-newsrc-options))) - - (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist)) - (gnus-make-hashtable-from-newsrc-alist))) - -(defun gnus-make-newsrc-file (file) - "Make server dependent file name by catenating FILE and server host name." - (let* ((file (expand-file-name file nil)) - (real-file (concat file "-" (nth 1 gnus-select-method)))) - (if (or (file-exists-p real-file) - (file-exists-p (concat real-file ".el")) - (file-exists-p (concat real-file ".eld"))) - real-file - file))) - -(defun gnus-newsrc-to-gnus-format () - (setq gnus-newsrc-options "") - (setq gnus-newsrc-options-n nil) - - (unless gnus-active-hashtb - (setq gnus-active-hashtb (gnus-make-hashtable 4096))) - (let ((buf (current-buffer)) - (already-read (> (length gnus-newsrc-alist) 1)) - group subscribed options-symbol newsrc Options-symbol - symbol reads num1) - (goto-char (point-min)) - ;; We intern the symbol `options' in the active hashtb so that we - ;; can `eq' against it later. - (set (setq options-symbol (intern "options" gnus-active-hashtb)) nil) - (set (setq Options-symbol (intern "Options" gnus-active-hashtb)) nil) - - (while (not (eobp)) - ;; We first read the first word on the line by narrowing and - ;; then reading into `gnus-active-hashtb'. Most groups will - ;; already exist in that hashtb, so this will save some string - ;; space. - (narrow-to-region - (point) - (progn (skip-chars-forward "^ \t!:\n") (point))) - (goto-char (point-min)) - (setq symbol - (and (/= (point-min) (point-max)) - (let ((obarray gnus-active-hashtb)) (read buf)))) - (widen) - ;; Now, the symbol we have read is either `options' or a group - ;; name. If it is an options line, we just add it to a string. - (cond - ((or (eq symbol options-symbol) - (eq symbol Options-symbol)) - (setq gnus-newsrc-options - ;; This concating is quite inefficient, but since our - ;; thorough studies show that approx 99.37% of all - ;; .newsrc files only contain a single options line, we - ;; don't give a damn, frankly, my dear. - (concat gnus-newsrc-options - (buffer-substring - (gnus-point-at-bol) - ;; Options may continue on the next line. - (or (and (re-search-forward "^[^ \t]" nil 'move) - (progn (beginning-of-line) (point))) - (point))))) - (forward-line -1)) - (symbol - ;; Group names can be just numbers. - (when (numberp symbol) - (setq symbol (intern (int-to-string symbol) gnus-active-hashtb))) - (unless (boundp symbol) - (set symbol nil)) - ;; It was a group name. - (setq subscribed (eq (char-after) ?:) - group (symbol-name symbol) - reads nil) - (if (eolp) - ;; If the line ends here, this is clearly a buggy line, so - ;; we put point a the beginning of line and let the cond - ;; below do the error handling. - (beginning-of-line) - ;; We skip to the beginning of the ranges. - (skip-chars-forward "!: \t")) - ;; We are now at the beginning of the list of read articles. - ;; We read them range by range. - (while - (cond - ((looking-at "[0-9]+") - ;; We narrow and read a number instead of buffer-substring/ - ;; string-to-number because it's faster. narrow/widen is - ;; faster than save-restriction/narrow, and save-restriction - ;; produces a garbage object. - (setq num1 (progn - (narrow-to-region (match-beginning 0) (match-end 0)) - (read buf))) - (widen) - ;; If the next character is a dash, then this is a range. - (if (eq (char-after) ?-) - (progn - ;; We read the upper bound of the range. - (forward-char 1) - (if (not (looking-at "[0-9]+")) - ;; This is a buggy line, by we pretend that - ;; it's kinda OK. Perhaps the user should be - ;; dinged? - (push num1 reads) - (push - (cons num1 - (progn - (narrow-to-region (match-beginning 0) - (match-end 0)) - (read buf))) - reads) - (widen))) - ;; It was just a simple number, so we add it to the - ;; list of ranges. - (push num1 reads)) - ;; If the next char in ?\n, then we have reached the end - ;; of the line and return nil. - (not (eq (char-after) ?\n))) - ((eq (char-after) ?\n) - ;; End of line, so we end. - nil) - (t - ;; Not numbers and not eol, so this might be a buggy - ;; line... - (unless (eobp) - ;; If it was eob instead of ?\n, we allow it. - ;; The line was buggy. - (setq group nil) - (gnus-error 3.1 "Mangled line: %s" - (buffer-substring (gnus-point-at-bol) - (gnus-point-at-eol)))) - nil)) - ;; Skip past ", ". Spaces are invalid in these ranges, but - ;; we allow them, because it's a common mistake to put a - ;; space after the comma. - (skip-chars-forward ", ")) - - ;; We have already read .newsrc.eld, so we gently update the - ;; data in the hash table with the information we have just - ;; read. - (when group - (let ((info (gnus-get-info group)) - level) - (if info - ;; There is an entry for this file in the alist. - (progn - (gnus-info-set-read info (nreverse reads)) - ;; We update the level very gently. In fact, we - ;; only change it if there's been a status change - ;; from subscribed to unsubscribed, or vice versa. - (setq level (gnus-info-level info)) - (cond ((and (<= level gnus-level-subscribed) - (not subscribed)) - (setq level (if reads - gnus-level-default-unsubscribed - (1+ gnus-level-default-unsubscribed)))) - ((and (> level gnus-level-subscribed) subscribed) - (setq level gnus-level-default-subscribed))) - (gnus-info-set-level info level)) - ;; This is a new group. - (setq info (list group - (if subscribed - gnus-level-default-subscribed - (if reads - (1+ gnus-level-subscribed) - gnus-level-default-unsubscribed)) - (nreverse reads)))) - (push info newsrc))))) - (forward-line 1)) - - (setq newsrc (nreverse newsrc)) - - (if (not already-read) - () - ;; We now have two newsrc lists - `newsrc', which is what we - ;; have read from .newsrc, and `gnus-newsrc-alist', which is - ;; what we've read from .newsrc.eld. We have to merge these - ;; lists. We do this by "attaching" any (foreign) groups in the - ;; gnus-newsrc-alist to the (native) group that precedes them. - (let ((rc (cdr gnus-newsrc-alist)) - (prev gnus-newsrc-alist) - entry mentry) - (while rc - (or (null (nth 4 (car rc))) ; It's a native group. - (assoc (caar rc) newsrc) ; It's already in the alist. - (if (setq entry (assoc (caar prev) newsrc)) - (setcdr (setq mentry (memq entry newsrc)) - (cons (car rc) (cdr mentry))) - (push (car rc) newsrc))) - (setq prev rc - rc (cdr rc))))) - - (setq gnus-newsrc-alist newsrc) - ;; We make the newsrc hashtb. - (gnus-make-hashtable-from-newsrc-alist) - - ;; Finally, if we read some options lines, we parse them. - (unless (string= gnus-newsrc-options "") - (gnus-newsrc-parse-options gnus-newsrc-options)))) - -;; Parse options lines to find "options -n !all rec.all" and stuff. -;; The return value will be a list on the form -;; ((regexp1 . ignore) -;; (regexp2 . subscribe)...) -;; When handling new newsgroups, groups that match a `ignore' regexp -;; will be ignored, and groups that match a `subscribe' regexp will be -;; subscribed. A line like -;; options -n !all rec.all -;; will lead to a list that looks like -;; (("^rec\\..+" . subscribe) -;; ("^.+" . ignore)) -;; So all "rec.*" groups will be subscribed, while all the other -;; groups will be ignored. Note that "options -n !all rec.all" is very -;; different from "options -n rec.all !all". -(defun gnus-newsrc-parse-options (options) - (let (out eol) - (save-excursion - (gnus-set-work-buffer) - (insert (regexp-quote options)) - ;; First we treat all continuation lines. - (goto-char (point-min)) - (while (re-search-forward "\n[ \t]+" nil t) - (replace-match " " t t)) - ;; Then we transform all "all"s into ".+"s. - (goto-char (point-min)) - (while (re-search-forward "\\ball\\b" nil t) - (replace-match ".+" t t)) - (goto-char (point-min)) - ;; We remove all other options than the "-n" ones. - (while (re-search-forward "[ \t]-[^n][^-]*" nil t) - (replace-match " ") - (forward-char -1)) - (goto-char (point-min)) - - ;; We are only interested in "options -n" lines - we - ;; ignore the other option lines. - (while (re-search-forward "[ \t]-n" nil t) - (setq eol - (or (save-excursion - (and (re-search-forward "[ \t]-n" (gnus-point-at-eol) t) - (- (point) 2))) - (gnus-point-at-eol))) - ;; Search for all "words"... - (while (re-search-forward "[^ \t,\n]+" eol t) - (if (eq (char-after (match-beginning 0)) ?!) - ;; If the word begins with a bang (!), this is a "not" - ;; spec. We put this spec (minus the bang) and the - ;; symbol `ignore' into the list. - (push (cons (concat - "^" (buffer-substring - (1+ (match-beginning 0)) - (match-end 0)) - "\\($\\|\\.\\)") - 'ignore) - out) - ;; There was no bang, so this is a "yes" spec. - (push (cons (concat "^" (match-string 0) "\\($\\|\\.\\)") - 'subscribe) - out)))) - - (setq gnus-newsrc-options-n out)))) - -(eval-and-compile - (defalias 'gnus-long-file-names - (if (fboundp 'msdos-long-file-names) - 'msdos-long-file-names - (lambda () t)))) - -(defun gnus-save-newsrc-file (&optional force) - "Save .newsrc file." - ;; Note: We cannot save .newsrc file if all newsgroups are removed - ;; from the variable gnus-newsrc-alist. - (when (and (or gnus-newsrc-alist gnus-killed-list) - gnus-current-startup-file) - ;; Save agent range limits for the currently active method. - (when gnus-agent - (gnus-agent-save-local force)) - - (save-excursion - (if (and (or gnus-use-dribble-file gnus-slave) - (not force) - (or (not gnus-dribble-buffer) - (not (buffer-name gnus-dribble-buffer)) - (zerop (save-excursion - (set-buffer gnus-dribble-buffer) - (buffer-size))))) - (gnus-message 4 "(No changes need to be saved)") - (gnus-run-hooks 'gnus-save-newsrc-hook) - (if gnus-slave - (gnus-slave-save-newsrc) - ;; Save .newsrc. - (when gnus-save-newsrc-file - (gnus-message 8 "Saving %s..." gnus-current-startup-file) - (gnus-gnus-to-newsrc-format) - (gnus-message 8 "Saving %s...done" gnus-current-startup-file)) - - ;; Save .newsrc.eld. - (set-buffer (gnus-get-buffer-create " *Gnus-newsrc*")) - (make-local-variable 'version-control) - (setq version-control gnus-backup-startup-file) - (setq buffer-file-name - (concat gnus-current-startup-file ".eld")) - (setq default-directory (file-name-directory buffer-file-name)) - (buffer-disable-undo) - (erase-buffer) - (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file) - - (if gnus-save-startup-file-via-temp-buffer - (let ((coding-system-for-write gnus-ding-file-coding-system) - (standard-output (current-buffer))) - (gnus-gnus-to-quick-newsrc-format) - (gnus-run-hooks 'gnus-save-quick-newsrc-hook) - (save-buffer)) - (let ((coding-system-for-write gnus-ding-file-coding-system) - (version-control gnus-backup-startup-file) - (startup-file (concat gnus-current-startup-file ".eld")) - (working-dir (file-name-directory gnus-current-startup-file)) - working-file - (i -1)) - ;; Generate the name of a non-existent file. - (while (progn (setq working-file - (format - (if (and (eq system-type 'ms-dos) - (not (gnus-long-file-names))) - "%s#%d.tm#" ; MSDOS limits files to 8+3 - (if (memq system-type '(vax-vms axp-vms)) - "%s$tmp$%d" - "%s#tmp#%d")) - working-dir (setq i (1+ i)))) - (file-exists-p working-file))) - - (unwind-protect - (progn - (gnus-with-output-to-file working-file - (gnus-gnus-to-quick-newsrc-format) - (gnus-run-hooks 'gnus-save-quick-newsrc-hook)) - - ;; These bindings will mislead the current buffer - ;; into thinking that it is visiting the startup - ;; file. - (let ((buffer-backed-up nil) - (buffer-file-name startup-file) - (file-precious-flag t) - (setmodes (file-modes startup-file))) - ;; Backup the current version of the startup file. - (backup-buffer) - - ;; Replace the existing startup file with the temp file. - (rename-file working-file startup-file t) - (set-file-modes startup-file setmodes))) - (condition-case nil - (delete-file working-file) - (file-error nil))))) - - (gnus-kill-buffer (current-buffer)) - (gnus-message - 5 "Saving %s.eld...done" gnus-current-startup-file)) - (gnus-dribble-delete-file) - (gnus-group-set-mode-line))))) - -(defun gnus-gnus-to-quick-newsrc-format (&optional minimal name &rest specific-variables) - "Print Gnus variables such as `gnus-newsrc-alist' in Lisp format." - (princ ";; -*- emacs-lisp -*-\n") - (if name - (princ (format ";; %s\n" name)) - (princ ";; Gnus startup file.\n")) - - (unless minimal - (princ "\ -;; Never delete this file -- if you want to force Gnus to read the -;; .newsrc file (if you have one), touch .newsrc instead.\n") - (princ "(setq gnus-newsrc-file-version ") - (princ (gnus-prin1-to-string gnus-version)) - (princ ")\n")) - - (let* ((print-quoted t) - (print-readably t) - (print-escape-multibyte nil) - (print-escape-nonascii t) - (print-length nil) - (print-level nil) - (print-circle nil) - (print-escape-newlines t) - (gnus-killed-list - (if (and gnus-save-killed-list - (stringp gnus-save-killed-list)) - (gnus-strip-killed-list) - gnus-killed-list)) - (variables - (or specific-variables - (if gnus-save-killed-list gnus-variable-list - ;; Remove the `gnus-killed-list' from the list of variables - ;; to be saved, if required. - (delq 'gnus-killed-list (copy-sequence gnus-variable-list))))) - ;; Peel off the "dummy" group. - (gnus-newsrc-alist (cdr gnus-newsrc-alist)) - variable) - ;; Insert the variables into the file. - (while variables - (when (and (boundp (setq variable (pop variables))) - (symbol-value variable)) - (princ "(setq ") - (princ (symbol-name variable)) - (princ " '") - (prin1 (symbol-value variable)) - (princ ")\n"))))) - -(defun gnus-strip-killed-list () - "Return the killed list minus the groups that match `gnus-save-killed-list'." - (let ((list gnus-killed-list) - olist) - (while list - (when (string-match gnus-save-killed-list (car list)) - (push (car list) olist)) - (pop list)) - (nreverse olist))) - -(defun gnus-gnus-to-newsrc-format () - ;; Generate and save the .newsrc file. - (save-excursion - (set-buffer (create-file-buffer gnus-current-startup-file)) - (let ((newsrc (cdr gnus-newsrc-alist)) - (standard-output (current-buffer)) - info ranges range method) - (setq buffer-file-name gnus-current-startup-file) - (setq default-directory (file-name-directory buffer-file-name)) - (buffer-disable-undo) - (erase-buffer) - ;; Write options. - (when gnus-newsrc-options - (insert gnus-newsrc-options)) - ;; Write subscribed and unsubscribed. - (while (setq info (pop newsrc)) - ;; Don't write foreign groups to .newsrc. - (when (or (null (setq method (gnus-info-method info))) - (equal method "native") - (inline (gnus-server-equal method gnus-select-method))) - (insert (gnus-info-group info) - (if (> (gnus-info-level info) gnus-level-subscribed) - "!" ":")) - (when (setq ranges (gnus-info-read info)) - (insert " ") - (if (not (listp (cdr ranges))) - (if (= (car ranges) (cdr ranges)) - (princ (car ranges)) - (princ (car ranges)) - (insert "-") - (princ (cdr ranges))) - (while (setq range (pop ranges)) - (if (or (atom range) (= (car range) (cdr range))) - (princ (or (and (atom range) range) (car range))) - (princ (car range)) - (insert "-") - (princ (cdr range))) - (when ranges - (insert ","))))) - (insert "\n"))) - (make-local-variable 'version-control) - (setq version-control 'never) - ;; It has been reported that sometime the modtime on the .newsrc - ;; file seems to be off. We really do want to overwrite it, so - ;; we clear the modtime here before saving. It's a bit odd, - ;; though... - ;; sometimes the modtime clear isn't sufficient. most brute force: - ;; delete the silly thing entirely first. but this fails to provide - ;; such niceties as .newsrc~ creation. - (if gnus-modtime-botch - (delete-file gnus-startup-file) - (clear-visited-file-modtime)) - (gnus-run-hooks 'gnus-save-standard-newsrc-hook) - (save-buffer) - (kill-buffer (current-buffer))))) - - -;;; -;;; Slave functions. -;;; - -(defvar gnus-slave-mode nil) - -(defun gnus-slave-mode () - "Minor mode for slave Gnusae." - (gnus-add-minor-mode 'gnus-slave-mode " Slave" (make-sparse-keymap)) - (gnus-run-hooks 'gnus-slave-mode-hook)) - -(defun gnus-slave-save-newsrc () - (save-excursion - (set-buffer gnus-dribble-buffer) - (let ((slave-name - (mm-make-temp-file (concat gnus-current-startup-file "-slave-"))) - (modes (ignore-errors - (file-modes (concat gnus-current-startup-file ".eld"))))) - (let ((coding-system-for-write gnus-ding-file-coding-system)) - (gnus-write-buffer slave-name)) - (when modes - (set-file-modes slave-name modes))))) - -(defun gnus-master-read-slave-newsrc () - (let ((slave-files - (directory-files - (file-name-directory gnus-current-startup-file) - t (concat - "^" (regexp-quote - (concat - (file-name-nondirectory gnus-current-startup-file) - "-slave-"))) - t)) - file) - (if (not slave-files) - () ; There are no slave files to read. - (gnus-message 7 "Reading slave newsrcs...") - (save-excursion - (set-buffer (gnus-get-buffer-create " *gnus slave*")) - (setq slave-files - (sort (mapcar (lambda (file) - (list (nth 5 (file-attributes file)) file)) - slave-files) - (lambda (f1 f2) - (or (< (caar f1) (caar f2)) - (< (nth 1 (car f1)) (nth 1 (car f2))))))) - (while slave-files - (erase-buffer) - (setq file (nth 1 (car slave-files))) - (nnheader-insert-file-contents file) - (when (condition-case () - (progn - (eval-buffer (current-buffer)) - t) - (error - (gnus-error 3.2 "Possible error in %s" file) - nil)) - (unless gnus-slave ; Slaves shouldn't delete these files. - (ignore-errors - (delete-file file)))) - (setq slave-files (cdr slave-files)))) - (gnus-dribble-touch) - (gnus-message 7 "Reading slave newsrcs...done")))) - - -;;; -;;; Group description. -;;; - -(defun gnus-read-all-descriptions-files () - (let ((methods (cons gnus-select-method - (nconc - (when (gnus-archive-server-wanted-p) - (list "archive")) - gnus-secondary-select-methods)))) - (while methods - (gnus-read-descriptions-file (car methods)) - (setq methods (cdr methods))) - t)) - -(defun gnus-read-descriptions-file (&optional method) - (let ((method (or method gnus-select-method)) - group) - (when (stringp method) - (setq method (gnus-server-to-method method))) - ;; We create the hashtable whether we manage to read the desc file - ;; to avoid trying to re-read after a failed read. - (unless gnus-description-hashtb - (setq gnus-description-hashtb - (gnus-make-hashtable (length gnus-active-hashtb)))) - ;; Mark this method's desc file as read. - (gnus-sethash (gnus-group-prefixed-name "" method) "Has read" - gnus-description-hashtb) - - (gnus-message 5 "Reading descriptions file via %s..." (car method)) - (cond - ((null (gnus-get-function method 'request-list-newsgroups t)) - t) - ((not (gnus-check-server method)) - (gnus-message 1 "Couldn't open server") - nil) - ((not (gnus-request-list-newsgroups method)) - (gnus-message 1 "Couldn't read newsgroups descriptions") - nil) - (t - (save-excursion - (save-restriction - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (when (or (search-forward "\n.\n" nil t) - (goto-char (point-max))) - (beginning-of-line) - (narrow-to-region (point-min) (point))) - ;; If these are groups from a foreign select method, we insert the - ;; group prefix in front of the group names. - (and method (not (inline - (gnus-server-equal - (gnus-server-get-method nil method) - (gnus-server-get-method - nil gnus-select-method)))) - (let ((prefix (gnus-group-prefixed-name "" method))) - (goto-char (point-min)) - (while (and (not (eobp)) - (progn (insert prefix) - (zerop (forward-line 1))))))) - (goto-char (point-min)) - (while (not (eobp)) - ;; If we get an error, we set group to 0, which is not a - ;; symbol... - (setq group - (condition-case () - (let ((obarray gnus-description-hashtb)) - ;; Group is set to a symbol interned in this - ;; hash table. - (read nntp-server-buffer)) - (error 0))) - (skip-chars-forward " \t") - ;; ... which leads to this line being effectively ignored. - (when (symbolp group) - (let* ((str (buffer-substring - (point) (progn (end-of-line) (point)))) - (name (symbol-name group)) - (charset - (or (gnus-group-name-charset method name) - (gnus-parameter-charset name) - gnus-default-charset))) - ;; Fixme: Don't decode in unibyte mode. - (when (and str charset (featurep 'mule)) - (setq str (mm-decode-coding-string str charset))) - (set group str))) - (forward-line 1)))) - (gnus-message 5 "Reading descriptions file...done") - t)))) - -(defun gnus-group-get-description (group) - "Get the description of a group by sending XGTITLE to the server." - (when (gnus-request-group-description group) - (save-excursion - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (when (looking-at "[^ \t]+[ \t]+\\(.*\\)") - (match-string 1))))) - -;;;###autoload -(defun gnus-declare-backend (name &rest abilities) - "Declare back end NAME with ABILITIES as a Gnus back end." - (setq gnus-valid-select-methods - (nconc gnus-valid-select-methods - (list (apply 'list name abilities)))) - (gnus-redefine-select-method-widget)) - -(defun gnus-set-default-directory () - "Set the default directory in the current buffer to `gnus-default-directory'. -If this variable is nil, don't do anything." - (setq default-directory - (if (and gnus-default-directory - (file-exists-p gnus-default-directory)) - (file-name-as-directory (expand-file-name gnus-default-directory)) - default-directory))) - -(defun gnus-display-time-event-handler () - (if (and (fboundp 'display-time-event-handler) - (gnus-boundp 'display-time-timer)) - (display-time-event-handler))) - -;;;###autoload -(defun gnus-fixup-nnimap-unread-after-getting-new-news () - (let (server group info) - (mapatoms - (lambda (sym) - (when (and (setq group (symbol-name sym)) - (gnus-group-entry group) - (setq info (symbol-value sym))) - (gnus-sethash group (cons (nth 2 info) (cdr (gnus-group-entry group))) - gnus-newsrc-hashtb))) - (if (boundp 'nnimap-mailbox-info) - (symbol-value 'nnimap-mailbox-info) - (make-vector 1 0))))) - - -(provide 'gnus-start) - -;; arch-tag: f4584a22-b7b7-4853-abfc-a637329af5d2 -;;; gnus-start.el ends here - - diff --git a/xemacs-packages/gnus/lisp/gnus-sum.el b/xemacs-packages/gnus/lisp/gnus-sum.el deleted file mode 100644 index 7a228e59..00000000 --- a/xemacs-packages/gnus/lisp/gnus-sum.el +++ /dev/null @@ -1,12032 +0,0 @@ -;;; gnus-sum.el --- summary mode commands for Gnus - -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile - (require 'cl) - (defvar tool-bar-mode)) - -(require 'gnus) -(require 'gnus-group) -(require 'gnus-spec) -(require 'gnus-range) -(require 'gnus-int) -(require 'gnus-undo) -(require 'gnus-util) -(require 'gmm-utils) -(require 'mm-decode) -(require 'nnoo) - -(autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t) -(autoload 'gnus-cache-write-active "gnus-cache") -(autoload 'gnus-mailing-list-insinuate "gnus-ml" nil t) -(autoload 'turn-on-gnus-mailing-list-mode "gnus-ml" nil t) -(autoload 'gnus-pick-line-number "gnus-salt" nil t) -(autoload 'mm-uu-dissect "mm-uu") -(autoload 'gnus-article-outlook-deuglify-article "deuglify" - "Deuglify broken Outlook (Express) articles and redisplay." - t) -(autoload 'gnus-article-outlook-unwrap-lines "deuglify" nil t) -(autoload 'gnus-article-outlook-repair-attribution "deuglify" nil t) -(autoload 'gnus-article-outlook-rearrange-citation "deuglify" nil t) - -(defun-when-void put-display-table (range value display-table) - "Set the value for char RANGE to VALUE in DISPLAY-TABLE. " - (ecase (type-of display-table) - (vector - (aset display-table range value)) - (char-table - (put-char-table range value display-table)))) - -(defun-when-void get-display-table (character display-table) - "Find value for CHARACTER in DISPLAY-TABLE. " - (ecase (type-of display-table) - (vector - (aref display-table character)) - (char-table - (get-char-table character display-table)))) - -(defcustom gnus-kill-summary-on-exit t - "*If non-nil, kill the summary buffer when you exit from it. -If nil, the summary will become a \"*Dead Summary*\" buffer, and -it will be killed sometime later." - :group 'gnus-summary-exit - :type 'boolean) - -(defcustom gnus-fetch-old-headers nil - "*Non-nil means that Gnus will try to build threads by grabbing old headers. -If an unread article in the group refers to an older, already read (or -just marked as read) article, the old article will not normally be -displayed in the Summary buffer. If this variable is t, Gnus -will attempt to grab the headers to the old articles, and thereby -build complete threads. If it has the value `some', only enough -headers to connect otherwise loose threads will be displayed. This -variable can also be a number. In that case, no more than that number -of old headers will be fetched. If it has the value `invisible', all -old headers will be fetched, but none will be displayed. - -The server has to support NOV for any of this to work." - :group 'gnus-thread - :type '(choice (const :tag "off" nil) - (const :tag "on" t) - (const some) - (const invisible) - number - (sexp :menu-tag "other" t))) - -(defcustom gnus-refer-thread-limit 200 - "*The number of old headers to fetch when doing \\\\[gnus-summary-refer-thread]. -If t, fetch all the available old headers." - :group 'gnus-thread - :type '(choice number - (sexp :menu-tag "other" t))) - -(defcustom gnus-summary-make-false-root 'adopt - "*nil means that Gnus won't gather loose threads. -If the root of a thread has expired or been read in a previous -session, the information necessary to build a complete thread has been -lost. Instead of having many small sub-threads from this original thread -scattered all over the summary buffer, Gnus can gather them. - -If non-nil, Gnus will try to gather all loose sub-threads from an -original thread into one large thread. - -If this variable is non-nil, it should be one of `none', `adopt', -`dummy' or `empty'. - -If this variable is `none', Gnus will not make a false root, but just -present the sub-threads after another. -If this variable is `dummy', Gnus will create a dummy root that will -have all the sub-threads as children. -If this variable is `adopt', Gnus will make one of the \"children\" -the parent and mark all the step-children as such. -If this variable is `empty', the \"children\" are printed with empty -subject fields. (Or rather, they will be printed with a string -given by the `gnus-summary-same-subject' variable.)" - :group 'gnus-thread - :type '(choice (const :tag "off" nil) - (const none) - (const dummy) - (const adopt) - (const empty))) - -(defcustom gnus-summary-make-false-root-always nil - "Always make a false dummy root." - :version "22.1" - :group 'gnus-thread - :type 'boolean) - -(defcustom gnus-summary-gather-exclude-subject "^ *$\\|^(none)$" - "*A regexp to match subjects to be excluded from loose thread gathering. -As loose thread gathering is done on subjects only, that means that -there can be many false gatherings performed. By rooting out certain -common subjects, gathering might become saner." - :group 'gnus-thread - :type 'regexp) - -(defcustom gnus-summary-gather-subject-limit nil - "*Maximum length of subject comparisons when gathering loose threads. -Use nil to compare full subjects. Setting this variable to a low -number will help gather threads that have been corrupted by -newsreaders chopping off subject lines, but it might also mean that -unrelated articles that have subject that happen to begin with the -same few characters will be incorrectly gathered. - -If this variable is `fuzzy', Gnus will use a fuzzy algorithm when -comparing subjects." - :group 'gnus-thread - :type '(choice (const :tag "off" nil) - (const fuzzy) - (sexp :menu-tag "on" t))) - -(defcustom gnus-simplify-subject-functions nil - "List of functions taking a string argument that simplify subjects. -The functions are applied recursively. - -Useful functions to put in this list include: -`gnus-simplify-subject-re', `gnus-simplify-subject-fuzzy', -`gnus-simplify-whitespace', and `gnus-simplify-all-whitespace'." - :group 'gnus-thread - :type '(repeat function)) - -(defcustom gnus-simplify-ignored-prefixes nil - "*Remove matches for this regexp from subject lines when simplifying fuzzily." - :group 'gnus-thread - :type '(choice (const :tag "off" nil) - regexp)) - -(defcustom gnus-build-sparse-threads nil - "*If non-nil, fill in the gaps in threads. -If `some', only fill in the gaps that are needed to tie loose threads -together. If `more', fill in all leaf nodes that Gnus can find. If -non-nil and non-`some', fill in all gaps that Gnus manages to guess." - :group 'gnus-thread - :type '(choice (const :tag "off" nil) - (const some) - (const more) - (sexp :menu-tag "all" t))) - -(defcustom gnus-summary-thread-gathering-function - 'gnus-gather-threads-by-subject - "*Function used for gathering loose threads. -There are two pre-defined functions: `gnus-gather-threads-by-subject', -which only takes Subjects into consideration; and -`gnus-gather-threads-by-references', which compared the References -headers of the articles to find matches." - :group 'gnus-thread - :type '(radio (function-item gnus-gather-threads-by-subject) - (function-item gnus-gather-threads-by-references) - (function :tag "other"))) - -(defcustom gnus-summary-same-subject "" - "*String indicating that the current article has the same subject as the previous. -This variable will only be used if the value of -`gnus-summary-make-false-root' is `empty'." - :group 'gnus-summary-format - :type 'string) - -(defcustom gnus-summary-goto-unread t - "*If t, many commands will go to the next unread article. -This applies to marking commands as well as other commands that -\"naturally\" select the next article, like, for instance, `SPC' at -the end of an article. - -If nil, the marking commands do NOT go to the next unread article -\(they go to the next article instead). If `never', commands that -usually go to the next unread article, will go to the next article, -whether it is read or not." - :group 'gnus-summary-marks - :link '(custom-manual "(gnus)Setting Marks") - :type '(choice (const :tag "off" nil) - (const never) - (sexp :menu-tag "on" t))) - -(defcustom gnus-summary-default-score 0 - "*Default article score level. -All scores generated by the score files will be added to this score. -If this variable is nil, scoring will be disabled." - :group 'gnus-score-default - :type '(choice (const :tag "disable") - integer)) - -(defcustom gnus-summary-default-high-score 0 - "*Default threshold for a high scored article. -An article will be highlighted as high scored if its score is greater -than this score." - :version "22.1" - :group 'gnus-score-default - :type 'integer) - -(defcustom gnus-summary-default-low-score 0 - "*Default threshold for a low scored article. -An article will be highlighted as low scored if its score is smaller -than this score." - :version "22.1" - :group 'gnus-score-default - :type 'integer) - -(defcustom gnus-summary-zcore-fuzz 0 - "*Fuzziness factor for the zcore in the summary buffer. -Articles with scores closer than this to `gnus-summary-default-score' -will not be marked." - :group 'gnus-summary-format - :type 'integer) - -(defcustom gnus-simplify-subject-fuzzy-regexp nil - "*Strings to be removed when doing fuzzy matches. -This can either be a regular expression or list of regular expressions -that will be removed from subject strings if fuzzy subject -simplification is selected." - :group 'gnus-thread - :type '(repeat regexp)) - -(defcustom gnus-show-threads t - "*If non-nil, display threads in summary mode." - :group 'gnus-thread - :type 'boolean) - -(defcustom gnus-thread-hide-subtree nil - "*If non-nil, hide all threads initially. -This can be a predicate specifier which says which threads to hide. -If threads are hidden, you have to run the command -`gnus-summary-show-thread' by hand or select an article." - :group 'gnus-thread - :type '(radio (sexp :format "Non-nil\n" - :match (lambda (widget value) - (not (or (consp value) (functionp value)))) - :value t) - (const nil) - (sexp :tag "Predicate specifier"))) - -(defcustom gnus-thread-hide-killed t - "*If non-nil, hide killed threads automatically." - :group 'gnus-thread - :type 'boolean) - -(defcustom gnus-thread-ignore-subject t - "*If non-nil, which is the default, ignore subjects and do all threading based on the Reference header. -If nil, articles that have different subjects from their parents will -start separate threads." - :group 'gnus-thread - :type 'boolean) - -(defcustom gnus-thread-operation-ignore-subject t - "*If non-nil, subjects will be ignored when doing thread commands. -This affects commands like `gnus-summary-kill-thread' and -`gnus-summary-lower-thread'. - -If this variable is nil, articles in the same thread with different -subjects will not be included in the operation in question. If this -variable is `fuzzy', only articles that have subjects that are fuzzily -equal will be included." - :group 'gnus-thread - :type '(choice (const :tag "off" nil) - (const fuzzy) - (sexp :tag "on" t))) - -(defcustom gnus-thread-indent-level 4 - "*Number that says how much each sub-thread should be indented." - :group 'gnus-thread - :type 'integer) - -(defcustom gnus-auto-extend-newsgroup t - "*If non-nil, extend newsgroup forward and backward when requested." - :group 'gnus-summary-choose - :type 'boolean) - -(defcustom gnus-auto-select-first t - "If non-nil, select an article on group entry. -An article is selected automatically when entering a group -e.g. with \\\\[gnus-group-read-group], or via `gnus-summary-next-page' or -`gnus-summary-catchup-and-goto-next-group'. - -Which article is selected is controlled by the variable -`gnus-auto-select-subject'. - -If you want to prevent automatic selection of articles in some -newsgroups, set the variable to nil in `gnus-select-group-hook'." - ;; Commands include... - ;; \\\\[gnus-group-read-group] - ;; \\\\[gnus-summary-next-page] - ;; \\\\[gnus-summary-catchup-and-goto-next-group] - :group 'gnus-group-select - :type '(choice (const :tag "none" nil) - (sexp :menu-tag "first" t))) - -(defcustom gnus-auto-select-subject 'unread - "*Says what subject to place under point when entering a group. - -This variable can either be the symbols `first' (place point on the -first subject), `unread' (place point on the subject line of the first -unread article), `best' (place point on the subject line of the -higest-scored article), `unseen' (place point on the subject line of -the first unseen article), `unseen-or-unread' (place point on the subject -line of the first unseen article or, if all article have been seen, on the -subject line of the first unread article), or a function to be called to -place point on some subject line." - :version "22.1" - :group 'gnus-group-select - :type '(choice (const best) - (const unread) - (const first) - (const unseen) - (const unseen-or-unread))) - -(defcustom gnus-auto-select-next t - "*If non-nil, offer to go to the next group from the end of the previous. -If the value is t and the next newsgroup is empty, Gnus will exit -summary mode and go back to group mode. If the value is neither nil -nor t, Gnus will select the following unread newsgroup. In -particular, if the value is the symbol `quietly', the next unread -newsgroup will be selected without any confirmation, and if it is -`almost-quietly', the next group will be selected without any -confirmation if you are located on the last article in the group. -Finally, if this variable is `slightly-quietly', the `\\\\[gnus-summary-catchup-and-goto-next-group]' command -will go to the next group without confirmation." - :group 'gnus-summary-maneuvering - :type '(choice (const :tag "off" nil) - (const quietly) - (const almost-quietly) - (const slightly-quietly) - (sexp :menu-tag "on" t))) - -(defcustom gnus-auto-select-same nil - "*If non-nil, select the next article with the same subject. -If there are no more articles with the same subject, go to -the first unread article." - :group 'gnus-summary-maneuvering - :type 'boolean) - -(defcustom gnus-auto-goto-ignores 'unfetched - "*Says how to handle unfetched articles when maneuvering. - -This variable can either be the symbols nil (maneuver to any -article), `undownloaded' (maneuvering while unplugged ignores articles -that have not been fetched), `always-undownloaded' (maneuvering always -ignores articles that have not been fetched), `unfetched' (maneuvering -ignores articles whose headers have not been fetched). - -NOTE: The list of unfetched articles will always be nil when plugged -and, when unplugged, a subset of the undownloaded article list." - :version "22.1" - :group 'gnus-summary-maneuvering - :type '(choice (const :tag "None" nil) - (const :tag "Undownloaded when unplugged" undownloaded) - (const :tag "Undownloaded" always-undownloaded) - (const :tag "Unfetched" unfetched))) - -(defcustom gnus-summary-check-current nil - "*If non-nil, consider the current article when moving. -The \"unread\" movement commands will stay on the same line if the -current article is unread." - :group 'gnus-summary-maneuvering - :type 'boolean) - -(defcustom gnus-auto-center-summary t - "*If non-nil, always center the current summary buffer. -In particular, if `vertical' do only vertical recentering. If non-nil -and non-`vertical', do both horizontal and vertical recentering." - :group 'gnus-summary-maneuvering - :type '(choice (const :tag "none" nil) - (const vertical) - (integer :tag "height") - (sexp :menu-tag "both" t))) - -(defvar gnus-auto-center-group t - "*If non-nil, always center the group buffer.") - -(defcustom gnus-show-all-headers nil - "*If non-nil, don't hide any headers." - :group 'gnus-article-hiding - :group 'gnus-article-headers - :type 'boolean) - -(defcustom gnus-summary-ignore-duplicates nil - "*If non-nil, ignore articles with identical Message-ID headers." - :group 'gnus-summary - :type 'boolean) - -(defcustom gnus-single-article-buffer t - "*If non-nil, display all articles in the same buffer. -If nil, each group will get its own article buffer." - :group 'gnus-article-various - :type 'boolean) - -(defcustom gnus-break-pages t - "*If non-nil, do page breaking on articles. -The page delimiter is specified by the `gnus-page-delimiter' -variable." - :group 'gnus-article-various - :type 'boolean) - -(defcustom gnus-move-split-methods nil - "*Variable used to suggest where articles are to be moved to. -It uses the same syntax as the `gnus-split-methods' variable. -However, whereas `gnus-split-methods' specifies file names as targets, -this variable specifies group names." - :group 'gnus-summary-mail - :type '(repeat (choice (list :value (fun) function) - (cons :value ("" "") regexp (repeat string)) - (sexp :value nil)))) - -;; FIXME: Although the custom type is `character' for the following variables, -;; using multibyte characters (Latin-1, UTF-8) doesn't work. -- rs - -(defcustom gnus-unread-mark ? ;Whitespace - "*Mark used for unread articles." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-ticked-mark ?! - "*Mark used for ticked articles." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-dormant-mark ?? - "*Mark used for dormant articles." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-del-mark ?r - "*Mark used for del'd articles." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-read-mark ?R - "*Mark used for read articles." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-expirable-mark ?E - "*Mark used for expirable articles." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-killed-mark ?K - "*Mark used for killed articles." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-spam-mark ?$ - "*Mark used for spam articles." - :version "22.1" - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-souped-mark ?F - "*Mark used for souped articles." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-kill-file-mark ?X - "*Mark used for articles killed by kill files." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-low-score-mark ?Y - "*Mark used for articles with a low score." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-catchup-mark ?C - "*Mark used for articles that are caught up." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-replied-mark ?A - "*Mark used for articles that have been replied to." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-forwarded-mark ?F - "*Mark used for articles that have been forwarded." - :version "22.1" - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-recent-mark ?N - "*Mark used for articles that are recent." - :version "22.1" - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-cached-mark ?* - "*Mark used for articles that are in the cache." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-saved-mark ?S - "*Mark used for articles that have been saved." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-unseen-mark ?. - "*Mark used for articles that haven't been seen." - :version "22.1" - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-no-mark ? ;Whitespace - "*Mark used for articles that have no other secondary mark." - :version "22.1" - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-ancient-mark ?O - "*Mark used for ancient articles." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-sparse-mark ?Q - "*Mark used for sparsely reffed articles." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-canceled-mark ?G - "*Mark used for canceled articles." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-duplicate-mark ?M - "*Mark used for duplicate articles." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-undownloaded-mark ?- - "*Mark used for articles that weren't downloaded." - :version "22.1" - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-downloaded-mark ?+ - "*Mark used for articles that were downloaded." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-downloadable-mark ?% - "*Mark used for articles that are to be downloaded." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-unsendable-mark ?= - "*Mark used for articles that won't be sent." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-score-over-mark ?+ - "*Score mark used for articles with high scores." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-score-below-mark ?- - "*Score mark used for articles with low scores." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-empty-thread-mark ? ;Whitespace - "*There is no thread under the article." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-not-empty-thread-mark ?= - "*There is a thread under the article." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-view-pseudo-asynchronously nil - "*If non-nil, Gnus will view pseudo-articles asynchronously." - :group 'gnus-extract-view - :type 'boolean) - -(defcustom gnus-auto-expirable-marks - (list gnus-killed-mark gnus-del-mark gnus-catchup-mark - gnus-low-score-mark gnus-ancient-mark gnus-read-mark - gnus-souped-mark gnus-duplicate-mark) - "*The list of marks converted into expiration if a group is auto-expirable." - :version "21.1" - :group 'gnus-summary - :type '(repeat character)) - -(defcustom gnus-inhibit-user-auto-expire t - "*If non-nil, user marking commands will not mark an article as expirable, even if the group has auto-expire turned on." - :version "21.1" - :group 'gnus-summary - :type 'boolean) - -(defcustom gnus-view-pseudos nil - "*If `automatic', pseudo-articles will be viewed automatically. -If `not-confirm', pseudos will be viewed automatically, and the user -will not be asked to confirm the command." - :group 'gnus-extract-view - :type '(choice (const :tag "off" nil) - (const automatic) - (const not-confirm))) - -(defcustom gnus-view-pseudos-separately t - "*If non-nil, one pseudo-article will be created for each file to be viewed. -If nil, all files that use the same viewing command will be given as a -list of parameters to that command." - :group 'gnus-extract-view - :type 'boolean) - -(defcustom gnus-insert-pseudo-articles t - "*If non-nil, insert pseudo-articles when decoding articles." - :group 'gnus-extract-view - :type 'boolean) - -(defcustom gnus-summary-dummy-line-format - " %(: :%) %S\n" - "*The format specification for the dummy roots in the summary buffer. -It works along the same lines as a normal formatting string, -with some simple extensions. - -%S The subject - -General format specifiers can also be used. -See `(gnus)Formatting Variables'." - :link '(custom-manual "(gnus)Formatting Variables") - :group 'gnus-threading - :type 'string) - -(defcustom gnus-summary-mode-line-format "Gnus: %g [%A] %Z" - "*The format specification for the summary mode line. -It works along the same lines as a normal formatting string, -with some simple extensions: - -%G Group name -%p Unprefixed group name -%A Current article number -%z Current article score -%V Gnus version -%U Number of unread articles in the group -%e Number of unselected articles in the group -%Z A string with unread/unselected article counts -%g Shortish group name -%S Subject of the current article -%u User-defined spec -%s Current score file name -%d Number of dormant articles -%r Number of articles that have been marked as read in this session -%E Number of articles expunged by the score files" - :group 'gnus-summary-format - :type 'string) - -(defcustom gnus-list-identifiers nil - "Regexp that matches list identifiers to be removed from subject. -This can also be a list of regexps." - :version "21.1" - :group 'gnus-summary-format - :group 'gnus-article-hiding - :type '(choice (const :tag "none" nil) - (regexp :value ".*") - (repeat :value (".*") regexp))) - -(defcustom gnus-summary-mark-below 0 - "*Mark all articles with a score below this variable as read. -This variable is local to each summary buffer and usually set by the -score file." - :group 'gnus-score-default - :type 'integer) - -(defcustom gnus-article-sort-functions '(gnus-article-sort-by-number) - "*List of functions used for sorting articles in the summary buffer. - -Each function takes two articles and returns non-nil if the first -article should be sorted before the other. If you use more than one -function, the primary sort function should be the last. You should -probably always include `gnus-article-sort-by-number' in the list of -sorting functions -- preferably first. Also note that sorting by date -is often much slower than sorting by number, and the sorting order is -very similar. (Sorting by date means sorting by the time the message -was sent, sorting by number means sorting by arrival time.) - -Ready-made functions include `gnus-article-sort-by-number', -`gnus-article-sort-by-author', `gnus-article-sort-by-subject', -`gnus-article-sort-by-date', `gnus-article-sort-by-random' -and `gnus-article-sort-by-score'. - -When threading is turned on, the variable `gnus-thread-sort-functions' -controls how articles are sorted." - :group 'gnus-summary-sort - :type '(repeat (choice (function-item gnus-article-sort-by-number) - (function-item gnus-article-sort-by-author) - (function-item gnus-article-sort-by-subject) - (function-item gnus-article-sort-by-date) - (function-item gnus-article-sort-by-score) - (function-item gnus-article-sort-by-random) - (function :tag "other")))) - -(defcustom gnus-thread-sort-functions '(gnus-thread-sort-by-number) - "*List of functions used for sorting threads in the summary buffer. -By default, threads are sorted by article number. - -Each function takes two threads and returns non-nil if the first -thread should be sorted before the other. If you use more than one -function, the primary sort function should be the last. You should -probably always include `gnus-thread-sort-by-number' in the list of -sorting functions -- preferably first. Also note that sorting by date -is often much slower than sorting by number, and the sorting order is -very similar. (Sorting by date means sorting by the time the message -was sent, sorting by number means sorting by arrival time.) - -Ready-made functions include `gnus-thread-sort-by-number', -`gnus-thread-sort-by-author', `gnus-thread-sort-by-subject', -`gnus-thread-sort-by-date', `gnus-thread-sort-by-score', -`gnus-thread-sort-by-most-recent-number', -`gnus-thread-sort-by-most-recent-date', -`gnus-thread-sort-by-random', and -`gnus-thread-sort-by-total-score' (see `gnus-thread-score-function'). - -When threading is turned off, the variable -`gnus-article-sort-functions' controls how articles are sorted." - :group 'gnus-summary-sort - :type '(repeat (choice (function-item gnus-thread-sort-by-number) - (function-item gnus-thread-sort-by-author) - (function-item gnus-thread-sort-by-subject) - (function-item gnus-thread-sort-by-date) - (function-item gnus-thread-sort-by-score) - (function-item gnus-thread-sort-by-total-score) - (function-item gnus-thread-sort-by-random) - (function :tag "other")))) - -(defcustom gnus-thread-score-function '+ - "*Function used for calculating the total score of a thread. - -The function is called with the scores of the article and each -subthread and should then return the score of the thread. - -Some functions you can use are `+', `max', or `min'." - :group 'gnus-summary-sort - :type 'function) - -(defcustom gnus-summary-expunge-below nil - "All articles that have a score less than this variable will be expunged. -This variable is local to the summary buffers." - :group 'gnus-score-default - :type '(choice (const :tag "off" nil) - integer)) - -(defcustom gnus-thread-expunge-below nil - "All threads that have a total score less than this variable will be expunged. -See `gnus-thread-score-function' for en explanation of what a -\"thread score\" is. - -This variable is local to the summary buffers." - :group 'gnus-threading - :group 'gnus-score-default - :type '(choice (const :tag "off" nil) - integer)) - -(defcustom gnus-summary-mode-hook nil - "*A hook for Gnus summary mode. -This hook is run before any variables are set in the summary buffer." - :options '(turn-on-gnus-mailing-list-mode gnus-pick-mode) - :group 'gnus-summary-various - :type 'hook) - -;; Extracted from gnus-xmas-redefine in order to preserve user settings -(when (featurep 'xemacs) - (add-hook 'gnus-summary-mode-hook 'gnus-xmas-summary-menu-add) - (add-hook 'gnus-summary-mode-hook 'gnus-xmas-setup-summary-toolbar) - (add-hook 'gnus-summary-mode-hook - 'gnus-xmas-switch-horizontal-scrollbar-off)) - -(defcustom gnus-summary-menu-hook nil - "*Hook run after the creation of the summary mode menu." - :group 'gnus-summary-visual - :type 'hook) - -(defcustom gnus-summary-exit-hook nil - "*A hook called on exit from the summary buffer. -It will be called with point in the group buffer." - :group 'gnus-summary-exit - :type 'hook) - -(defcustom gnus-summary-prepare-hook nil - "*A hook called after the summary buffer has been generated. -If you want to modify the summary buffer, you can use this hook." - :group 'gnus-summary-various - :type 'hook) - -(defcustom gnus-summary-prepared-hook nil - "*A hook called as the last thing after the summary buffer has been generated." - :group 'gnus-summary-various - :type 'hook) - -(defcustom gnus-summary-generate-hook nil - "*A hook run just before generating the summary buffer. -This hook is commonly used to customize threading variables and the -like." - :group 'gnus-summary-various - :type 'hook) - -(defcustom gnus-select-group-hook nil - "*A hook called when a newsgroup is selected. - -If you'd like to simplify subjects like the -`gnus-summary-next-same-subject' command does, you can use the -following hook: - - (add-hook gnus-select-group-hook - (lambda () - (mapcar (lambda (header) - (mail-header-set-subject - header - (gnus-simplify-subject - (mail-header-subject header) 're-only))) - gnus-newsgroup-headers)))" - :group 'gnus-group-select - :type 'hook) - -(defcustom gnus-select-article-hook nil - "*A hook called when an article is selected." - :group 'gnus-summary-choose - :options '(gnus-agent-fetch-selected-article) - :type 'hook) - -(defcustom gnus-visual-mark-article-hook - (list 'gnus-highlight-selected-summary) - "*Hook run after selecting an article in the summary buffer. -It is meant to be used for highlighting the article in some way. It -is not run if `gnus-visual' is nil." - :group 'gnus-summary-visual - :type 'hook) - -(defcustom gnus-parse-headers-hook nil - "*A hook called before parsing the headers." - :group 'gnus-various - :type 'hook) - -(defcustom gnus-exit-group-hook nil - "*A hook called when exiting summary mode. -This hook is not called from the non-updating exit commands like `Q'." - :group 'gnus-various - :type 'hook) - -(defcustom gnus-summary-update-hook - (list 'gnus-summary-highlight-line) - "*A hook called when a summary line is changed. -The hook will not be called if `gnus-visual' is nil. - -The default function `gnus-summary-highlight-line' will -highlight the line according to the `gnus-summary-highlight' -variable." - :group 'gnus-summary-visual - :type 'hook) - -(defcustom gnus-mark-article-hook '(gnus-summary-mark-read-and-unread-as-read) - "*A hook called when an article is selected for the first time. -The hook is intended to mark an article as read (or unread) -automatically when it is selected." - :group 'gnus-summary-choose - :type 'hook) - -(defcustom gnus-group-no-more-groups-hook nil - "*A hook run when returning to group mode having no more (unread) groups." - :group 'gnus-group-select - :type 'hook) - -(defcustom gnus-ps-print-hook nil - "*A hook run before ps-printing something from Gnus." - :group 'gnus-summary - :type 'hook) - -(defcustom gnus-summary-article-move-hook nil - "*A hook called after an article is moved, copied, respooled, or crossposted." - :version "22.1" - :group 'gnus-summary - :type 'hook) - -(defcustom gnus-summary-article-delete-hook nil - "*A hook called after an article is deleted." - :version "22.1" - :group 'gnus-summary - :type 'hook) - -(defcustom gnus-summary-article-expire-hook nil - "*A hook called after an article is expired." - :version "22.1" - :group 'gnus-summary - :type 'hook) - -(defcustom gnus-summary-display-arrow - (and (fboundp 'display-graphic-p) - (display-graphic-p)) - "*If non-nil, display an arrow highlighting the current article." - :version "22.1" - :group 'gnus-summary - :type 'boolean) - -(defcustom gnus-summary-selected-face 'gnus-summary-selected - "Face used for highlighting the current article in the summary buffer." - :group 'gnus-summary-visual - :type 'face) - -(defvar gnus-tmp-downloaded nil) - -(defcustom gnus-summary-highlight - '(((eq mark gnus-canceled-mark) - . gnus-summary-cancelled) - ((and uncached (> score default-high)) - . gnus-summary-high-undownloaded) - ((and uncached (< score default-low)) - . gnus-summary-low-undownloaded) - (uncached - . gnus-summary-normal-undownloaded) - ((and (> score default-high) - (or (eq mark gnus-dormant-mark) - (eq mark gnus-ticked-mark))) - . gnus-summary-high-ticked) - ((and (< score default-low) - (or (eq mark gnus-dormant-mark) - (eq mark gnus-ticked-mark))) - . gnus-summary-low-ticked) - ((or (eq mark gnus-dormant-mark) - (eq mark gnus-ticked-mark)) - . gnus-summary-normal-ticked) - ((and (> score default-high) (eq mark gnus-ancient-mark)) - . gnus-summary-high-ancient) - ((and (< score default-low) (eq mark gnus-ancient-mark)) - . gnus-summary-low-ancient) - ((eq mark gnus-ancient-mark) - . gnus-summary-normal-ancient) - ((and (> score default-high) (eq mark gnus-unread-mark)) - . gnus-summary-high-unread) - ((and (< score default-low) (eq mark gnus-unread-mark)) - . gnus-summary-low-unread) - ((eq mark gnus-unread-mark) - . gnus-summary-normal-unread) - ((> score default-high) - . gnus-summary-high-read) - ((< score default-low) - . gnus-summary-low-read) - (t - . gnus-summary-normal-read)) - "*Controls the highlighting of summary buffer lines. - -A list of (FORM . FACE) pairs. When deciding how a particular -summary line should be displayed, each form is evaluated. The content -of the face field after the first true form is used. You can change -how those summary lines are displayed, by editing the face field. - -You can use the following variables in the FORM field. - -score: The article's score. -default: The default article score. -default-high: The default score for high scored articles. -default-low: The default score for low scored articles. -below: The score below which articles are automatically marked as read. -mark: The article's mark. -uncached: Non-nil if the article is uncached." - :group 'gnus-summary-visual - :type '(repeat (cons (sexp :tag "Form" nil) - face))) -(put 'gnus-summary-highlight 'risky-local-variable t) - -(defcustom gnus-alter-header-function nil - "Function called to allow alteration of article header structures. -The function is called with one parameter, the article header vector, -which it may alter in any way." - :type '(choice (const :tag "None" nil) - function) - :group 'gnus-summary) - -(defvar gnus-decode-encoded-word-function 'mail-decode-encoded-word-string - "Function used to decode a string with encoded words.") - -(defvar gnus-decode-encoded-address-function - 'mail-decode-encoded-address-string - "Function used to decode addresses with encoded words.") - -(defcustom gnus-extra-headers '(To Newsgroups) - "*Extra headers to parse." - :version "21.1" - :group 'gnus-summary - :type '(repeat symbol)) - -(defcustom gnus-ignored-from-addresses - (and user-mail-address - (not (string= user-mail-address "")) - (regexp-quote user-mail-address)) - "*Regexp of From headers that may be suppressed in favor of To headers." - :version "21.1" - :group 'gnus-summary - :type 'regexp) - -(defcustom gnus-newsgroup-ignored-charsets '(unknown-8bit x-unknown) - "List of charsets that should be ignored. -When these charsets are used in the \"charset\" parameter, the -default charset will be used instead." - :version "21.1" - :type '(repeat symbol) - :group 'gnus-charset) - -(defcustom gnus-newsgroup-maximum-articles nil - "The maximum number of articles a newsgroup. -If this is a number, old articles in a newsgroup exceeding this number -are silently ignored. If it is nil, no article is ignored. Note that -setting this variable to a number might prevent you from reading very -old articles." - :group 'gnus-group-select - :version "22.2" - :type '(choice (const :tag "No limit" nil) - integer)) - -(gnus-define-group-parameter - ignored-charsets - :type list - :function-document - "Return the ignored charsets of GROUP." - :variable gnus-group-ignored-charsets-alist - :variable-default - '(("alt\\.chinese\\.text" iso-8859-1)) - :variable-document - "Alist of regexps (to match group names) and charsets that should be ignored. -When these charsets are used in the \"charset\" parameter, the -default charset will be used instead." - :variable-group gnus-charset - :variable-type '(repeat (cons (regexp :tag "Group") - (repeat symbol))) - :parameter-type '(choice :tag "Ignored charsets" - :value nil - (repeat (symbol))) - :parameter-document "\ -List of charsets that should be ignored. - -When these charsets are used in the \"charset\" parameter, the -default charset will be used instead.") - -(defcustom gnus-group-highlight-words-alist nil - "Alist of group regexps and highlight regexps. -This variable uses the same syntax as `gnus-emphasis-alist'." - :version "21.1" - :type '(repeat (cons (regexp :tag "Group") - (repeat (list (regexp :tag "Highlight regexp") - (number :tag "Group for entire word" 0) - (number :tag "Group for displayed part" 0) - (symbol :tag "Face" - gnus-emphasis-highlight-words))))) - :group 'gnus-summary-visual) - -(defcustom gnus-summary-show-article-charset-alist - nil - "Alist of number and charset. -The article will be shown with the charset corresponding to the -numbered argument. -For example: ((1 . cn-gb-2312) (2 . big5))." - :version "21.1" - :type '(repeat (cons (number :tag "Argument" 1) - (symbol :tag "Charset"))) - :group 'gnus-charset) - -(defcustom gnus-preserve-marks t - "Whether marks are preserved when moving, copying and respooling messages." - :version "21.1" - :type 'boolean - :group 'gnus-summary-marks) - -(defcustom gnus-alter-articles-to-read-function nil - "Function to be called to alter the list of articles to be selected." - :type '(choice (const nil) function) - :group 'gnus-summary) - -(defcustom gnus-orphan-score nil - "*All orphans get this score added. Set in the score file." - :group 'gnus-score-default - :type '(choice (const nil) - integer)) - -(defcustom gnus-summary-save-parts-default-mime "image/.*" - "*A regexp to match MIME parts when saving multiple parts of a -message with `gnus-summary-save-parts' (\\\\[gnus-summary-save-parts]). -This regexp will be used by default when prompting the user for which -type of files to save." - :group 'gnus-summary - :type 'regexp) - -(defcustom gnus-read-all-available-headers nil - "Whether Gnus should parse all headers made available to it. -This is mostly relevant for slow back ends where the user may -wish to widen the summary buffer to include all headers -that were fetched. Say, for nnultimate groups." - :version "22.1" - :group 'gnus-summary - :type '(choice boolean regexp)) - -(defcustom gnus-summary-muttprint-program "muttprint" - "Command (and optional arguments) used to run Muttprint." - :version "22.1" - :group 'gnus-summary - :type 'string) - -(defcustom gnus-article-loose-mime nil - "If non-nil, don't require MIME-Version header. -Some brain-damaged MUA/MTA, e.g. Lotus Domino 5.0.6 clients, does not -supply the MIME-Version header or deliberately strip it from the mail. -Set it to non-nil, Gnus will treat some articles as MIME even if -the MIME-Version header is missed." - :version "22.1" - :type 'boolean - :group 'gnus-article-mime) - -(defcustom gnus-article-emulate-mime t - "If non-nil, use MIME emulation for uuencode and the like. -This means that Gnus will search message bodies for text that look -like uuencoded bits, yEncoded bits, and so on, and present that using -the normal Gnus MIME machinery." - :version "22.1" - :type 'boolean - :group 'gnus-article-mime) - -;;; Internal variables - -(defvar gnus-summary-display-cache nil) -(defvar gnus-article-mime-handles nil) -(defvar gnus-article-decoded-p nil) -(defvar gnus-article-charset nil) -(defvar gnus-article-ignored-charsets nil) -(defvar gnus-scores-exclude-files nil) -(defvar gnus-page-broken nil) - -(defvar gnus-original-article nil) -(defvar gnus-article-internal-prepare-hook nil) -(defvar gnus-newsgroup-process-stack nil) - -(defvar gnus-thread-indent-array nil) -(defvar gnus-thread-indent-array-level gnus-thread-indent-level) -(defvar gnus-sort-gathered-threads-function 'gnus-thread-sort-by-number - "Function called to sort the articles within a thread after it has been gathered together.") - -(defvar gnus-summary-save-parts-type-history nil) -(defvar gnus-summary-save-parts-last-directory mm-default-directory) - -;; Avoid highlighting in kill files. -(defvar gnus-summary-inhibit-highlight nil) -(defvar gnus-newsgroup-selected-overlay nil) -(defvar gnus-inhibit-limiting nil) -(defvar gnus-newsgroup-adaptive-score-file nil) -(defvar gnus-current-score-file nil) -(defvar gnus-current-move-group nil) -(defvar gnus-current-copy-group nil) -(defvar gnus-current-crosspost-group nil) -(defvar gnus-newsgroup-display nil) - -(defvar gnus-newsgroup-dependencies nil) -(defvar gnus-newsgroup-adaptive nil) -(defvar gnus-summary-display-article-function nil) -(defvar gnus-summary-highlight-line-function nil - "Function called after highlighting a summary line.") - -(defvar gnus-summary-line-format-alist - `((?N ,(macroexpand '(mail-header-number gnus-tmp-header)) ?d) - (?S ,(macroexpand '(mail-header-subject gnus-tmp-header)) ?s) - (?s gnus-tmp-subject-or-nil ?s) - (?n gnus-tmp-name ?s) - (?A (car (cdr (funcall gnus-extract-address-components gnus-tmp-from))) - ?s) - (?a (or (car (funcall gnus-extract-address-components gnus-tmp-from)) - gnus-tmp-from) ?s) - (?F gnus-tmp-from ?s) - (?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s) - (?D ,(macroexpand '(mail-header-date gnus-tmp-header)) ?s) - (?d (gnus-dd-mmm (mail-header-date gnus-tmp-header)) ?s) - (?o (gnus-date-iso8601 (mail-header-date gnus-tmp-header)) ?s) - (?M ,(macroexpand '(mail-header-id gnus-tmp-header)) ?s) - (?r ,(macroexpand '(mail-header-references gnus-tmp-header)) ?s) - (?c (or (mail-header-chars gnus-tmp-header) 0) ?d) - (?k (gnus-summary-line-message-size gnus-tmp-header) ?s) - (?L gnus-tmp-lines ?s) - (?O gnus-tmp-downloaded ?c) - (?I gnus-tmp-indentation ?s) - (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s) - (?R gnus-tmp-replied ?c) - (?\[ gnus-tmp-opening-bracket ?c) - (?\] gnus-tmp-closing-bracket ?c) - (?\> (make-string gnus-tmp-level ? ) ?s) - (?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s) - (?i gnus-tmp-score ?d) - (?z gnus-tmp-score-char ?c) - (?l (bbb-grouplens-score gnus-tmp-header) ?s) - (?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d) - (?U gnus-tmp-unread ?c) - (?f (gnus-summary-from-or-to-or-newsgroups gnus-tmp-header gnus-tmp-from) - ?s) - (?t (gnus-summary-number-of-articles-in-thread - (and (boundp 'thread) (car thread)) gnus-tmp-level) - ?d) - (?e (gnus-summary-number-of-articles-in-thread - (and (boundp 'thread) (car thread)) gnus-tmp-level t) - ?c) - (?u gnus-tmp-user-defined ?s) - (?P (gnus-pick-line-number) ?d) - (?B gnus-tmp-thread-tree-header-string ?s) - (user-date (gnus-user-date - ,(macroexpand '(mail-header-date gnus-tmp-header))) ?s)) - "An alist of format specifications that can appear in summary lines. -These are paired with what variables they correspond with, along with -the type of the variable (string, integer, character, etc).") - -(defvar gnus-summary-dummy-line-format-alist - `((?S gnus-tmp-subject ?s) - (?N gnus-tmp-number ?d) - (?u gnus-tmp-user-defined ?s))) - -(defvar gnus-summary-mode-line-format-alist - `((?G gnus-tmp-group-name ?s) - (?g (gnus-short-group-name gnus-tmp-group-name) ?s) - (?p (gnus-group-real-name gnus-tmp-group-name) ?s) - (?A gnus-tmp-article-number ?d) - (?Z gnus-tmp-unread-and-unselected ?s) - (?V gnus-version ?s) - (?U gnus-tmp-unread-and-unticked ?d) - (?S gnus-tmp-subject ?s) - (?e gnus-tmp-unselected ?d) - (?u gnus-tmp-user-defined ?s) - (?d (length gnus-newsgroup-dormant) ?d) - (?t (length gnus-newsgroup-marked) ?d) - (?h (length gnus-newsgroup-spam-marked) ?d) - (?r (length gnus-newsgroup-reads) ?d) - (?z (gnus-summary-article-score gnus-tmp-article-number) ?d) - (?E gnus-newsgroup-expunged-tally ?d) - (?s (gnus-current-score-file-nondirectory) ?s))) - -(defvar gnus-last-search-regexp nil - "Default regexp for article search command.") - -(defvar gnus-last-shell-command nil - "Default shell command on article.") - -(defvar gnus-newsgroup-agentized nil - "Locally bound in each summary buffer to indicate whether the server has been agentized.") -(defvar gnus-newsgroup-begin nil) -(defvar gnus-newsgroup-end nil) -(defvar gnus-newsgroup-last-rmail nil) -(defvar gnus-newsgroup-last-mail nil) -(defvar gnus-newsgroup-last-folder nil) -(defvar gnus-newsgroup-last-file nil) -(defvar gnus-newsgroup-last-directory nil) -(defvar gnus-newsgroup-auto-expire nil) -(defvar gnus-newsgroup-active nil) - -(defvar gnus-newsgroup-data nil) -(defvar gnus-newsgroup-data-reverse nil) -(defvar gnus-newsgroup-limit nil) -(defvar gnus-newsgroup-limits nil) -(defvar gnus-summary-use-undownloaded-faces nil) - -(defvar gnus-newsgroup-unreads nil - "Sorted list of unread articles in the current newsgroup.") - -(defvar gnus-newsgroup-unselected nil - "Sorted list of unselected unread articles in the current newsgroup.") - -(defvar gnus-newsgroup-reads nil - "Alist of read articles and article marks in the current newsgroup.") - -(defvar gnus-newsgroup-expunged-tally nil) - -(defvar gnus-newsgroup-marked nil - "Sorted list of ticked articles in the current newsgroup (a subset of unread art).") - -(defvar gnus-newsgroup-spam-marked nil - "List of ranges of articles that have been marked as spam.") - -(defvar gnus-newsgroup-killed nil - "List of ranges of articles that have been through the scoring process.") - -(defvar gnus-newsgroup-cached nil - "Sorted list of articles that come from the article cache.") - -(defvar gnus-newsgroup-saved nil - "List of articles that have been saved.") - -(defvar gnus-newsgroup-kill-headers nil) - -(defvar gnus-newsgroup-replied nil - "List of articles that have been replied to in the current newsgroup.") - -(defvar gnus-newsgroup-forwarded nil - "List of articles that have been forwarded in the current newsgroup.") - -(defvar gnus-newsgroup-recent nil - "List of articles that have are recent in the current newsgroup.") - -(defvar gnus-newsgroup-expirable nil - "Sorted list of articles in the current newsgroup that can be expired.") - -(defvar gnus-newsgroup-processable nil - "List of articles in the current newsgroup that can be processed.") - -(defvar gnus-newsgroup-downloadable nil - "Sorted list of articles in the current newsgroup that can be processed.") - -(defvar gnus-newsgroup-unfetched nil - "Sorted list of articles in the current newsgroup whose headers have -not been fetched into the agent. - -This list will always be a subset of gnus-newsgroup-undownloaded.") - -(defvar gnus-newsgroup-undownloaded nil - "List of articles in the current newsgroup that haven't been downloaded.") - -(defvar gnus-newsgroup-unsendable nil - "List of articles in the current newsgroup that won't be sent.") - -(defvar gnus-newsgroup-bookmarks nil - "List of articles in the current newsgroup that have bookmarks.") - -(defvar gnus-newsgroup-dormant nil - "Sorted list of dormant articles in the current newsgroup.") - -(defvar gnus-newsgroup-unseen nil - "List of unseen articles in the current newsgroup.") - -(defvar gnus-newsgroup-seen nil - "Range of seen articles in the current newsgroup.") - -(defvar gnus-newsgroup-articles nil - "List of articles in the current newsgroup.") - -(defvar gnus-newsgroup-scored nil - "List of scored articles in the current newsgroup.") - -(defvar gnus-newsgroup-headers nil - "List of article headers in the current newsgroup.") - -(defvar gnus-newsgroup-threads nil) - -(defvar gnus-newsgroup-prepared nil - "Whether the current group has been prepared properly.") - -(defvar gnus-newsgroup-ancient nil - "List of `gnus-fetch-old-headers' articles in the current newsgroup.") - -(defvar gnus-newsgroup-sparse nil) - -(defvar gnus-current-article nil) -(defvar gnus-article-current nil) -(defvar gnus-current-headers nil) -(defvar gnus-have-all-headers nil) -(defvar gnus-last-article nil) -(defvar gnus-newsgroup-history nil) -(defvar gnus-newsgroup-charset nil) -(defvar gnus-newsgroup-ephemeral-charset nil) -(defvar gnus-newsgroup-ephemeral-ignored-charsets nil) - -(defvar gnus-article-before-search nil) - -(defvar gnus-summary-local-variables - '(gnus-newsgroup-name - gnus-newsgroup-begin gnus-newsgroup-end - gnus-newsgroup-last-rmail gnus-newsgroup-last-mail - gnus-newsgroup-last-folder gnus-newsgroup-last-file - gnus-newsgroup-last-directory - gnus-newsgroup-auto-expire gnus-newsgroup-unreads - gnus-newsgroup-unselected gnus-newsgroup-marked - gnus-newsgroup-spam-marked - gnus-newsgroup-reads gnus-newsgroup-saved - gnus-newsgroup-replied gnus-newsgroup-forwarded - gnus-newsgroup-recent - gnus-newsgroup-expirable - gnus-newsgroup-processable gnus-newsgroup-killed - gnus-newsgroup-downloadable gnus-newsgroup-undownloaded - gnus-newsgroup-unfetched - gnus-newsgroup-unsendable gnus-newsgroup-unseen - gnus-newsgroup-seen gnus-newsgroup-articles - gnus-newsgroup-bookmarks gnus-newsgroup-dormant - gnus-newsgroup-headers gnus-newsgroup-threads - gnus-newsgroup-prepared gnus-summary-highlight-line-function - gnus-current-article gnus-current-headers gnus-have-all-headers - gnus-last-article gnus-article-internal-prepare-hook - gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay - gnus-newsgroup-scored gnus-newsgroup-kill-headers - gnus-thread-expunge-below - gnus-score-alist gnus-current-score-file - (gnus-summary-expunge-below . global) - (gnus-summary-mark-below . global) - (gnus-orphan-score . global) - gnus-newsgroup-active gnus-scores-exclude-files - gnus-newsgroup-history gnus-newsgroup-ancient - gnus-newsgroup-sparse gnus-newsgroup-process-stack - (gnus-newsgroup-adaptive . gnus-use-adaptive-scoring) - gnus-newsgroup-adaptive-score-file (gnus-reffed-article-number . -1) - (gnus-newsgroup-expunged-tally . 0) - gnus-cache-removable-articles gnus-newsgroup-cached - gnus-newsgroup-data gnus-newsgroup-data-reverse - gnus-newsgroup-limit gnus-newsgroup-limits - gnus-newsgroup-charset gnus-newsgroup-display - gnus-summary-use-undownloaded-faces) - "Variables that are buffer-local to the summary buffers.") - -(defvar gnus-newsgroup-variables nil - "A list of variables that have separate values in different newsgroups. -A list of newsgroup (summary buffer) local variables, or cons of -variables and their default expressions to be evalled (when the default -values are not nil), that should be made global while the summary buffer -is active. - -Note: The default expressions will be evaluated (using function `eval') -before assignment to the local variable rather than just assigned to it. -If the default expression is the symbol `global', that symbol will not -be evaluated but the global value of the local variable will be used -instead. - -These variables can be used to set variables in the group parameters -while still allowing them to affect operations done in other buffers. -For example: - -\(setq gnus-newsgroup-variables - '(message-use-followup-to - (gnus-visible-headers . - \"^From:\\\\|^Newsgroups:\\\\|^Subject:\\\\|^Date:\\\\|^To:\"))) -") - -;; Byte-compiler warning. -(eval-when-compile - ;; Bind features so that require will believe that gnus-sum has - ;; already been loaded (avoids infinite recursion) - (let ((features (cons 'gnus-sum features))) - ;; Several of the declarations in gnus-sum are needed to load the - ;; following files. Right now, these definitions have been - ;; compiled but not defined (evaluated). We could either do a - ;; eval-and-compile about all of the declarations or evaluate the - ;; source file. - (if (boundp 'gnus-newsgroup-variables) - nil - (load "gnus-sum.el" t t t)) - (require 'gnus) - (require 'gnus-agent) - (require 'gnus-art))) - -;; MIME stuff. - -(defvar gnus-decode-encoded-word-methods - '(mail-decode-encoded-word-string) - "List of methods used to decode encoded words. - -This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item -is FUNCTION, FUNCTION will be apply to all newsgroups. If item is a -\(REGEXP . FUNCTION), FUNCTION will be only apply to thes newsgroups -whose names match REGEXP. - -For example: -\((\"chinese\" . gnus-decode-encoded-word-string-by-guess) - mail-decode-encoded-word-string - (\"chinese\" . rfc1843-decode-string))") - -(defvar gnus-decode-encoded-word-methods-cache nil) - -(defun gnus-multi-decode-encoded-word-string (string) - "Apply the functions from `gnus-encoded-word-methods' that match." - (unless (and gnus-decode-encoded-word-methods-cache - (eq gnus-newsgroup-name - (car gnus-decode-encoded-word-methods-cache))) - (setq gnus-decode-encoded-word-methods-cache (list gnus-newsgroup-name)) - (mapcar (lambda (x) - (if (symbolp x) - (nconc gnus-decode-encoded-word-methods-cache (list x)) - (if (and gnus-newsgroup-name - (string-match (car x) gnus-newsgroup-name)) - (nconc gnus-decode-encoded-word-methods-cache - (list (cdr x)))))) - gnus-decode-encoded-word-methods)) - (let ((xlist gnus-decode-encoded-word-methods-cache)) - (pop xlist) - (while xlist - (setq string (funcall (pop xlist) string)))) - string) - -;; Subject simplification. - -(defun gnus-simplify-whitespace (str) - "Remove excessive whitespace from STR." - ;; Multiple spaces. - (while (string-match "[ \t][ \t]+" str) - (setq str (concat (substring str 0 (match-beginning 0)) - " " - (substring str (match-end 0))))) - ;; Leading spaces. - (when (string-match "^[ \t]+" str) - (setq str (substring str (match-end 0)))) - ;; Trailing spaces. - (when (string-match "[ \t]+$" str) - (setq str (substring str 0 (match-beginning 0)))) - str) - -(defun gnus-simplify-all-whitespace (str) - "Remove all whitespace from STR." - (while (string-match "[ \t\n]+" str) - (setq str (replace-match "" nil nil str))) - str) - -(defsubst gnus-simplify-subject-re (subject) - "Remove \"Re:\" from subject lines." - (if (string-match message-subject-re-regexp subject) - (substring subject (match-end 0)) - subject)) - -(defun gnus-simplify-subject (subject &optional re-only) - "Remove `Re:' and words in parentheses. -If RE-ONLY is non-nil, strip leading `Re:'s only." - (let ((case-fold-search t)) ;Ignore case. - ;; Remove `Re:', `Re^N:', `Re(n)', and `Re[n]:'. - (when (string-match "\\`\\(re\\([[(^][0-9]+[])]?\\)?:[ \t]*\\)+" subject) - (setq subject (substring subject (match-end 0)))) - ;; Remove uninteresting prefixes. - (when (and (not re-only) - gnus-simplify-ignored-prefixes - (string-match gnus-simplify-ignored-prefixes subject)) - (setq subject (substring subject (match-end 0)))) - ;; Remove words in parentheses from end. - (unless re-only - (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject) - (setq subject (substring subject 0 (match-beginning 0))))) - ;; Return subject string. - subject)) - -;; Remove any leading "re:"s, any trailing paren phrases, and simplify -;; all whitespace. -(defsubst gnus-simplify-buffer-fuzzy-step (regexp &optional newtext) - (goto-char (point-min)) - (while (re-search-forward regexp nil t) - (replace-match (or newtext "")))) - -(defun gnus-simplify-buffer-fuzzy () - "Simplify string in the buffer fuzzily. -The string in the accessible portion of the current buffer is simplified. -It is assumed to be a single-line subject. -Whitespace is generally cleaned up, and miscellaneous leading/trailing -matter is removed. Additional things can be deleted by setting -`gnus-simplify-subject-fuzzy-regexp'." - (let ((case-fold-search t) - (modified-tick)) - (gnus-simplify-buffer-fuzzy-step "\t" " ") - - (while (not (eq modified-tick (buffer-modified-tick))) - (setq modified-tick (buffer-modified-tick)) - (cond - ((listp gnus-simplify-subject-fuzzy-regexp) - (mapcar 'gnus-simplify-buffer-fuzzy-step - gnus-simplify-subject-fuzzy-regexp)) - (gnus-simplify-subject-fuzzy-regexp - (gnus-simplify-buffer-fuzzy-step gnus-simplify-subject-fuzzy-regexp))) - (gnus-simplify-buffer-fuzzy-step "^ *\\[[-+?*!][-+?*!]\\] *") - (gnus-simplify-buffer-fuzzy-step - "^ *\\(re\\|fw\\|fwd\\)[[{(^0-9]*[])}]?[:;] *") - (gnus-simplify-buffer-fuzzy-step "^[[].*:\\( .*\\)[]]$" "\\1")) - - (gnus-simplify-buffer-fuzzy-step " *[[{(][^()\n]*[]})] *$") - (gnus-simplify-buffer-fuzzy-step " +" " ") - (gnus-simplify-buffer-fuzzy-step " $") - (gnus-simplify-buffer-fuzzy-step "^ +"))) - -(defun gnus-simplify-subject-fuzzy (subject) - "Simplify a subject string fuzzily. -See `gnus-simplify-buffer-fuzzy' for details." - (save-excursion - (gnus-set-work-buffer) - (let ((case-fold-search t)) - ;; Remove uninteresting prefixes. - (when (and gnus-simplify-ignored-prefixes - (string-match gnus-simplify-ignored-prefixes subject)) - (setq subject (substring subject (match-end 0)))) - (insert subject) - (inline (gnus-simplify-buffer-fuzzy)) - (buffer-string)))) - -(defsubst gnus-simplify-subject-fully (subject) - "Simplify a subject string according to `gnus-summary-gather-subject-limit'." - (cond - (gnus-simplify-subject-functions - (gnus-map-function gnus-simplify-subject-functions subject)) - ((null gnus-summary-gather-subject-limit) - (gnus-simplify-subject-re subject)) - ((eq gnus-summary-gather-subject-limit 'fuzzy) - (gnus-simplify-subject-fuzzy subject)) - ((numberp gnus-summary-gather-subject-limit) - (gnus-limit-string (gnus-simplify-subject-re subject) - gnus-summary-gather-subject-limit)) - (t - subject))) - -(defsubst gnus-subject-equal (s1 s2 &optional simple-first) - "Check whether two subjects are equal. -If optional argument SIMPLE-FIRST is t, first argument is already -simplified." - (cond - ((null simple-first) - (equal (gnus-simplify-subject-fully s1) - (gnus-simplify-subject-fully s2))) - (t - (equal s1 - (gnus-simplify-subject-fully s2))))) - -(defun gnus-summary-bubble-group () - "Increase the score of the current group. -This is a handy function to add to `gnus-summary-exit-hook' to -increase the score of each group you read." - (gnus-group-add-score gnus-newsgroup-name)) - - -;;; -;;; Gnus summary mode -;;; - -(put 'gnus-summary-mode 'mode-class 'special) - -(defvar gnus-article-commands-menu) - -;; Non-orthogonal keys - -(gnus-define-keys gnus-summary-mode-map - " " gnus-summary-next-page - "\177" gnus-summary-prev-page - [delete] gnus-summary-prev-page - [backspace] gnus-summary-prev-page - "\r" gnus-summary-scroll-up - "\M-\r" gnus-summary-scroll-down - "n" gnus-summary-next-unread-article - "p" gnus-summary-prev-unread-article - "N" gnus-summary-next-article - "P" gnus-summary-prev-article - "\M-\C-n" gnus-summary-next-same-subject - "\M-\C-p" gnus-summary-prev-same-subject - "\M-n" gnus-summary-next-unread-subject - "\M-p" gnus-summary-prev-unread-subject - "." gnus-summary-first-unread-article - "," gnus-summary-best-unread-article - "\M-s" gnus-summary-search-article-forward - "\M-r" gnus-summary-search-article-backward - "<" gnus-summary-beginning-of-article - ">" gnus-summary-end-of-article - "j" gnus-summary-goto-article - "^" gnus-summary-refer-parent-article - "\M-^" gnus-summary-refer-article - "u" gnus-summary-tick-article-forward - "!" gnus-summary-tick-article-forward - "U" gnus-summary-tick-article-backward - "d" gnus-summary-mark-as-read-forward - "D" gnus-summary-mark-as-read-backward - "E" gnus-summary-mark-as-expirable - "\M-u" gnus-summary-clear-mark-forward - "\M-U" gnus-summary-clear-mark-backward - "k" gnus-summary-kill-same-subject-and-select - "\C-k" gnus-summary-kill-same-subject - "\M-\C-k" gnus-summary-kill-thread - "\M-\C-l" gnus-summary-lower-thread - "e" gnus-summary-edit-article - "#" gnus-summary-mark-as-processable - "\M-#" gnus-summary-unmark-as-processable - "\M-\C-t" gnus-summary-toggle-threads - "\M-\C-s" gnus-summary-show-thread - "\M-\C-h" gnus-summary-hide-thread - "\M-\C-f" gnus-summary-next-thread - "\M-\C-b" gnus-summary-prev-thread - [(meta down)] gnus-summary-next-thread - [(meta up)] gnus-summary-prev-thread - "\M-\C-u" gnus-summary-up-thread - "\M-\C-d" gnus-summary-down-thread - "&" gnus-summary-execute-command - "c" gnus-summary-catchup-and-exit - "\C-w" gnus-summary-mark-region-as-read - "\C-t" gnus-summary-toggle-truncation - "?" gnus-summary-mark-as-dormant - "\C-c\M-\C-s" gnus-summary-limit-include-expunged - "\C-c\C-s\C-n" gnus-summary-sort-by-number - "\C-c\C-s\C-l" gnus-summary-sort-by-lines - "\C-c\C-s\C-c" gnus-summary-sort-by-chars - "\C-c\C-s\C-a" gnus-summary-sort-by-author - "\C-c\C-s\C-s" gnus-summary-sort-by-subject - "\C-c\C-s\C-d" gnus-summary-sort-by-date - "\C-c\C-s\C-i" gnus-summary-sort-by-score - "\C-c\C-s\C-o" gnus-summary-sort-by-original - "\C-c\C-s\C-r" gnus-summary-sort-by-random - "=" gnus-summary-expand-window - "\C-x\C-s" gnus-summary-reselect-current-group - "\M-g" gnus-summary-rescan-group - "w" gnus-summary-stop-page-breaking - "\C-c\C-r" gnus-summary-caesar-message - "f" gnus-summary-followup - "F" gnus-summary-followup-with-original - "C" gnus-summary-cancel-article - "r" gnus-summary-reply - "R" gnus-summary-reply-with-original - "\C-c\C-f" gnus-summary-mail-forward - "o" gnus-summary-save-article - "\C-o" gnus-summary-save-article-mail - "|" gnus-summary-pipe-output - "\M-k" gnus-summary-edit-local-kill - "\M-K" gnus-summary-edit-global-kill - ;; "V" gnus-version - "\C-c\C-d" gnus-summary-describe-group - "q" gnus-summary-exit - "Q" gnus-summary-exit-no-update - "\C-c\C-i" gnus-info-find-node - gnus-mouse-2 gnus-mouse-pick-article - [follow-link] mouse-face - "m" gnus-summary-mail-other-window - "a" gnus-summary-post-news - "i" gnus-summary-news-other-window - "x" gnus-summary-limit-to-unread - "s" gnus-summary-isearch-article - "t" gnus-summary-toggle-header - "g" gnus-summary-show-article - "l" gnus-summary-goto-last-article - "\C-c\C-v\C-v" gnus-uu-decode-uu-view - "\C-d" gnus-summary-enter-digest-group - "\M-\C-d" gnus-summary-read-document - "\M-\C-e" gnus-summary-edit-parameters - "\M-\C-a" gnus-summary-customize-parameters - "\C-c\C-b" gnus-bug - "*" gnus-cache-enter-article - "\M-*" gnus-cache-remove-article - "\M-&" gnus-summary-universal-argument - "\C-l" gnus-recenter - "I" gnus-summary-increase-score - "L" gnus-summary-lower-score - "\M-i" gnus-symbolic-argument - "h" gnus-summary-select-article-buffer - - "b" gnus-article-view-part - "\M-t" gnus-summary-toggle-display-buttonized - - "V" gnus-summary-score-map - "X" gnus-uu-extract-map - "S" gnus-summary-send-map) - -;; Sort of orthogonal keymap -(gnus-define-keys (gnus-summary-mark-map "M" gnus-summary-mode-map) - "t" gnus-summary-tick-article-forward - "!" gnus-summary-tick-article-forward - "d" gnus-summary-mark-as-read-forward - "r" gnus-summary-mark-as-read-forward - "c" gnus-summary-clear-mark-forward - " " gnus-summary-clear-mark-forward - "e" gnus-summary-mark-as-expirable - "x" gnus-summary-mark-as-expirable - "?" gnus-summary-mark-as-dormant - "b" gnus-summary-set-bookmark - "B" gnus-summary-remove-bookmark - "#" gnus-summary-mark-as-processable - "\M-#" gnus-summary-unmark-as-processable - "S" gnus-summary-limit-include-expunged - "C" gnus-summary-catchup - "H" gnus-summary-catchup-to-here - "h" gnus-summary-catchup-from-here - "\C-c" gnus-summary-catchup-all - "k" gnus-summary-kill-same-subject-and-select - "K" gnus-summary-kill-same-subject - "P" gnus-uu-mark-map) - -(gnus-define-keys (gnus-summary-mscore-map "V" gnus-summary-mark-map) - "c" gnus-summary-clear-above - "u" gnus-summary-tick-above - "m" gnus-summary-mark-above - "k" gnus-summary-kill-below) - -(gnus-define-keys (gnus-summary-limit-map "/" gnus-summary-mode-map) - "/" gnus-summary-limit-to-subject - "n" gnus-summary-limit-to-articles - "w" gnus-summary-pop-limit - "s" gnus-summary-limit-to-subject - "a" gnus-summary-limit-to-author - "u" gnus-summary-limit-to-unread - "m" gnus-summary-limit-to-marks - "M" gnus-summary-limit-exclude-marks - "v" gnus-summary-limit-to-score - "*" gnus-summary-limit-include-cached - "D" gnus-summary-limit-include-dormant - "T" gnus-summary-limit-include-thread - "d" gnus-summary-limit-exclude-dormant - "t" gnus-summary-limit-to-age - "." gnus-summary-limit-to-unseen - "x" gnus-summary-limit-to-extra - "p" gnus-summary-limit-to-display-predicate - "E" gnus-summary-limit-include-expunged - "c" gnus-summary-limit-exclude-childless-dormant - "C" gnus-summary-limit-mark-excluded-as-read - "o" gnus-summary-insert-old-articles - "N" gnus-summary-insert-new-articles) - -(gnus-define-keys (gnus-summary-goto-map "G" gnus-summary-mode-map) - "n" gnus-summary-next-unread-article - "p" gnus-summary-prev-unread-article - "N" gnus-summary-next-article - "P" gnus-summary-prev-article - "\C-n" gnus-summary-next-same-subject - "\C-p" gnus-summary-prev-same-subject - "\M-n" gnus-summary-next-unread-subject - "\M-p" gnus-summary-prev-unread-subject - "f" gnus-summary-first-unread-article - "b" gnus-summary-best-unread-article - "j" gnus-summary-goto-article - "g" gnus-summary-goto-subject - "l" gnus-summary-goto-last-article - "o" gnus-summary-pop-article) - -(gnus-define-keys (gnus-summary-thread-map "T" gnus-summary-mode-map) - "k" gnus-summary-kill-thread - "l" gnus-summary-lower-thread - "i" gnus-summary-raise-thread - "T" gnus-summary-toggle-threads - "t" gnus-summary-rethread-current - "^" gnus-summary-reparent-thread - "s" gnus-summary-show-thread - "S" gnus-summary-show-all-threads - "h" gnus-summary-hide-thread - "H" gnus-summary-hide-all-threads - "n" gnus-summary-next-thread - "p" gnus-summary-prev-thread - "u" gnus-summary-up-thread - "o" gnus-summary-top-thread - "d" gnus-summary-down-thread - "#" gnus-uu-mark-thread - "\M-#" gnus-uu-unmark-thread) - -(gnus-define-keys (gnus-summary-buffer-map "Y" gnus-summary-mode-map) - "g" gnus-summary-prepare - "c" gnus-summary-insert-cached-articles - "d" gnus-summary-insert-dormant-articles) - -(gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map) - "c" gnus-summary-catchup-and-exit - "C" gnus-summary-catchup-all-and-exit - "E" gnus-summary-exit-no-update - "Q" gnus-summary-exit - "Z" gnus-summary-exit - "n" gnus-summary-catchup-and-goto-next-group - "R" gnus-summary-reselect-current-group - "G" gnus-summary-rescan-group - "N" gnus-summary-next-group - "s" gnus-summary-save-newsrc - "P" gnus-summary-prev-group) - -(gnus-define-keys (gnus-summary-article-map "A" gnus-summary-mode-map) - " " gnus-summary-next-page - "n" gnus-summary-next-page - "\177" gnus-summary-prev-page - [delete] gnus-summary-prev-page - "p" gnus-summary-prev-page - "\r" gnus-summary-scroll-up - "\M-\r" gnus-summary-scroll-down - "<" gnus-summary-beginning-of-article - ">" gnus-summary-end-of-article - "b" gnus-summary-beginning-of-article - "e" gnus-summary-end-of-article - "^" gnus-summary-refer-parent-article - "r" gnus-summary-refer-parent-article - "D" gnus-summary-enter-digest-group - "R" gnus-summary-refer-references - "T" gnus-summary-refer-thread - "g" gnus-summary-show-article - "s" gnus-summary-isearch-article - "P" gnus-summary-print-article - "M" gnus-mailing-list-insinuate - "t" gnus-article-babel) - -(gnus-define-keys (gnus-summary-wash-map "W" gnus-summary-mode-map) - "b" gnus-article-add-buttons - "B" gnus-article-add-buttons-to-head - "o" gnus-article-treat-overstrike - "e" gnus-article-emphasize - "w" gnus-article-fill-cited-article - "Q" gnus-article-fill-long-lines - "C" gnus-article-capitalize-sentences - "c" gnus-article-remove-cr - "q" gnus-article-de-quoted-unreadable - "6" gnus-article-de-base64-unreadable - "Z" gnus-article-decode-HZ - "h" gnus-article-wash-html - "u" gnus-article-unsplit-urls - "s" gnus-summary-force-verify-and-decrypt - "f" gnus-article-display-x-face - "l" gnus-summary-stop-page-breaking - "r" gnus-summary-caesar-message - "m" gnus-summary-morse-message - "t" gnus-summary-toggle-header - "g" gnus-treat-smiley - "v" gnus-summary-verbose-headers - "a" gnus-article-strip-headers-in-body ;; mnemonic: wash archive - "p" gnus-article-verify-x-pgp-sig - "d" gnus-article-treat-dumbquotes) - -(gnus-define-keys (gnus-summary-wash-deuglify-map "Y" gnus-summary-wash-map) - ;; mnemonic: deuglif*Y* - "u" gnus-article-outlook-unwrap-lines - "a" gnus-article-outlook-repair-attribution - "c" gnus-article-outlook-rearrange-citation - "f" gnus-article-outlook-deuglify-article) ;; mnemonic: full deuglify - -(gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map) - "a" gnus-article-hide - "h" gnus-article-hide-headers - "b" gnus-article-hide-boring-headers - "s" gnus-article-hide-signature - "c" gnus-article-hide-citation - "C" gnus-article-hide-citation-in-followups - "l" gnus-article-hide-list-identifiers - "B" gnus-article-strip-banner - "P" gnus-article-hide-pem - "\C-c" gnus-article-hide-citation-maybe) - -(gnus-define-keys (gnus-summary-wash-highlight-map "H" gnus-summary-wash-map) - "a" gnus-article-highlight - "h" gnus-article-highlight-headers - "c" gnus-article-highlight-citation - "s" gnus-article-highlight-signature) - -(gnus-define-keys (gnus-summary-wash-header-map "G" gnus-summary-wash-map) - "f" gnus-article-treat-fold-headers - "u" gnus-article-treat-unfold-headers - "n" gnus-article-treat-fold-newsgroups) - -(gnus-define-keys (gnus-summary-wash-display-map "D" gnus-summary-wash-map) - "x" gnus-article-display-x-face - "d" gnus-article-display-face - "s" gnus-treat-smiley - "D" gnus-article-remove-images - "f" gnus-treat-from-picon - "m" gnus-treat-mail-picon - "n" gnus-treat-newsgroups-picon) - -(gnus-define-keys (gnus-summary-wash-mime-map "M" gnus-summary-wash-map) - "w" gnus-article-decode-mime-words - "c" gnus-article-decode-charset - "v" gnus-mime-view-all-parts - "b" gnus-article-view-part) - -(gnus-define-keys (gnus-summary-wash-time-map "T" gnus-summary-wash-map) - "z" gnus-article-date-ut - "u" gnus-article-date-ut - "l" gnus-article-date-local - "p" gnus-article-date-english - "e" gnus-article-date-lapsed - "o" gnus-article-date-original - "i" gnus-article-date-iso8601 - "s" gnus-article-date-user) - -(gnus-define-keys (gnus-summary-wash-empty-map "E" gnus-summary-wash-map) - "t" gnus-article-remove-trailing-blank-lines - "l" gnus-article-strip-leading-blank-lines - "m" gnus-article-strip-multiple-blank-lines - "a" gnus-article-strip-blank-lines - "A" gnus-article-strip-all-blank-lines - "s" gnus-article-strip-leading-space - "e" gnus-article-strip-trailing-space - "w" gnus-article-remove-leading-whitespace) - -(gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map) - "v" gnus-version - "f" gnus-summary-fetch-faq - "d" gnus-summary-describe-group - "h" gnus-summary-describe-briefly - "i" gnus-info-find-node - "c" gnus-group-fetch-charter - "C" gnus-group-fetch-control) - -(gnus-define-keys (gnus-summary-backend-map "B" gnus-summary-mode-map) - "e" gnus-summary-expire-articles - "\M-\C-e" gnus-summary-expire-articles-now - "\177" gnus-summary-delete-article - [delete] gnus-summary-delete-article - [backspace] gnus-summary-delete-article - "m" gnus-summary-move-article - "r" gnus-summary-respool-article - "w" gnus-summary-edit-article - "c" gnus-summary-copy-article - "B" gnus-summary-crosspost-article - "q" gnus-summary-respool-query - "t" gnus-summary-respool-trace - "i" gnus-summary-import-article - "I" gnus-summary-create-article - "p" gnus-summary-article-posted-p) - -(gnus-define-keys (gnus-summary-save-map "O" gnus-summary-mode-map) - "o" gnus-summary-save-article - "m" gnus-summary-save-article-mail - "F" gnus-summary-write-article-file - "r" gnus-summary-save-article-rmail - "f" gnus-summary-save-article-file - "b" gnus-summary-save-article-body-file - "B" gnus-summary-write-article-body-file - "h" gnus-summary-save-article-folder - "v" gnus-summary-save-article-vm - "p" gnus-summary-pipe-output - "P" gnus-summary-muttprint - "s" gnus-soup-add-article) - -(gnus-define-keys (gnus-summary-mime-map "K" gnus-summary-mode-map) - "b" gnus-summary-display-buttonized - "m" gnus-summary-repair-multipart - "v" gnus-article-view-part - "o" gnus-article-save-part - "c" gnus-article-copy-part - "C" gnus-article-view-part-as-charset - "e" gnus-article-view-part-externally - "E" gnus-article-encrypt-body - "i" gnus-article-inline-part - "|" gnus-article-pipe-part) - -(gnus-define-keys (gnus-uu-mark-map "P" gnus-summary-mark-map) - "p" gnus-summary-mark-as-processable - "u" gnus-summary-unmark-as-processable - "U" gnus-summary-unmark-all-processable - "v" gnus-uu-mark-over - "s" gnus-uu-mark-series - "r" gnus-uu-mark-region - "g" gnus-uu-unmark-region - "R" gnus-uu-mark-by-regexp - "G" gnus-uu-unmark-by-regexp - "t" gnus-uu-mark-thread - "T" gnus-uu-unmark-thread - "a" gnus-uu-mark-all - "b" gnus-uu-mark-buffer - "S" gnus-uu-mark-sparse - "k" gnus-summary-kill-process-mark - "y" gnus-summary-yank-process-mark - "w" gnus-summary-save-process-mark - "i" gnus-uu-invert-processable) - -(gnus-define-keys (gnus-uu-extract-map "X" gnus-summary-mode-map) - ;;"x" gnus-uu-extract-any - "m" gnus-summary-save-parts - "u" gnus-uu-decode-uu - "U" gnus-uu-decode-uu-and-save - "s" gnus-uu-decode-unshar - "S" gnus-uu-decode-unshar-and-save - "o" gnus-uu-decode-save - "O" gnus-uu-decode-save - "b" gnus-uu-decode-binhex - "B" gnus-uu-decode-binhex - "p" gnus-uu-decode-postscript - "P" gnus-uu-decode-postscript-and-save) - -(gnus-define-keys - (gnus-uu-extract-view-map "v" gnus-uu-extract-map) - "u" gnus-uu-decode-uu-view - "U" gnus-uu-decode-uu-and-save-view - "s" gnus-uu-decode-unshar-view - "S" gnus-uu-decode-unshar-and-save-view - "o" gnus-uu-decode-save-view - "O" gnus-uu-decode-save-view - "b" gnus-uu-decode-binhex-view - "B" gnus-uu-decode-binhex-view - "p" gnus-uu-decode-postscript-view - "P" gnus-uu-decode-postscript-and-save-view) - -(defvar gnus-article-post-menu nil) - -(defconst gnus-summary-menu-maxlen 20) - -(defun gnus-summary-menu-split (menu) - ;; If we have lots of elements, divide them into groups of 20 - ;; and make a pane (or submenu) for each one. - (if (> (length menu) (/ (* gnus-summary-menu-maxlen 3) 2)) - (let ((menu menu) sublists next - (i 1)) - (while menu - ;; Pull off the next gnus-summary-menu-maxlen elements - ;; and make them the next element of sublist. - (setq next (nthcdr gnus-summary-menu-maxlen menu)) - (if next - (setcdr (nthcdr (1- gnus-summary-menu-maxlen) menu) - nil)) - (setq sublists (cons (cons (format "%s ... %s" (aref (car menu) 0) - (aref (car (last menu)) 0)) menu) - sublists)) - (setq i (1+ i)) - (setq menu next)) - (nreverse sublists)) - ;; Few elements--put them all in one pane. - menu)) - -(defun gnus-summary-make-menu-bar () - (gnus-turn-off-edit-menu 'summary) - - (unless (boundp 'gnus-summary-misc-menu) - - (easy-menu-define - gnus-summary-kill-menu gnus-summary-mode-map "" - (cons - "Score" - (nconc - (list - ["Customize" gnus-score-customize t]) - (gnus-make-score-map 'increase) - (gnus-make-score-map 'lower) - '(("Mark" - ["Kill below" gnus-summary-kill-below t] - ["Mark above" gnus-summary-mark-above t] - ["Tick above" gnus-summary-tick-above t] - ["Clear above" gnus-summary-clear-above t]) - ["Current score" gnus-summary-current-score t] - ["Set score" gnus-summary-set-score t] - ["Switch current score file..." gnus-score-change-score-file t] - ["Set mark below..." gnus-score-set-mark-below t] - ["Set expunge below..." gnus-score-set-expunge-below t] - ["Edit current score file" gnus-score-edit-current-scores t] - ["Edit score file..." gnus-score-edit-file t] - ["Trace score" gnus-score-find-trace t] - ["Find words" gnus-score-find-favourite-words t] - ["Rescore buffer" gnus-summary-rescore t] - ["Increase score..." gnus-summary-increase-score t] - ["Lower score..." gnus-summary-lower-score t])))) - - ;; Define both the Article menu in the summary buffer and the - ;; equivalent Commands menu in the article buffer here for - ;; consistency. - (let ((innards - `(("Hide" - ["All" gnus-article-hide t] - ["Headers" gnus-article-hide-headers t] - ["Signature" gnus-article-hide-signature t] - ["Citation" gnus-article-hide-citation t] - ["List identifiers" gnus-article-hide-list-identifiers t] - ["Banner" gnus-article-strip-banner t] - ["Boring headers" gnus-article-hide-boring-headers t]) - ("Highlight" - ["All" gnus-article-highlight t] - ["Headers" gnus-article-highlight-headers t] - ["Signature" gnus-article-highlight-signature t] - ["Citation" gnus-article-highlight-citation t]) - ("MIME" - ["Words" gnus-article-decode-mime-words t] - ["Charset" gnus-article-decode-charset t] - ["QP" gnus-article-de-quoted-unreadable t] - ["Base64" gnus-article-de-base64-unreadable t] - ["View MIME buttons" gnus-summary-display-buttonized t] - ["View all" gnus-mime-view-all-parts t] - ["Verify and Decrypt" gnus-summary-force-verify-and-decrypt t] - ["Encrypt body" gnus-article-encrypt-body - :active (not (gnus-group-read-only-p)) - ,@(if (featurep 'xemacs) nil - '(:help "Encrypt the message body on disk"))] - ["Extract all parts..." gnus-summary-save-parts t] - ("Multipart" - ["Repair multipart" gnus-summary-repair-multipart t] - ["Pipe part..." gnus-article-pipe-part t] - ["Inline part" gnus-article-inline-part t] - ["Encrypt body" gnus-article-encrypt-body - :active (not (gnus-group-read-only-p)) - ,@(if (featurep 'xemacs) nil - '(:help "Encrypt the message body on disk"))] - ["View part externally" gnus-article-view-part-externally t] - ["View part with charset..." gnus-article-view-part-as-charset t] - ["Copy part" gnus-article-copy-part t] - ["Save part..." gnus-article-save-part t] - ["View part" gnus-article-view-part t])) - ("Date" - ["Local" gnus-article-date-local t] - ["ISO8601" gnus-article-date-iso8601 t] - ["UT" gnus-article-date-ut t] - ["Original" gnus-article-date-original t] - ["Lapsed" gnus-article-date-lapsed t] - ["User-defined" gnus-article-date-user t]) - ("Display" - ["Remove images" gnus-article-remove-images t] - ["Toggle smiley" gnus-treat-smiley t] - ["Show X-Face" gnus-article-display-x-face t] - ["Show picons in From" gnus-treat-from-picon t] - ["Show picons in mail headers" gnus-treat-mail-picon t] - ["Show picons in news headers" gnus-treat-newsgroups-picon t] - ("View as different encoding" - ,@(gnus-summary-menu-split - (mapcar - (lambda (cs) - ;; Since easymenu under Emacs doesn't allow - ;; lambda forms for menu commands, we should - ;; provide intern'ed function symbols. - (let ((command (intern (format "\ -gnus-summary-show-article-from-menu-as-charset-%s" cs)))) - (fset command - `(lambda () - (interactive) - (let ((gnus-summary-show-article-charset-alist - '((1 . ,cs)))) - (gnus-summary-show-article 1)))) - `[,(symbol-name cs) ,command t])) - (sort (if (fboundp 'coding-system-list) - (coding-system-list) - (mapcar 'car mm-mime-mule-charset-alist)) - 'string<))))) - ("Washing" - ("Remove Blanks" - ["Leading" gnus-article-strip-leading-blank-lines t] - ["Multiple" gnus-article-strip-multiple-blank-lines t] - ["Trailing" gnus-article-remove-trailing-blank-lines t] - ["All of the above" gnus-article-strip-blank-lines t] - ["All" gnus-article-strip-all-blank-lines t] - ["Leading space" gnus-article-strip-leading-space t] - ["Trailing space" gnus-article-strip-trailing-space t] - ["Leading space in headers" - gnus-article-remove-leading-whitespace t]) - ["Overstrike" gnus-article-treat-overstrike t] - ["Dumb quotes" gnus-article-treat-dumbquotes t] - ["Emphasis" gnus-article-emphasize t] - ["Word wrap" gnus-article-fill-cited-article t] - ["Fill long lines" gnus-article-fill-long-lines t] - ["Capitalize sentences" gnus-article-capitalize-sentences t] - ["Remove CR" gnus-article-remove-cr t] - ["Quoted-Printable" gnus-article-de-quoted-unreadable t] - ["Base64" gnus-article-de-base64-unreadable t] - ["Rot 13" gnus-summary-caesar-message - ,@(if (featurep 'xemacs) '(t) - '(:help "\"Caesar rotate\" article by 13"))] - ["Morse decode" gnus-summary-morse-message t] - ["Unix pipe..." gnus-summary-pipe-message t] - ["Add buttons" gnus-article-add-buttons t] - ["Add buttons to head" gnus-article-add-buttons-to-head t] - ["Stop page breaking" gnus-summary-stop-page-breaking t] - ["Verbose header" gnus-summary-verbose-headers t] - ["Toggle header" gnus-summary-toggle-header t] - ["Unfold headers" gnus-article-treat-unfold-headers t] - ["Fold newsgroups" gnus-article-treat-fold-newsgroups t] - ["Html" gnus-article-wash-html t] - ["Unsplit URLs" gnus-article-unsplit-urls t] - ["Verify X-PGP-Sig" gnus-article-verify-x-pgp-sig t] - ["Decode HZ" gnus-article-decode-HZ t] - ("(Outlook) Deuglify" - ["Unwrap lines" gnus-article-outlook-unwrap-lines t] - ["Repair attribution" gnus-article-outlook-repair-attribution t] - ["Rearrange citation" gnus-article-outlook-rearrange-citation t] - ["Full (Outlook) deuglify" - gnus-article-outlook-deuglify-article t]) - ) - ("Output" - ["Save in default format..." gnus-summary-save-article - ,@(if (featurep 'xemacs) '(t) - '(:help "Save article using default method"))] - ["Save in file..." gnus-summary-save-article-file - ,@(if (featurep 'xemacs) '(t) - '(:help "Save article in file"))] - ["Save in Unix mail format..." gnus-summary-save-article-mail t] - ["Save in MH folder..." gnus-summary-save-article-folder t] - ["Save in VM folder..." gnus-summary-save-article-vm t] - ["Save in RMAIL mbox..." gnus-summary-save-article-rmail t] - ["Save body in file..." gnus-summary-save-article-body-file t] - ["Pipe through a filter..." gnus-summary-pipe-output t] - ["Add to SOUP packet" gnus-soup-add-article t] - ["Print with Muttprint..." gnus-summary-muttprint t] - ["Print" gnus-summary-print-article - ,@(if (featurep 'xemacs) '(t) - '(:help "Generate and print a PostScript image"))]) - ("Copy, move,... (Backend)" - ,@(if (featurep 'xemacs) nil - '(:help "Copying, moving, expiring articles...")) - ["Respool article..." gnus-summary-respool-article t] - ["Move article..." gnus-summary-move-article - (gnus-check-backend-function - 'request-move-article gnus-newsgroup-name)] - ["Copy article..." gnus-summary-copy-article t] - ["Crosspost article..." gnus-summary-crosspost-article - (gnus-check-backend-function - 'request-replace-article gnus-newsgroup-name)] - ["Import file..." gnus-summary-import-article - (gnus-check-backend-function - 'request-accept-article gnus-newsgroup-name)] - ["Create article..." gnus-summary-create-article - (gnus-check-backend-function - 'request-accept-article gnus-newsgroup-name)] - ["Check if posted" gnus-summary-article-posted-p t] - ["Edit article" gnus-summary-edit-article - (not (gnus-group-read-only-p))] - ["Delete article" gnus-summary-delete-article - (gnus-check-backend-function - 'request-expire-articles gnus-newsgroup-name)] - ["Query respool" gnus-summary-respool-query t] - ["Trace respool" gnus-summary-respool-trace t] - ["Delete expirable articles" gnus-summary-expire-articles-now - (gnus-check-backend-function - 'request-expire-articles gnus-newsgroup-name)]) - ("Extract" - ["Uudecode" gnus-uu-decode-uu - ,@(if (featurep 'xemacs) '(t) - '(:help "Decode uuencoded article(s)"))] - ["Uudecode and save" gnus-uu-decode-uu-and-save t] - ["Unshar" gnus-uu-decode-unshar t] - ["Unshar and save" gnus-uu-decode-unshar-and-save t] - ["Save" gnus-uu-decode-save t] - ["Binhex" gnus-uu-decode-binhex t] - ["Postscript" gnus-uu-decode-postscript t] - ["All MIME parts" gnus-summary-save-parts t]) - ("Cache" - ["Enter article" gnus-cache-enter-article t] - ["Remove article" gnus-cache-remove-article t]) - ["Translate" gnus-article-babel t] - ["Select article buffer" gnus-summary-select-article-buffer t] - ["Enter digest buffer" gnus-summary-enter-digest-group t] - ["Isearch article..." gnus-summary-isearch-article t] - ["Beginning of the article" gnus-summary-beginning-of-article t] - ["End of the article" gnus-summary-end-of-article t] - ["Fetch parent of article" gnus-summary-refer-parent-article t] - ["Fetch referenced articles" gnus-summary-refer-references t] - ["Fetch current thread" gnus-summary-refer-thread t] - ["Fetch article with id..." gnus-summary-refer-article t] - ["Setup Mailing List Params" gnus-mailing-list-insinuate t] - ["Redisplay" gnus-summary-show-article t] - ["Raw article" gnus-summary-show-raw-article :keys "C-u g"]))) - (easy-menu-define - gnus-summary-article-menu gnus-summary-mode-map "" - (cons "Article" innards)) - - (if (not (keymapp gnus-summary-article-menu)) - (easy-menu-define - gnus-article-commands-menu gnus-article-mode-map "" - (cons "Commands" innards)) - ;; in Emacs, don't share menu. - (setq gnus-article-commands-menu - (copy-keymap gnus-summary-article-menu)) - (define-key gnus-article-mode-map [menu-bar commands] - (cons "Commands" gnus-article-commands-menu)))) - - (easy-menu-define - gnus-summary-thread-menu gnus-summary-mode-map "" - '("Threads" - ["Find all messages in thread" gnus-summary-refer-thread t] - ["Toggle threading" gnus-summary-toggle-threads t] - ["Hide threads" gnus-summary-hide-all-threads t] - ["Show threads" gnus-summary-show-all-threads t] - ["Hide thread" gnus-summary-hide-thread t] - ["Show thread" gnus-summary-show-thread t] - ["Go to next thread" gnus-summary-next-thread t] - ["Go to previous thread" gnus-summary-prev-thread t] - ["Go down thread" gnus-summary-down-thread t] - ["Go up thread" gnus-summary-up-thread t] - ["Top of thread" gnus-summary-top-thread t] - ["Mark thread as read" gnus-summary-kill-thread t] - ["Lower thread score" gnus-summary-lower-thread t] - ["Raise thread score" gnus-summary-raise-thread t] - ["Rethread current" gnus-summary-rethread-current t])) - - (easy-menu-define - gnus-summary-post-menu gnus-summary-mode-map "" - `("Post" - ["Send a message (mail or news)" gnus-summary-post-news - ,@(if (featurep 'xemacs) '(t) - '(:help "Compose a new message (mail or news)"))] - ["Followup" gnus-summary-followup - ,@(if (featurep 'xemacs) '(t) - '(:help "Post followup to this article"))] - ["Followup and yank" gnus-summary-followup-with-original - ,@(if (featurep 'xemacs) '(t) - '(:help "Post followup to this article, quoting its contents"))] - ["Supersede article" gnus-summary-supersede-article t] - ["Cancel article" gnus-summary-cancel-article - ,@(if (featurep 'xemacs) '(t) - '(:help "Cancel an article you posted"))] - ["Reply" gnus-summary-reply t] - ["Reply and yank" gnus-summary-reply-with-original t] - ["Wide reply" gnus-summary-wide-reply t] - ["Wide reply and yank" gnus-summary-wide-reply-with-original - ,@(if (featurep 'xemacs) '(t) - '(:help "Mail a reply, quoting this article"))] - ["Very wide reply" gnus-summary-very-wide-reply t] - ["Very wide reply and yank" gnus-summary-very-wide-reply-with-original - ,@(if (featurep 'xemacs) '(t) - '(:help "Mail a very wide reply, quoting this article"))] - ["Mail forward" gnus-summary-mail-forward t] - ["Post forward" gnus-summary-post-forward t] - ["Digest and mail" gnus-uu-digest-mail-forward t] - ["Digest and post" gnus-uu-digest-post-forward t] - ["Resend message" gnus-summary-resend-message t] - ["Resend message edit" gnus-summary-resend-message-edit t] - ["Send bounced mail" gnus-summary-resend-bounced-mail t] - ["Send a mail" gnus-summary-mail-other-window t] - ["Create a local message" gnus-summary-news-other-window t] - ["Uuencode and post" gnus-uu-post-news - ,@(if (featurep 'xemacs) '(t) - '(:help "Post a uuencoded article"))] - ["Followup via news" gnus-summary-followup-to-mail t] - ["Followup via news and yank" - gnus-summary-followup-to-mail-with-original t] - ;;("Draft" - ;;["Send" gnus-summary-send-draft t] - ;;["Send bounced" gnus-resend-bounced-mail t]) - )) - - (cond - ((not (keymapp gnus-summary-post-menu)) - (setq gnus-article-post-menu gnus-summary-post-menu)) - ((not gnus-article-post-menu) - ;; Don't share post menu. - (setq gnus-article-post-menu - (copy-keymap gnus-summary-post-menu)))) - (define-key gnus-article-mode-map [menu-bar post] - (cons "Post" gnus-article-post-menu)) - - (easy-menu-define - gnus-summary-misc-menu gnus-summary-mode-map "" - `("Gnus" - ("Mark Read" - ["Mark as read" gnus-summary-mark-as-read-forward t] - ["Mark same subject and select" - gnus-summary-kill-same-subject-and-select t] - ["Mark same subject" gnus-summary-kill-same-subject t] - ["Catchup" gnus-summary-catchup - ,@(if (featurep 'xemacs) '(t) - '(:help "Mark unread articles in this group as read"))] - ["Catchup all" gnus-summary-catchup-all t] - ["Catchup to here" gnus-summary-catchup-to-here t] - ["Catchup from here" gnus-summary-catchup-from-here t] - ["Catchup region" gnus-summary-mark-region-as-read - (gnus-mark-active-p)] - ["Mark excluded" gnus-summary-limit-mark-excluded-as-read t]) - ("Mark Various" - ["Tick" gnus-summary-tick-article-forward t] - ["Mark as dormant" gnus-summary-mark-as-dormant t] - ["Remove marks" gnus-summary-clear-mark-forward t] - ["Set expirable mark" gnus-summary-mark-as-expirable t] - ["Set bookmark" gnus-summary-set-bookmark t] - ["Remove bookmark" gnus-summary-remove-bookmark t]) - ("Limit to" - ["Marks..." gnus-summary-limit-to-marks t] - ["Subject..." gnus-summary-limit-to-subject t] - ["Author..." gnus-summary-limit-to-author t] - ["Age..." gnus-summary-limit-to-age t] - ["Extra..." gnus-summary-limit-to-extra t] - ["Score..." gnus-summary-limit-to-score t] - ["Display Predicate" gnus-summary-limit-to-display-predicate t] - ["Unread" gnus-summary-limit-to-unread t] - ["Unseen" gnus-summary-limit-to-unseen t] - ["Non-dormant" gnus-summary-limit-exclude-dormant t] - ["Next or process marked articles" gnus-summary-limit-to-articles t] - ["Pop limit" gnus-summary-pop-limit t] - ["Show dormant" gnus-summary-limit-include-dormant t] - ["Hide childless dormant" - gnus-summary-limit-exclude-childless-dormant t] - ;;["Hide thread" gnus-summary-limit-exclude-thread t] - ["Hide marked" gnus-summary-limit-exclude-marks t] - ["Show expunged" gnus-summary-limit-include-expunged t]) - ("Process Mark" - ["Set mark" gnus-summary-mark-as-processable t] - ["Remove mark" gnus-summary-unmark-as-processable t] - ["Remove all marks" gnus-summary-unmark-all-processable t] - ["Mark above" gnus-uu-mark-over t] - ["Mark series" gnus-uu-mark-series t] - ["Mark region" gnus-uu-mark-region (gnus-mark-active-p)] - ["Unmark region" gnus-uu-unmark-region (gnus-mark-active-p)] - ["Mark by regexp..." gnus-uu-mark-by-regexp t] - ["Unmark by regexp..." gnus-uu-unmark-by-regexp t] - ["Mark all" gnus-uu-mark-all t] - ["Mark buffer" gnus-uu-mark-buffer t] - ["Mark sparse" gnus-uu-mark-sparse t] - ["Mark thread" gnus-uu-mark-thread t] - ["Unmark thread" gnus-uu-unmark-thread t] - ("Process Mark Sets" - ["Kill" gnus-summary-kill-process-mark t] - ["Yank" gnus-summary-yank-process-mark - gnus-newsgroup-process-stack] - ["Save" gnus-summary-save-process-mark t] - ["Run command on marked..." gnus-summary-universal-argument t])) - ("Scroll article" - ["Page forward" gnus-summary-next-page - ,@(if (featurep 'xemacs) '(t) - '(:help "Show next page of article"))] - ["Page backward" gnus-summary-prev-page - ,@(if (featurep 'xemacs) '(t) - '(:help "Show previous page of article"))] - ["Line forward" gnus-summary-scroll-up t]) - ("Move" - ["Next unread article" gnus-summary-next-unread-article t] - ["Previous unread article" gnus-summary-prev-unread-article t] - ["Next article" gnus-summary-next-article t] - ["Previous article" gnus-summary-prev-article t] - ["Next unread subject" gnus-summary-next-unread-subject t] - ["Previous unread subject" gnus-summary-prev-unread-subject t] - ["Next article same subject" gnus-summary-next-same-subject t] - ["Previous article same subject" gnus-summary-prev-same-subject t] - ["First unread article" gnus-summary-first-unread-article t] - ["Best unread article" gnus-summary-best-unread-article t] - ["Go to subject number..." gnus-summary-goto-subject t] - ["Go to article number..." gnus-summary-goto-article t] - ["Go to the last article" gnus-summary-goto-last-article t] - ["Pop article off history" gnus-summary-pop-article t]) - ("Sort" - ["Sort by number" gnus-summary-sort-by-number t] - ["Sort by author" gnus-summary-sort-by-author t] - ["Sort by subject" gnus-summary-sort-by-subject t] - ["Sort by date" gnus-summary-sort-by-date t] - ["Sort by score" gnus-summary-sort-by-score t] - ["Sort by lines" gnus-summary-sort-by-lines t] - ["Sort by characters" gnus-summary-sort-by-chars t] - ["Randomize" gnus-summary-sort-by-random t] - ["Original sort" gnus-summary-sort-by-original t]) - ("Help" - ["Fetch group FAQ" gnus-summary-fetch-faq t] - ["Describe group" gnus-summary-describe-group t] - ["Fetch charter" gnus-group-fetch-charter - ,@(if (featurep 'xemacs) nil - '(:help "Display the charter of the current group"))] - ["Fetch control message" gnus-group-fetch-control - ,@(if (featurep 'xemacs) nil - '(:help "Display the archived control message for the current group"))] - ["Read manual" gnus-info-find-node t]) - ("Modes" - ["Pick and read" gnus-pick-mode t] - ["Binary" gnus-binary-mode t]) - ("Regeneration" - ["Regenerate" gnus-summary-prepare t] - ["Insert cached articles" gnus-summary-insert-cached-articles t] - ["Insert dormant articles" gnus-summary-insert-dormant-articles t] - ["Toggle threading" gnus-summary-toggle-threads t]) - ["See old articles" gnus-summary-insert-old-articles t] - ["See new articles" gnus-summary-insert-new-articles t] - ["Filter articles..." gnus-summary-execute-command t] - ["Run command on articles..." gnus-summary-universal-argument t] - ["Search articles forward..." gnus-summary-search-article-forward t] - ["Search articles backward..." gnus-summary-search-article-backward t] - ["Toggle line truncation" gnus-summary-toggle-truncation t] - ["Expand window" gnus-summary-expand-window t] - ["Expire expirable articles" gnus-summary-expire-articles - (gnus-check-backend-function - 'request-expire-articles gnus-newsgroup-name)] - ["Edit local kill file" gnus-summary-edit-local-kill t] - ["Edit main kill file" gnus-summary-edit-global-kill t] - ["Edit group parameters" gnus-summary-edit-parameters t] - ["Customize group parameters" gnus-summary-customize-parameters t] - ["Send a bug report" gnus-bug t] - ("Exit" - ["Catchup and exit" gnus-summary-catchup-and-exit - ,@(if (featurep 'xemacs) '(t) - '(:help "Mark unread articles in this group as read, then exit"))] - ["Catchup all and exit" gnus-summary-catchup-all-and-exit t] - ["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t] - ["Exit group" gnus-summary-exit - ,@(if (featurep 'xemacs) '(t) - '(:help "Exit current group, return to group selection mode"))] - ["Exit group without updating" gnus-summary-exit-no-update t] - ["Exit and goto next group" gnus-summary-next-group t] - ["Exit and goto prev group" gnus-summary-prev-group t] - ["Reselect group" gnus-summary-reselect-current-group t] - ["Rescan group" gnus-summary-rescan-group t] - ["Update dribble" gnus-summary-save-newsrc t]))) - - (gnus-run-hooks 'gnus-summary-menu-hook))) - -(defvar gnus-summary-tool-bar-map nil) - -;; Note: The :set function in the `gnus-summary-tool-bar*' variables will only -;; affect _new_ message buffers. We might add a function that walks thru all -;; summary-mode buffers and force the update. -(defun gnus-summary-tool-bar-update (&optional symbol value) - "Update summary mode toolbar. -Setter function for custom variables." - (setq-default gnus-summary-tool-bar-map nil) - (when symbol - ;; When used as ":set" function: - (set-default symbol value)) - (when (gnus-buffer-live-p gnus-summary-buffer) - (with-current-buffer gnus-summary-buffer - (gnus-summary-make-tool-bar)))) - -(defcustom gnus-summary-tool-bar (if (eq gmm-tool-bar-style 'gnome) - 'gnus-summary-tool-bar-gnome - 'gnus-summary-tool-bar-retro) - "Specifies the Gnus summary tool bar. - -It can be either a list or a symbol refering to a list. See -`gmm-tool-bar-from-list' for the format of the list. The -default key map is `gnus-summary-mode-map'. - -Pre-defined symbols include `gnus-summary-tool-bar-gnome' and -`gnus-summary-tool-bar-retro'." - :type '(choice (const :tag "GNOME style" gnus-summary-tool-bar-gnome) - (const :tag "Retro look" gnus-summary-tool-bar-retro) - (repeat :tag "User defined list" gmm-tool-bar-item) - (symbol)) - :version "22.1" ;; Gnus 5.10.9 - :initialize 'custom-initialize-default - :set 'gnus-summary-tool-bar-update - :group 'gnus-summary) - -(defcustom gnus-summary-tool-bar-gnome - '((gnus-summary-post-news "mail/compose" nil) - (gnus-summary-insert-new-articles "mail/inbox" nil - :visible (or (not gnus-agent) - gnus-plugged)) - (gnus-summary-reply-with-original "mail/reply") - (gnus-summary-reply "mail/reply" nil :visible nil) - (gnus-summary-followup-with-original "mail/reply-all") - (gnus-summary-followup "mail/reply-all" nil :visible nil) - (gnus-summary-mail-forward "mail/forward") - (gnus-summary-save-article "mail/save") - (gnus-summary-search-article-forward "search" nil :visible nil) - (gnus-summary-print-article "print") - (gnus-summary-tick-article-forward "flag-followup" nil :visible nil) - ;; Some new commands that may need more suitable icons: - (gnus-summary-save-newsrc "save" nil :visible nil) - ;; (gnus-summary-show-article "stock_message-display" nil :visible nil) - (gnus-summary-prev-article "left-arrow") - (gnus-summary-next-article "right-arrow") - (gnus-summary-next-page "next-page") - ;; (gnus-summary-enter-digest-group "right_arrow" nil :visible nil) - ;; - ;; Maybe some sort-by-... could be added: - ;; (gnus-summary-sort-by-author "sort-a-z" nil :visible nil) - ;; (gnus-summary-sort-by-date "sort-1-9" nil :visible nil) - (gnus-summary-mark-as-expirable - "delete" nil - :visible (gnus-check-backend-function 'request-expire-articles - gnus-newsgroup-name)) - (gnus-summary-mark-as-spam - "mail/spam" t - :visible (and (fboundp 'spam-group-ham-contents-p) - (spam-group-ham-contents-p gnus-newsgroup-name)) - :help "Mark as spam") - (gnus-summary-mark-as-read-forward - "mail/not-spam" nil - :visible (and (fboundp 'spam-group-spam-contents-p) - (spam-group-spam-contents-p gnus-newsgroup-name))) - ;; - (gnus-summary-exit "exit") - (gmm-customize-mode "preferences" t :help "Edit mode preferences") - (gnus-info-find-node "help")) - "List of functions for the summary tool bar (GNOME style). - -See `gmm-tool-bar-from-list' for the format of the list." - :type '(repeat gmm-tool-bar-item) - :version "22.1" ;; Gnus 5.10.9 - :initialize 'custom-initialize-default - :set 'gnus-summary-tool-bar-update - :group 'gnus-summary) - -(defcustom gnus-summary-tool-bar-retro - '((gnus-summary-prev-unread-article "gnus/prev-ur") - (gnus-summary-next-unread-article "gnus/next-ur") - (gnus-summary-post-news "gnus/post") - (gnus-summary-followup-with-original "gnus/fuwo") - (gnus-summary-followup "gnus/followup") - (gnus-summary-reply-with-original "gnus/reply-wo") - (gnus-summary-reply "gnus/reply") - (gnus-summary-caesar-message "gnus/rot13") - (gnus-uu-decode-uu "gnus/uu-decode") - (gnus-summary-save-article-file "gnus/save-aif") - (gnus-summary-save-article "gnus/save-art") - (gnus-uu-post-news "gnus/uu-post") - (gnus-summary-catchup "gnus/catchup") - (gnus-summary-catchup-and-exit "gnus/cu-exit") - (gnus-summary-exit "gnus/exit-summ") - ;; Some new command that may need more suitable icons: - (gnus-summary-print-article "gnus/print" nil :visible nil) - (gnus-summary-mark-as-expirable "gnus/close" nil :visible nil) - (gnus-summary-save-newsrc "gnus/save" nil :visible nil) - ;; (gnus-summary-enter-digest-group "gnus/right_arrow" nil :visible nil) - (gnus-summary-search-article-forward "gnus/search" nil :visible nil) - ;; (gnus-summary-insert-new-articles "gnus/paste" nil :visible nil) - ;; (gnus-summary-toggle-threads "gnus/open" nil :visible nil) - ;; - (gnus-info-find-node "gnus/help" nil :visible nil)) - "List of functions for the summary tool bar (retro look). - -See `gmm-tool-bar-from-list' for the format of the list." - :type '(repeat gmm-tool-bar-item) - :version "22.1" ;; Gnus 5.10.9 - :initialize 'custom-initialize-default - :set 'gnus-summary-tool-bar-update - :group 'gnus-summary) - -(defcustom gnus-summary-tool-bar-zap-list t - "List of icon items from the global tool bar. -These items are not displayed in the Gnus summary mode tool bar. - -See `gmm-tool-bar-from-list' for the format of the list." - :type 'gmm-tool-bar-zap-list - :version "22.1" ;; Gnus 5.10.9 - :initialize 'custom-initialize-default - :set 'gnus-summary-tool-bar-update - :group 'gnus-summary) - -(defvar image-load-path) - -(defun gnus-summary-make-tool-bar (&optional force) - "Make a summary mode tool bar from `gnus-summary-tool-bar'. -When FORCE, rebuild the tool bar." - (when (and (not (featurep 'xemacs)) - (boundp 'tool-bar-mode) - tool-bar-mode - (or (not gnus-summary-tool-bar-map) force)) - (let* ((load-path - (gmm-image-load-path-for-library "gnus" - "mail/save.xpm" - nil t)) - (image-load-path (cons (car load-path) - (when (boundp 'image-load-path) - image-load-path))) - (map (gmm-tool-bar-from-list gnus-summary-tool-bar - gnus-summary-tool-bar-zap-list - 'gnus-summary-mode-map))) - (when map - ;; Need to set `gnus-summary-tool-bar-map' because `gnus-article-mode' - ;; uses it's value. - (setq gnus-summary-tool-bar-map map)))) - (set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map)) - -(defun gnus-score-set-default (var value) - "A version of set that updates the GNU Emacs menu-bar." - (set var value) - ;; It is the message that forces the active status to be updated. - (message "")) - -(defun gnus-make-score-map (type) - "Make a summary score map of type TYPE." - (if t - nil - (let ((headers '(("author" "from" string) - ("subject" "subject" string) - ("article body" "body" string) - ("article head" "head" string) - ("xref" "xref" string) - ("extra header" "extra" string) - ("lines" "lines" number) - ("followups to author" "followup" string))) - (types '((number ("less than" <) - ("greater than" >) - ("equal" =)) - (string ("substring" s) - ("exact string" e) - ("fuzzy string" f) - ("regexp" r)))) - (perms '(("temporary" (current-time-string)) - ("permanent" nil) - ("immediate" now))) - header) - (list - (apply - 'nconc - (list - (if (eq type 'lower) - "Lower score" - "Increase score")) - (let (outh) - (while headers - (setq header (car headers)) - (setq outh - (cons - (apply - 'nconc - (list (car header)) - (let ((ts (cdr (assoc (nth 2 header) types))) - outt) - (while ts - (setq outt - (cons - (apply - 'nconc - (list (caar ts)) - (let ((ps perms) - outp) - (while ps - (setq outp - (cons - (vector - (caar ps) - (list - 'gnus-summary-score-entry - (nth 1 header) - (if (or (string= (nth 1 header) - "head") - (string= (nth 1 header) - "body")) - "" - (list 'gnus-summary-header - (nth 1 header))) - (list 'quote (nth 1 (car ts))) - (list 'gnus-score-delta-default - nil) - (nth 1 (car ps)) - t) - t) - outp)) - (setq ps (cdr ps))) - (list (nreverse outp)))) - outt)) - (setq ts (cdr ts))) - (list (nreverse outt)))) - outh)) - (setq headers (cdr headers))) - (list (nreverse outh)))))))) - - - -(defun gnus-summary-mode (&optional group) - "Major mode for reading articles. - -All normal editing commands are switched off. -\\ -Each line in this buffer represents one article. To read an -article, you can, for instance, type `\\[gnus-summary-next-page]'. To move forwards -and backwards while displaying articles, type `\\[gnus-summary-next-unread-article]' and `\\[gnus-summary-prev-unread-article]', -respectively. - -You can also post articles and send mail from this buffer. To -follow up an article, type `\\[gnus-summary-followup]'. To mail a reply to the author -of an article, type `\\[gnus-summary-reply]'. - -There are approx. one gazillion commands you can execute in this -buffer; read the info pages for more information (`\\[gnus-info-find-node]'). - -The following commands are available: - -\\{gnus-summary-mode-map}" - (interactive) - (kill-all-local-variables) - (when (gnus-visual-p 'summary-menu 'menu) - (gnus-summary-make-menu-bar) - (gnus-summary-make-tool-bar)) - (gnus-summary-make-local-variables) - (let ((gnus-summary-local-variables gnus-newsgroup-variables)) - (gnus-summary-make-local-variables)) - (gnus-make-thread-indent-array) - (gnus-simplify-mode-line) - (setq major-mode 'gnus-summary-mode) - (setq mode-name "Summary") - (make-local-variable 'minor-mode-alist) - (use-local-map gnus-summary-mode-map) - (buffer-disable-undo) - (setq buffer-read-only t) ;Disable modification - (setq truncate-lines t) - (setq selective-display t) - (setq selective-display-ellipses t) ;Display `...' - (gnus-summary-set-display-table) - (gnus-set-default-directory) - (setq gnus-newsgroup-name group) - (make-local-variable 'gnus-summary-line-format) - (make-local-variable 'gnus-summary-line-format-spec) - (make-local-variable 'gnus-summary-dummy-line-format) - (make-local-variable 'gnus-summary-dummy-line-format-spec) - (make-local-variable 'gnus-summary-mark-positions) - (gnus-make-local-hook 'pre-command-hook) - (add-hook 'pre-command-hook 'gnus-set-global-variables nil t) - (gnus-run-mode-hooks 'gnus-summary-mode-hook) - (turn-on-gnus-mailing-list-mode) - (mm-enable-multibyte) - (gnus-update-format-specifications nil 'summary 'summary-mode 'summary-dummy) - (gnus-update-summary-mark-positions)) - -(defun gnus-summary-make-local-variables () - "Make all the local summary buffer variables." - (let (global) - (dolist (local gnus-summary-local-variables) - (if (consp local) - (progn - (if (eq (cdr local) 'global) - ;; Copy the global value of the variable. - (setq global (symbol-value (car local))) - ;; Use the value from the list. - (setq global (eval (cdr local)))) - (set (make-local-variable (car local)) global)) - ;; Simple nil-valued local variable. - (set (make-local-variable local) nil))))) - -(defun gnus-summary-clear-local-variables () - (let ((locals gnus-summary-local-variables)) - (while locals - (if (consp (car locals)) - (and (vectorp (caar locals)) - (set (caar locals) nil)) - (and (vectorp (car locals)) - (set (car locals) nil))) - (setq locals (cdr locals))))) - -;; Summary data functions. - -(defmacro gnus-data-number (data) - `(car ,data)) - -(defmacro gnus-data-set-number (data number) - `(setcar ,data ,number)) - -(defmacro gnus-data-mark (data) - `(nth 1 ,data)) - -(defmacro gnus-data-set-mark (data mark) - `(setcar (nthcdr 1 ,data) ,mark)) - -(defmacro gnus-data-pos (data) - `(nth 2 ,data)) - -(defmacro gnus-data-set-pos (data pos) - `(setcar (nthcdr 2 ,data) ,pos)) - -(defmacro gnus-data-header (data) - `(nth 3 ,data)) - -(defmacro gnus-data-set-header (data header) - `(setf (nth 3 ,data) ,header)) - -(defmacro gnus-data-level (data) - `(nth 4 ,data)) - -(defmacro gnus-data-unread-p (data) - `(= (nth 1 ,data) gnus-unread-mark)) - -(defmacro gnus-data-read-p (data) - `(/= (nth 1 ,data) gnus-unread-mark)) - -(defmacro gnus-data-pseudo-p (data) - `(consp (nth 3 ,data))) - -(defmacro gnus-data-find (number) - `(assq ,number gnus-newsgroup-data)) - -(defmacro gnus-data-find-list (number &optional data) - `(let ((bdata ,(or data 'gnus-newsgroup-data))) - (memq (assq ,number bdata) - bdata))) - -(defmacro gnus-data-make (number mark pos header level) - `(list ,number ,mark ,pos ,header ,level)) - -(defun gnus-data-enter (after-article number mark pos header level offset) - (let ((data (gnus-data-find-list after-article))) - (unless data - (error "No such article: %d" after-article)) - (setcdr data (cons (gnus-data-make number mark pos header level) - (cdr data))) - (setq gnus-newsgroup-data-reverse nil) - (gnus-data-update-list (cddr data) offset))) - -(defun gnus-data-enter-list (after-article list &optional offset) - (when list - (let ((data (and after-article (gnus-data-find-list after-article))) - (ilist list)) - (if (not (or data - after-article)) - (let ((odata gnus-newsgroup-data)) - (setq gnus-newsgroup-data (nconc list gnus-newsgroup-data)) - (when offset - (gnus-data-update-list odata offset))) - ;; Find the last element in the list to be spliced into the main - ;; list. - (while (cdr list) - (setq list (cdr list))) - (if (not data) - (progn - (setcdr list gnus-newsgroup-data) - (setq gnus-newsgroup-data ilist) - (when offset - (gnus-data-update-list (cdr list) offset))) - (setcdr list (cdr data)) - (setcdr data ilist) - (when offset - (gnus-data-update-list (cdr list) offset)))) - (setq gnus-newsgroup-data-reverse nil)))) - -(defun gnus-data-remove (article &optional offset) - (let ((data gnus-newsgroup-data)) - (if (= (gnus-data-number (car data)) article) - (progn - (setq gnus-newsgroup-data (cdr gnus-newsgroup-data) - gnus-newsgroup-data-reverse nil) - (when offset - (gnus-data-update-list gnus-newsgroup-data offset))) - (while (cdr data) - (when (= (gnus-data-number (cadr data)) article) - (setcdr data (cddr data)) - (when offset - (gnus-data-update-list (cdr data) offset)) - (setq data nil - gnus-newsgroup-data-reverse nil)) - (setq data (cdr data)))))) - -(defmacro gnus-data-list (backward) - `(if ,backward - (or gnus-newsgroup-data-reverse - (setq gnus-newsgroup-data-reverse - (reverse gnus-newsgroup-data))) - gnus-newsgroup-data)) - -(defun gnus-data-update-list (data offset) - "Add OFFSET to the POS of all data entries in DATA." - (setq gnus-newsgroup-data-reverse nil) - (while data - (setcar (nthcdr 2 (car data)) (+ offset (nth 2 (car data)))) - (setq data (cdr data)))) - -(defun gnus-summary-article-pseudo-p (article) - "Say whether this article is a pseudo article or not." - (not (vectorp (gnus-data-header (gnus-data-find article))))) - -(defmacro gnus-summary-article-sparse-p (article) - "Say whether this article is a sparse article or not." - `(memq ,article gnus-newsgroup-sparse)) - -(defmacro gnus-summary-article-ancient-p (article) - "Say whether this article is a sparse article or not." - `(memq ,article gnus-newsgroup-ancient)) - -(defun gnus-article-parent-p (number) - "Say whether this article is a parent or not." - (let ((data (gnus-data-find-list number))) - (and (cdr data) ; There has to be an article after... - (< (gnus-data-level (car data)) ; And it has to have a higher level. - (gnus-data-level (nth 1 data)))))) - -(defun gnus-article-children (number) - "Return a list of all children to NUMBER." - (let* ((data (gnus-data-find-list number)) - (level (gnus-data-level (car data))) - children) - (setq data (cdr data)) - (while (and data - (= (gnus-data-level (car data)) (1+ level))) - (push (gnus-data-number (car data)) children) - (setq data (cdr data))) - children)) - -(defmacro gnus-summary-skip-intangible () - "If the current article is intangible, then jump to a different article." - '(let ((to (get-text-property (point) 'gnus-intangible))) - (and to (gnus-summary-goto-subject to)))) - -(defmacro gnus-summary-article-intangible-p () - "Say whether this article is intangible or not." - '(get-text-property (point) 'gnus-intangible)) - -(defun gnus-article-read-p (article) - "Say whether ARTICLE is read or not." - (not (or (memq article gnus-newsgroup-marked) - (memq article gnus-newsgroup-spam-marked) - (memq article gnus-newsgroup-unreads) - (memq article gnus-newsgroup-unselected) - (memq article gnus-newsgroup-dormant)))) - -;; Some summary mode macros. - -(defmacro gnus-summary-article-number () - "The article number of the article on the current line. -If there isn't an article number here, then we return the current -article number." - '(progn - (gnus-summary-skip-intangible) - (or (get-text-property (point) 'gnus-number) - (gnus-summary-last-subject)))) - -(defmacro gnus-summary-article-header (&optional number) - "Return the header of article NUMBER." - `(gnus-data-header (gnus-data-find - ,(or number '(gnus-summary-article-number))))) - -(defmacro gnus-summary-thread-level (&optional number) - "Return the level of thread that starts with article NUMBER." - `(if (and (eq gnus-summary-make-false-root 'dummy) - (get-text-property (point) 'gnus-intangible)) - 0 - (gnus-data-level (gnus-data-find - ,(or number '(gnus-summary-article-number)))))) - -(defmacro gnus-summary-article-mark (&optional number) - "Return the mark of article NUMBER." - `(gnus-data-mark (gnus-data-find - ,(or number '(gnus-summary-article-number))))) - -(defmacro gnus-summary-article-pos (&optional number) - "Return the position of the line of article NUMBER." - `(gnus-data-pos (gnus-data-find - ,(or number '(gnus-summary-article-number))))) - -(defalias 'gnus-summary-subject-string 'gnus-summary-article-subject) -(defmacro gnus-summary-article-subject (&optional number) - "Return current subject string or nil if nothing." - `(let ((headers - ,(if number - `(gnus-data-header (assq ,number gnus-newsgroup-data)) - '(gnus-data-header (assq (gnus-summary-article-number) - gnus-newsgroup-data))))) - (and headers - (vectorp headers) - (mail-header-subject headers)))) - -(defmacro gnus-summary-article-score (&optional number) - "Return current article score." - `(or (cdr (assq ,(or number '(gnus-summary-article-number)) - gnus-newsgroup-scored)) - gnus-summary-default-score 0)) - -(defun gnus-summary-article-children (&optional number) - "Return a list of article numbers that are children of article NUMBER." - (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number)))) - (level (gnus-data-level (car data))) - l children) - (while (and (setq data (cdr data)) - (> (setq l (gnus-data-level (car data))) level)) - (and (= (1+ level) l) - (push (gnus-data-number (car data)) - children))) - (nreverse children))) - -(defun gnus-summary-article-parent (&optional number) - "Return the article number of the parent of article NUMBER." - (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number)) - (gnus-data-list t))) - (level (gnus-data-level (car data)))) - (if (zerop level) - () ; This is a root. - ;; We search until we find an article with a level less than - ;; this one. That function has to be the parent. - (while (and (setq data (cdr data)) - (not (< (gnus-data-level (car data)) level)))) - (and data (gnus-data-number (car data)))))) - -(defun gnus-unread-mark-p (mark) - "Say whether MARK is the unread mark." - (= mark gnus-unread-mark)) - -(defun gnus-read-mark-p (mark) - "Say whether MARK is one of the marks that mark as read. -This is all marks except unread, ticked, dormant, and expirable." - (not (or (= mark gnus-unread-mark) - (= mark gnus-ticked-mark) - (= mark gnus-spam-mark) - (= mark gnus-dormant-mark) - (= mark gnus-expirable-mark)))) - -(defmacro gnus-article-mark (number) - "Return the MARK of article NUMBER. -This macro should only be used when computing the mark the \"first\" -time; i.e., when generating the summary lines. After that, -`gnus-summary-article-mark' should be used to examine the -marks of articles." - `(cond - ((memq ,number gnus-newsgroup-unsendable) gnus-unsendable-mark) - ((memq ,number gnus-newsgroup-downloadable) gnus-downloadable-mark) - ((memq ,number gnus-newsgroup-unreads) gnus-unread-mark) - ((memq ,number gnus-newsgroup-marked) gnus-ticked-mark) - ((memq ,number gnus-newsgroup-spam-marked) gnus-spam-mark) - ((memq ,number gnus-newsgroup-dormant) gnus-dormant-mark) - ((memq ,number gnus-newsgroup-expirable) gnus-expirable-mark) - (t (or (cdr (assq ,number gnus-newsgroup-reads)) - gnus-ancient-mark)))) - -;; Saving hidden threads. - -(defmacro gnus-save-hidden-threads (&rest forms) - "Save hidden threads, eval FORMS, and restore the hidden threads." - (let ((config (make-symbol "config"))) - `(let ((,config (gnus-hidden-threads-configuration))) - (unwind-protect - (save-excursion - ,@forms) - (gnus-restore-hidden-threads-configuration ,config))))) -(put 'gnus-save-hidden-threads 'lisp-indent-function 0) -(put 'gnus-save-hidden-threads 'edebug-form-spec '(body)) - -(defun gnus-data-compute-positions () - "Compute the positions of all articles." - (setq gnus-newsgroup-data-reverse nil) - (let ((data gnus-newsgroup-data)) - (save-excursion - (gnus-save-hidden-threads - (gnus-summary-show-all-threads) - (goto-char (point-min)) - (while data - (while (get-text-property (point) 'gnus-intangible) - (forward-line 1)) - (gnus-data-set-pos (car data) (+ (point) 3)) - (setq data (cdr data)) - (forward-line 1)))))) - -(defun gnus-hidden-threads-configuration () - "Return the current hidden threads configuration." - (save-excursion - (let (config) - (goto-char (point-min)) - (while (search-forward "\r" nil t) - (push (1- (point)) config)) - config))) - -(defun gnus-restore-hidden-threads-configuration (config) - "Restore hidden threads configuration from CONFIG." - (save-excursion - (let (point buffer-read-only) - (while (setq point (pop config)) - (when (and (< point (point-max)) - (goto-char point) - (eq (char-after) ?\n)) - (subst-char-in-region point (1+ point) ?\n ?\r)))))) - -;; Various summary mode internalish functions. - -(defun gnus-mouse-pick-article (e) - (interactive "e") - (mouse-set-point e) - (gnus-summary-next-page nil t)) - -(defun gnus-summary-set-display-table () - "Change the display table. -Odd characters have a tendency to mess -up nicely formatted displays - we make all possible glyphs -display only a single character." - - ;; We start from the standard display table, if any. - (let ((table (or (copy-sequence standard-display-table) - (make-display-table))) - (i 32)) - ;; Nix out all the control chars... - (while (>= (setq i (1- i)) 0) - (put-display-table i [??] table)) - ;; ... but not newline and cr, of course. (cr is necessary for the - ;; selective display). - (put-display-table ?\n nil table) - (put-display-table ?\r nil table) - ;; We keep TAB as well. - (put-display-table ?\t nil table) - ;; We nix out any glyphs 127 through 255, or 127 through 159 in - ;; Emacs 23 (unicode), that are not set already. - (let ((i (if (ignore-errors (= (make-char 'latin-iso8859-1 160) 160)) - 160 - 256))) - (while (>= (setq i (1- i)) 127) - ;; Only modify if the entry is nil. - (unless (get-display-table i table) - (put-display-table i [??] table)))) - (setq buffer-display-table table))) - -(defun gnus-summary-set-article-display-arrow (pos) - "Update the overlay arrow to point to line at position POS." - (when (and gnus-summary-display-arrow - (boundp 'overlay-arrow-position) - (boundp 'overlay-arrow-string)) - (save-excursion - (goto-char pos) - (beginning-of-line) - (unless overlay-arrow-position - (setq overlay-arrow-position (make-marker))) - (setq overlay-arrow-string "=>" - overlay-arrow-position (set-marker overlay-arrow-position - (point) - (current-buffer)))))) - -(defun gnus-summary-setup-buffer (group) - "Initialize summary buffer." - (let ((buffer (gnus-summary-buffer-name group)) - (dead-name (concat "*Dead Summary " - (gnus-group-decoded-name group) "*"))) - ;; If a dead summary buffer exists, we kill it. - (when (gnus-buffer-live-p dead-name) - (gnus-kill-buffer dead-name)) - (if (get-buffer buffer) - (progn - (set-buffer buffer) - (setq gnus-summary-buffer (current-buffer)) - (not gnus-newsgroup-prepared)) - ;; Fix by Sudish Joseph - (setq gnus-summary-buffer (set-buffer (gnus-get-buffer-create buffer))) - (gnus-summary-mode group) - (when gnus-carpal - (gnus-carpal-setup-buffer 'summary)) - (unless gnus-single-article-buffer - (make-local-variable 'gnus-article-buffer) - (make-local-variable 'gnus-article-current) - (make-local-variable 'gnus-original-article-buffer)) - (setq gnus-newsgroup-name group) - ;; Set any local variables in the group parameters. - (gnus-summary-set-local-parameters gnus-newsgroup-name) - t))) - -(defun gnus-set-global-variables () - "Set the global equivalents of the buffer-local variables. -They are set to the latest values they had. These reflect the summary -buffer that was in action when the last article was fetched." - (when (eq major-mode 'gnus-summary-mode) - (setq gnus-summary-buffer (current-buffer)) - (let ((name gnus-newsgroup-name) - (marked gnus-newsgroup-marked) - (spam gnus-newsgroup-spam-marked) - (unread gnus-newsgroup-unreads) - (headers gnus-current-headers) - (data gnus-newsgroup-data) - (summary gnus-summary-buffer) - (article-buffer gnus-article-buffer) - (original gnus-original-article-buffer) - (gac gnus-article-current) - (reffed gnus-reffed-article-number) - (score-file gnus-current-score-file) - (default-charset gnus-newsgroup-charset) - vlist) - (let ((locals gnus-newsgroup-variables)) - (while locals - (if (consp (car locals)) - (push (eval (caar locals)) vlist) - (push (eval (car locals)) vlist)) - (setq locals (cdr locals))) - (setq vlist (nreverse vlist))) - (save-excursion - (set-buffer gnus-group-buffer) - (setq gnus-newsgroup-name name - gnus-newsgroup-marked marked - gnus-newsgroup-spam-marked spam - gnus-newsgroup-unreads unread - gnus-current-headers headers - gnus-newsgroup-data data - gnus-article-current gac - gnus-summary-buffer summary - gnus-article-buffer article-buffer - gnus-original-article-buffer original - gnus-reffed-article-number reffed - gnus-current-score-file score-file - gnus-newsgroup-charset default-charset) - (let ((locals gnus-newsgroup-variables)) - (while locals - (if (consp (car locals)) - (set (caar locals) (pop vlist)) - (set (car locals) (pop vlist))) - (setq locals (cdr locals)))) - ;; The article buffer also has local variables. - (when (gnus-buffer-live-p gnus-article-buffer) - (set-buffer gnus-article-buffer) - (setq gnus-summary-buffer summary)))))) - -(defun gnus-summary-article-unread-p (article) - "Say whether ARTICLE is unread or not." - (memq article gnus-newsgroup-unreads)) - -(defun gnus-summary-first-article-p (&optional article) - "Return whether ARTICLE is the first article in the buffer." - (if (not (setq article (or article (gnus-summary-article-number)))) - nil - (eq article (caar gnus-newsgroup-data)))) - -(defun gnus-summary-last-article-p (&optional article) - "Return whether ARTICLE is the last article in the buffer." - (if (not (setq article (or article (gnus-summary-article-number)))) - ;; All non-existent numbers are the last article. :-) - t - (not (cdr (gnus-data-find-list article))))) - -(defun gnus-make-thread-indent-array (&optional n) - (when (or n - (progn (setq n 200) nil) - (null gnus-thread-indent-array) - (/= gnus-thread-indent-level gnus-thread-indent-array-level)) - (setq gnus-thread-indent-array (make-vector (1+ n) "") - gnus-thread-indent-array-level gnus-thread-indent-level) - (while (>= n 0) - (aset gnus-thread-indent-array n - (make-string (* n gnus-thread-indent-level) ? )) - (setq n (1- n))))) - -(defun gnus-update-summary-mark-positions () - "Compute where the summary marks are to go." - (save-excursion - (when (gnus-buffer-exists-p gnus-summary-buffer) - (set-buffer gnus-summary-buffer)) - (let ((spec gnus-summary-line-format-spec) - pos) - (save-excursion - (gnus-set-work-buffer) - (let ((gnus-tmp-unread ?Z) - (gnus-replied-mark ?Z) - (gnus-score-below-mark ?Z) - (gnus-score-over-mark ?Z) - (gnus-undownloaded-mark ?Z) - (gnus-summary-line-format-spec spec) - (gnus-newsgroup-downloadable '(0)) - (header [0 "" "" "05 Apr 2001 23:33:09 +0400" "" "" 0 0 "" nil]) - case-fold-search ignores) - ;; Here, all marks are bound to Z. - (gnus-summary-insert-line header - 0 nil t gnus-tmp-unread t nil "" nil 1) - (goto-char (point-min)) - ;; Memorize the positions of the same characters as dummy marks. - (while (re-search-forward "[A-D]" nil t) - (push (point) ignores)) - (erase-buffer) - ;; We use A-D as dummy marks in order to know column positions - ;; where marks should be inserted. - (setq gnus-tmp-unread ?A - gnus-replied-mark ?B - gnus-score-below-mark ?C - gnus-score-over-mark ?C - gnus-undownloaded-mark ?D) - (gnus-summary-insert-line header - 0 nil t gnus-tmp-unread t nil "" nil 1) - ;; Ignore characters which aren't dummy marks. - (dolist (p ignores) - (delete-region (goto-char (1- p)) p) - (insert ?Z)) - (goto-char (point-min)) - (setq pos (list (cons 'unread - (and (search-forward "A" nil t) - (- (point) (point-min) 1))))) - (goto-char (point-min)) - (push (cons 'replied (and (search-forward "B" nil t) - (- (point) (point-min) 1))) - pos) - (goto-char (point-min)) - (push (cons 'score (and (search-forward "C" nil t) - (- (point) (point-min) 1))) - pos) - (goto-char (point-min)) - (push (cons 'download (and (search-forward "D" nil t) - (- (point) (point-min) 1))) - pos))) - (setq gnus-summary-mark-positions pos)))) - -(defun gnus-summary-insert-dummy-line (gnus-tmp-subject gnus-tmp-number) - "Insert a dummy root in the summary buffer." - (beginning-of-line) - (gnus-add-text-properties - (point) (progn (eval gnus-summary-dummy-line-format-spec) (point)) - (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number))) - -(defun gnus-summary-extract-address-component (from) - (or (car (funcall gnus-extract-address-components from)) - from)) - -(defun gnus-summary-from-or-to-or-newsgroups (header gnus-tmp-from) - (let ((mail-parse-charset gnus-newsgroup-charset) - ; Is it really necessary to do this next part for each summary line? - ; Luckily, doesn't seem to slow things down much. - (mail-parse-ignored-charsets - (save-excursion (set-buffer gnus-summary-buffer) - gnus-newsgroup-ignored-charsets))) - (or - (and gnus-ignored-from-addresses - (string-match gnus-ignored-from-addresses gnus-tmp-from) - (let ((extra-headers (mail-header-extra header)) - to - newsgroups) - (cond - ((setq to (cdr (assq 'To extra-headers))) - (concat "-> " - (inline - (gnus-summary-extract-address-component - (funcall gnus-decode-encoded-address-function to))))) - ((setq newsgroups (cdr (assq 'Newsgroups extra-headers))) - (concat "=> " newsgroups))))) - (inline (gnus-summary-extract-address-component gnus-tmp-from))))) - -(defun gnus-summary-insert-line (gnus-tmp-header - gnus-tmp-level gnus-tmp-current - undownloaded gnus-tmp-unread gnus-tmp-replied - gnus-tmp-expirable gnus-tmp-subject-or-nil - &optional gnus-tmp-dummy gnus-tmp-score - gnus-tmp-process) - (if (>= gnus-tmp-level (length gnus-thread-indent-array)) - (gnus-make-thread-indent-array (max (* 2 (length gnus-thread-indent-array)) - gnus-tmp-level))) - (let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level)) - (gnus-tmp-lines (mail-header-lines gnus-tmp-header)) - (gnus-tmp-score (or gnus-tmp-score gnus-summary-default-score 0)) - (gnus-tmp-score-char - (if (or (null gnus-summary-default-score) - (<= (abs (- gnus-tmp-score gnus-summary-default-score)) - gnus-summary-zcore-fuzz)) - ? ;Whitespace - (if (< gnus-tmp-score gnus-summary-default-score) - gnus-score-below-mark gnus-score-over-mark))) - (gnus-tmp-number (mail-header-number gnus-tmp-header)) - (gnus-tmp-replied - (cond (gnus-tmp-process gnus-process-mark) - ((memq gnus-tmp-current gnus-newsgroup-cached) - gnus-cached-mark) - (gnus-tmp-replied gnus-replied-mark) - ((memq gnus-tmp-current gnus-newsgroup-forwarded) - gnus-forwarded-mark) - ((memq gnus-tmp-current gnus-newsgroup-saved) - gnus-saved-mark) - ((memq gnus-tmp-number gnus-newsgroup-recent) - gnus-recent-mark) - ((memq gnus-tmp-number gnus-newsgroup-unseen) - gnus-unseen-mark) - (t gnus-no-mark))) - (gnus-tmp-downloaded - (cond (undownloaded - gnus-undownloaded-mark) - (gnus-newsgroup-agentized - gnus-downloaded-mark) - (t - gnus-no-mark))) - (gnus-tmp-from (mail-header-from gnus-tmp-header)) - (gnus-tmp-name - (cond - ((string-match "<[^>]+> *$" gnus-tmp-from) - (let ((beg (match-beginning 0))) - (or (and (string-match "^\".+\"" gnus-tmp-from) - (substring gnus-tmp-from 1 (1- (match-end 0)))) - (substring gnus-tmp-from 0 beg)))) - ((string-match "(.+)" gnus-tmp-from) - (substring gnus-tmp-from - (1+ (match-beginning 0)) (1- (match-end 0)))) - (t gnus-tmp-from))) - (gnus-tmp-subject (mail-header-subject gnus-tmp-header)) - (gnus-tmp-opening-bracket (if gnus-tmp-dummy ?\< ?\[)) - (gnus-tmp-closing-bracket (if gnus-tmp-dummy ?\> ?\])) - (buffer-read-only nil)) - (when (string= gnus-tmp-name "") - (setq gnus-tmp-name gnus-tmp-from)) - (unless (numberp gnus-tmp-lines) - (setq gnus-tmp-lines -1)) - (if (= gnus-tmp-lines -1) - (setq gnus-tmp-lines "?") - (setq gnus-tmp-lines (number-to-string gnus-tmp-lines))) - (gnus-put-text-property - (point) - (progn (eval gnus-summary-line-format-spec) (point)) - 'gnus-number gnus-tmp-number) - (when (gnus-visual-p 'summary-highlight 'highlight) - (forward-line -1) - (gnus-run-hooks 'gnus-summary-update-hook) - (forward-line 1)))) - -(defun gnus-summary-update-line (&optional dont-update) - "Update summary line after change." - (when (and gnus-summary-default-score - (not gnus-summary-inhibit-highlight)) - (let* ((gnus-summary-inhibit-highlight t) ; Prevent recursion. - (article (gnus-summary-article-number)) - (score (gnus-summary-article-score article))) - (unless dont-update - (if (and gnus-summary-mark-below - (< (gnus-summary-article-score) - gnus-summary-mark-below)) - ;; This article has a low score, so we mark it as read. - (when (memq article gnus-newsgroup-unreads) - (gnus-summary-mark-article-as-read gnus-low-score-mark)) - (when (eq (gnus-summary-article-mark) gnus-low-score-mark) - ;; This article was previously marked as read on account - ;; of a low score, but now it has risen, so we mark it as - ;; unread. - (gnus-summary-mark-article-as-unread gnus-unread-mark))) - (gnus-summary-update-mark - (if (or (null gnus-summary-default-score) - (<= (abs (- score gnus-summary-default-score)) - gnus-summary-zcore-fuzz)) - ? ;Whitespace - (if (< score gnus-summary-default-score) - gnus-score-below-mark gnus-score-over-mark)) - 'score)) - ;; Do visual highlighting. - (when (gnus-visual-p 'summary-highlight 'highlight) - (gnus-run-hooks 'gnus-summary-update-hook))))) - -(defvar gnus-tmp-new-adopts nil) - -(defun gnus-summary-number-of-articles-in-thread (thread &optional level char) - "Return the number of articles in THREAD. -This may be 0 in some cases -- if none of the articles in -the thread are to be displayed." - (let* ((number - ;; Fix by Luc Van Eycken . - (cond - ((not (listp thread)) - 1) - ((and (consp thread) (cdr thread)) - (apply - '+ 1 (mapcar - 'gnus-summary-number-of-articles-in-thread (cdr thread)))) - ((null thread) - 1) - ((memq (mail-header-number (car thread)) gnus-newsgroup-limit) - 1) - (t 0)))) - (when (and level (zerop level) gnus-tmp-new-adopts) - (incf number - (apply '+ (mapcar - 'gnus-summary-number-of-articles-in-thread - gnus-tmp-new-adopts)))) - (if char - (if (> number 1) gnus-not-empty-thread-mark - gnus-empty-thread-mark) - number))) - -(defsubst gnus-summary-line-message-size (head) - "Return pretty-printed version of message size. -This function is intended to be used in -`gnus-summary-line-format-alist'." - (let ((c (or (mail-header-chars head) -1))) - (cond ((< c 0) "n/a") ; chars not available - ((< c (* 1000 10)) (format "%1.1fk" (/ c 1024.0))) - ((< c (* 1000 100)) (format "%dk" (/ c 1024.0))) - ((< c (* 1000 10000)) (format "%1.1fM" (/ c (* 1024.0 1024)))) - (t (format "%dM" (/ c (* 1024.0 1024))))))) - - -(defun gnus-summary-set-local-parameters (group) - "Go through the local params of GROUP and set all variable specs in that list." - (let ((params (gnus-group-find-parameter group)) - (vars '(quit-config)) ; Ignore quit-config. - elem) - (while params - (setq elem (car params) - params (cdr params)) - (and (consp elem) ; Has to be a cons. - (consp (cdr elem)) ; The cdr has to be a list. - (symbolp (car elem)) ; Has to be a symbol in there. - (not (memq (car elem) vars)) - (ignore-errors ; So we set it. - (push (car elem) vars) - (make-local-variable (car elem)) - (set (car elem) (eval (nth 1 elem)))))))) - -(defun gnus-summary-read-group (group &optional show-all no-article - kill-buffer no-display backward - select-articles) - "Start reading news in newsgroup GROUP. -If SHOW-ALL is non-nil, already read articles are also listed. -If NO-ARTICLE is non-nil, no article is selected initially. -If NO-DISPLAY, don't generate a summary buffer." - (let (result) - (while (and group - (null (setq result - (let ((gnus-auto-select-next nil)) - (or (gnus-summary-read-group-1 - group show-all no-article - kill-buffer no-display - select-articles) - (setq show-all nil - select-articles nil))))) - (eq gnus-auto-select-next 'quietly)) - (set-buffer gnus-group-buffer) - ;; The entry function called above goes to the next - ;; group automatically, so we go two groups back - ;; if we are searching for the previous group. - (when backward - (gnus-group-prev-unread-group 2)) - (if (not (equal group (gnus-group-group-name))) - (setq group (gnus-group-group-name)) - (setq group nil))) - result)) - -(defun gnus-summary-read-group-1 (group show-all no-article - kill-buffer no-display - &optional select-articles) - ;; Killed foreign groups can't be entered. - ;; (when (and (not (gnus-group-native-p group)) - ;; (not (gnus-gethash group gnus-newsrc-hashtb))) - ;; (error "Dead non-native groups can't be entered")) - (gnus-message 5 "Retrieving newsgroup: %s..." - (gnus-group-decoded-name group)) - (let* ((new-group (gnus-summary-setup-buffer group)) - (quit-config (gnus-group-quit-config group)) - (did-select (and new-group (gnus-select-newsgroup - group show-all select-articles)))) - (cond - ;; This summary buffer exists already, so we just select it. - ((not new-group) - (gnus-set-global-variables) - (when kill-buffer - (gnus-kill-or-deaden-summary kill-buffer)) - (gnus-configure-windows 'summary 'force) - (gnus-set-mode-line 'summary) - (gnus-summary-position-point) - (message "") - t) - ;; We couldn't select this group. - ((null did-select) - (when (and (eq major-mode 'gnus-summary-mode) - (not (equal (current-buffer) kill-buffer))) - (kill-buffer (current-buffer)) - (if (not quit-config) - (progn - ;; Update the info -- marks might need to be removed, - ;; for instance. - (gnus-summary-update-info) - (set-buffer gnus-group-buffer) - (gnus-group-jump-to-group group) - (gnus-group-next-unread-group 1)) - (gnus-handle-ephemeral-exit quit-config))) - (let ((grpinfo (gnus-get-info group))) - (if (null (gnus-info-read grpinfo)) - (gnus-message 3 "Group %s contains no messages" - (gnus-group-decoded-name group)) - (gnus-message 3 "Can't select group"))) - nil) - ;; The user did a `C-g' while prompting for number of articles, - ;; so we exit this group. - ((eq did-select 'quit) - (and (eq major-mode 'gnus-summary-mode) - (not (equal (current-buffer) kill-buffer)) - (kill-buffer (current-buffer))) - (when kill-buffer - (gnus-kill-or-deaden-summary kill-buffer)) - (if (not quit-config) - (progn - (set-buffer gnus-group-buffer) - (gnus-group-jump-to-group group) - (gnus-group-next-unread-group 1) - (gnus-configure-windows 'group 'force)) - (gnus-handle-ephemeral-exit quit-config)) - ;; Finally signal the quit. - (signal 'quit nil)) - ;; The group was successfully selected. - (t - (gnus-set-global-variables) - ;; Save the active value in effect when the group was entered. - (setq gnus-newsgroup-active - (gnus-copy-sequence - (gnus-active gnus-newsgroup-name))) - ;; You can change the summary buffer in some way with this hook. - (gnus-run-hooks 'gnus-select-group-hook) - (when (memq 'summary (gnus-update-format-specifications - nil 'summary 'summary-mode 'summary-dummy)) - ;; The format specification for the summary line was updated, - ;; so we need to update the mark positions as well. - (gnus-update-summary-mark-positions)) - ;; Do score processing. - (when gnus-use-scoring - (gnus-possibly-score-headers)) - ;; Check whether to fill in the gaps in the threads. - (when gnus-build-sparse-threads - (gnus-build-sparse-threads)) - ;; Find the initial limit. - (if show-all - (let ((gnus-newsgroup-dormant nil)) - (gnus-summary-initial-limit show-all)) - (gnus-summary-initial-limit show-all)) - ;; Generate the summary buffer. - (unless no-display - (gnus-summary-prepare)) - (when gnus-use-trees - (gnus-tree-open group) - (setq gnus-summary-highlight-line-function - 'gnus-tree-highlight-article)) - ;; If the summary buffer is empty, but there are some low-scored - ;; articles or some excluded dormants, we include these in the - ;; buffer. - (when (and (zerop (buffer-size)) - (not no-display)) - (cond (gnus-newsgroup-dormant - (gnus-summary-limit-include-dormant)) - ((and gnus-newsgroup-scored show-all) - (gnus-summary-limit-include-expunged t)))) - ;; Function `gnus-apply-kill-file' must be called in this hook. - (gnus-run-hooks 'gnus-apply-kill-hook) - (if (and (zerop (buffer-size)) - (not no-display)) - (progn - ;; This newsgroup is empty. - (gnus-summary-catchup-and-exit nil t) - (gnus-message 6 "No unread news") - (when kill-buffer - (gnus-kill-or-deaden-summary kill-buffer)) - ;; Return nil from this function. - nil) - ;; Hide conversation thread subtrees. We cannot do this in - ;; gnus-summary-prepare-hook since kill processing may not - ;; work with hidden articles. - (gnus-summary-maybe-hide-threads) - (when kill-buffer - (gnus-kill-or-deaden-summary kill-buffer)) - (gnus-summary-auto-select-subject) - ;; Show first unread article if requested. - (if (and (not no-article) - (not no-display) - gnus-newsgroup-unreads - gnus-auto-select-first) - (progn - (gnus-configure-windows 'summary) - (let ((art (gnus-summary-article-number))) - (unless (and (not gnus-plugged) - (or (memq art gnus-newsgroup-undownloaded) - (memq art gnus-newsgroup-downloadable))) - (gnus-summary-goto-article art)))) - ;; Don't select any articles. - (gnus-summary-position-point) - (gnus-configure-windows 'summary 'force) - (gnus-set-mode-line 'summary)) - (when (and gnus-auto-center-group - (get-buffer-window gnus-group-buffer t)) - ;; Gotta use windows, because recenter does weird stuff if - ;; the current buffer ain't the displayed window. - (let ((owin (selected-window))) - (select-window (get-buffer-window gnus-group-buffer t)) - (when (gnus-group-goto-group group) - (recenter)) - (select-window owin))) - ;; Mark this buffer as "prepared". - (setq gnus-newsgroup-prepared t) - (gnus-run-hooks 'gnus-summary-prepared-hook) - (unless (gnus-ephemeral-group-p group) - (gnus-group-update-group group)) - t))))) - -(defun gnus-summary-auto-select-subject () - "Select the subject line on initial group entry." - (goto-char (point-min)) - (cond - ((eq gnus-auto-select-subject 'best) - (gnus-summary-best-unread-subject)) - ((eq gnus-auto-select-subject 'unread) - (gnus-summary-first-unread-subject)) - ((eq gnus-auto-select-subject 'unseen) - (gnus-summary-first-unseen-subject)) - ((eq gnus-auto-select-subject 'unseen-or-unread) - (gnus-summary-first-unseen-or-unread-subject)) - ((eq gnus-auto-select-subject 'first) - ;; Do nothing. - ) - ((functionp gnus-auto-select-subject) - (funcall gnus-auto-select-subject)))) - -(defun gnus-summary-prepare () - "Generate the summary buffer." - (interactive) - (let ((buffer-read-only nil)) - (erase-buffer) - (setq gnus-newsgroup-data nil - gnus-newsgroup-data-reverse nil) - (gnus-run-hooks 'gnus-summary-generate-hook) - ;; Generate the buffer, either with threads or without. - (when gnus-newsgroup-headers - (gnus-summary-prepare-threads - (if gnus-show-threads - (gnus-sort-gathered-threads - (funcall gnus-summary-thread-gathering-function - (gnus-sort-threads - (gnus-cut-threads (gnus-make-threads))))) - ;; Unthreaded display. - (gnus-sort-articles gnus-newsgroup-headers)))) - (setq gnus-newsgroup-data (nreverse gnus-newsgroup-data)) - ;; Call hooks for modifying summary buffer. - (goto-char (point-min)) - (gnus-run-hooks 'gnus-summary-prepare-hook))) - -(defsubst gnus-general-simplify-subject (subject) - "Simplify subject by the same rules as `gnus-gather-threads-by-subject'." - (setq subject - (cond - ;; Truncate the subject. - (gnus-simplify-subject-functions - (gnus-map-function gnus-simplify-subject-functions subject)) - ((numberp gnus-summary-gather-subject-limit) - (setq subject (gnus-simplify-subject-re subject)) - (if (> (length subject) gnus-summary-gather-subject-limit) - (substring subject 0 gnus-summary-gather-subject-limit) - subject)) - ;; Fuzzily simplify it. - ((eq 'fuzzy gnus-summary-gather-subject-limit) - (gnus-simplify-subject-fuzzy subject)) - ;; Just remove the leading "Re:". - (t - (gnus-simplify-subject-re subject)))) - - (if (and gnus-summary-gather-exclude-subject - (string-match gnus-summary-gather-exclude-subject subject)) - nil ; This article shouldn't be gathered - subject)) - -(defun gnus-summary-simplify-subject-query () - "Query where the respool algorithm would put this article." - (interactive) - (gnus-summary-select-article) - (message (gnus-general-simplify-subject (gnus-summary-article-subject)))) - -(defun gnus-gather-threads-by-subject (threads) - "Gather threads by looking at Subject headers." - (if (not gnus-summary-make-false-root) - threads - (let ((hashtb (gnus-make-hashtable 1024)) - (prev threads) - (result threads) - subject hthread whole-subject) - (while threads - (setq subject (gnus-general-simplify-subject - (setq whole-subject (mail-header-subject - (caar threads))))) - (when subject - (if (setq hthread (gnus-gethash subject hashtb)) - (progn - ;; We enter a dummy root into the thread, if we - ;; haven't done that already. - (unless (stringp (caar hthread)) - (setcar hthread (list whole-subject (car hthread)))) - ;; We add this new gathered thread to this gathered - ;; thread. - (setcdr (car hthread) - (nconc (cdar hthread) (list (car threads)))) - ;; Remove it from the list of threads. - (setcdr prev (cdr threads)) - (setq threads prev)) - ;; Enter this thread into the hash table. - (gnus-sethash subject - (if gnus-summary-make-false-root-always - (progn - ;; If you want a dummy root above all - ;; threads... - (setcar threads (list whole-subject - (car threads))) - threads) - threads) - hashtb))) - (setq prev threads) - (setq threads (cdr threads))) - result))) - -(defun gnus-gather-threads-by-references (threads) - "Gather threads by looking at References headers." - (let ((idhashtb (gnus-make-hashtable 1024)) - (thhashtb (gnus-make-hashtable 1024)) - (prev threads) - (result threads) - ids references id gthread gid entered ref) - (while threads - (when (setq references (mail-header-references (caar threads))) - (setq id (mail-header-id (caar threads)) - ids (inline (gnus-split-references references)) - entered nil) - (while (setq ref (pop ids)) - (setq ids (delete ref ids)) - (if (not (setq gid (gnus-gethash ref idhashtb))) - (progn - (gnus-sethash ref id idhashtb) - (gnus-sethash id threads thhashtb)) - (setq gthread (gnus-gethash gid thhashtb)) - (unless entered - ;; We enter a dummy root into the thread, if we - ;; haven't done that already. - (unless (stringp (caar gthread)) - (setcar gthread (list (mail-header-subject (caar gthread)) - (car gthread)))) - ;; We add this new gathered thread to this gathered - ;; thread. - (setcdr (car gthread) - (nconc (cdar gthread) (list (car threads))))) - ;; Add it into the thread hash table. - (gnus-sethash id gthread thhashtb) - (setq entered t) - ;; Remove it from the list of threads. - (setcdr prev (cdr threads)) - (setq threads prev)))) - (setq prev threads) - (setq threads (cdr threads))) - result)) - -(defun gnus-sort-gathered-threads (threads) - "Sort subtreads inside each gathered thread by `gnus-sort-gathered-threads-function'." - (let ((result threads)) - (while threads - (when (stringp (caar threads)) - (setcdr (car threads) - (sort (cdar threads) gnus-sort-gathered-threads-function))) - (setq threads (cdr threads))) - result)) - -(defun gnus-thread-loop-p (root thread) - "Say whether ROOT is in THREAD." - (let ((stack (list thread)) - (infloop 0) - th) - (while (setq thread (pop stack)) - (setq th (cdr thread)) - (while (and th - (not (eq (caar th) root))) - (pop th)) - (if th - ;; We have found a loop. - (let (ref-dep) - (setcdr thread (delq (car th) (cdr thread))) - (if (boundp (setq ref-dep (intern "none" - gnus-newsgroup-dependencies))) - (setcdr (symbol-value ref-dep) - (nconc (cdr (symbol-value ref-dep)) - (list (car th)))) - (set ref-dep (list nil (car th)))) - (setq infloop 1 - stack nil)) - ;; Push all the subthreads onto the stack. - (push (cdr thread) stack))) - infloop)) - -(defun gnus-make-threads () - "Go through the dependency hashtb and find the roots. Return all threads." - (let (threads) - (while (catch 'infloop - (mapatoms - (lambda (refs) - ;; Deal with self-referencing References loops. - (when (and (car (symbol-value refs)) - (not (zerop - (apply - '+ - (mapcar - (lambda (thread) - (gnus-thread-loop-p - (car (symbol-value refs)) thread)) - (cdr (symbol-value refs))))))) - (setq threads nil) - (throw 'infloop t)) - (unless (car (symbol-value refs)) - ;; These threads do not refer back to any other - ;; articles, so they're roots. - (setq threads (append (cdr (symbol-value refs)) threads)))) - gnus-newsgroup-dependencies))) - threads)) - -;; Build the thread tree. -(defsubst gnus-dependencies-add-header (header dependencies force-new) - "Enter HEADER into the DEPENDENCIES table if it is not already there. - -If FORCE-NEW is not nil, enter HEADER into the DEPENDENCIES table even -if it was already present. - -If `gnus-summary-ignore-duplicates' is nil then duplicate Message-IDs -will not be entered in the DEPENDENCIES table. Otherwise duplicate -Message-IDs will be renamed to a unique Message-ID before being -entered. - -Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." - (let* ((id (mail-header-id header)) - (id-dep (and id (intern id dependencies))) - parent-id ref ref-dep ref-header replaced) - ;; Enter this `header' in the `dependencies' table. - (cond - ((not id-dep) - (setq header nil)) - ;; The first two cases do the normal part: enter a new `header' - ;; in the `dependencies' table. - ((not (boundp id-dep)) - (set id-dep (list header))) - ((null (car (symbol-value id-dep))) - (setcar (symbol-value id-dep) header)) - - ;; From here the `header' was already present in the - ;; `dependencies' table. - (force-new - ;; Overrides an existing entry; - ;; just set the header part of the entry. - (setcar (symbol-value id-dep) header) - (setq replaced t)) - - ;; Renames the existing `header' to a unique Message-ID. - ((not gnus-summary-ignore-duplicates) - ;; An article with this Message-ID has already been seen. - ;; We rename the Message-ID. - (set (setq id-dep (intern (setq id (nnmail-message-id)) dependencies)) - (list header)) - (mail-header-set-id header id)) - - ;; The last case ignores an existing entry, except it adds any - ;; additional Xrefs (in case the two articles came from different - ;; servers. - ;; Also sets `header' to `nil' meaning that the `dependencies' - ;; table was *not* modified. - (t - (mail-header-set-xref - (car (symbol-value id-dep)) - (concat (or (mail-header-xref (car (symbol-value id-dep))) - "") - (or (mail-header-xref header) ""))) - (setq header nil))) - - (when (and header (not replaced)) - ;; First check that we are not creating a References loop. - (setq parent-id (gnus-parent-id (mail-header-references header))) - (setq ref parent-id) - (while (and ref - (setq ref-dep (intern-soft ref dependencies)) - (boundp ref-dep) - (setq ref-header (car (symbol-value ref-dep)))) - (if (string= id ref) - ;; Yuk! This is a reference loop. Make the article be a - ;; root article. - (progn - (mail-header-set-references (car (symbol-value id-dep)) "none") - (setq ref nil) - (setq parent-id nil)) - (setq ref (gnus-parent-id (mail-header-references ref-header))))) - (setq ref-dep (intern (or parent-id "none") dependencies)) - (if (boundp ref-dep) - (setcdr (symbol-value ref-dep) - (nconc (cdr (symbol-value ref-dep)) - (list (symbol-value id-dep)))) - (set ref-dep (list nil (symbol-value id-dep))))) - header)) - -(defun gnus-extract-message-id-from-in-reply-to (string) - (if (string-match "<[^>]+>" string) - (substring string (match-beginning 0) (match-end 0)) - nil)) - -(defun gnus-build-sparse-threads () - (let ((headers gnus-newsgroup-headers) - (mail-parse-charset gnus-newsgroup-charset) - (gnus-summary-ignore-duplicates t) - header references generation relations - subject child end new-child date) - ;; First we create an alist of generations/relations, where - ;; generations is how much we trust the relation, and the relation - ;; is parent/child. - (gnus-message 7 "Making sparse threads...") - (save-excursion - (nnheader-set-temp-buffer " *gnus sparse threads*") - (while (setq header (pop headers)) - (when (and (setq references (mail-header-references header)) - (not (string= references ""))) - (insert references) - (setq child (mail-header-id header) - subject (mail-header-subject header) - date (mail-header-date header) - generation 0) - (while (search-backward ">" nil t) - (setq end (1+ (point))) - (when (search-backward "<" nil t) - (setq new-child (buffer-substring (point) end)) - (push (list (incf generation) - child (setq child new-child) - subject date) - relations))) - (when child - (push (list (1+ generation) child nil subject) relations)) - (erase-buffer))) - (kill-buffer (current-buffer))) - ;; Sort over trustworthiness. - (mapcar - (lambda (relation) - (when (gnus-dependencies-add-header - (make-full-mail-header - gnus-reffed-article-number - (nth 3 relation) "" (or (nth 4 relation) "") - (nth 1 relation) - (or (nth 2 relation) "") 0 0 "") - gnus-newsgroup-dependencies nil) - (push gnus-reffed-article-number gnus-newsgroup-limit) - (push gnus-reffed-article-number gnus-newsgroup-sparse) - (push (cons gnus-reffed-article-number gnus-sparse-mark) - gnus-newsgroup-reads) - (decf gnus-reffed-article-number))) - (sort relations 'car-less-than-car)) - (gnus-message 7 "Making sparse threads...done"))) - -(defun gnus-build-old-threads () - ;; Look at all the articles that refer back to old articles, and - ;; fetch the headers for the articles that aren't there. This will - ;; build complete threads - if the roots haven't been expired by the - ;; server, that is. - (let ((mail-parse-charset gnus-newsgroup-charset) - id heads) - (mapatoms - (lambda (refs) - (when (not (car (symbol-value refs))) - (setq heads (cdr (symbol-value refs))) - (while heads - (if (memq (mail-header-number (caar heads)) - gnus-newsgroup-dormant) - (setq heads (cdr heads)) - (setq id (symbol-name refs)) - (while (and (setq id (gnus-build-get-header id)) - (not (car (gnus-id-to-thread id))))) - (setq heads nil))))) - gnus-newsgroup-dependencies))) - -(defsubst gnus-remove-odd-characters (string) - "Translate STRING into something that doesn't contain weird characters." - (mm-subst-char-in-string - ?\r ?\- - (mm-subst-char-in-string - ?\n ?\- string))) - -;; This function has to be called with point after the article number -;; on the beginning of the line. -(defsubst gnus-nov-parse-line (number dependencies &optional force-new) - (let ((eol (gnus-point-at-eol)) - (buffer (current-buffer)) - header references in-reply-to) - - ;; overview: [num subject from date id refs chars lines misc] - (unwind-protect - (let (x) - (narrow-to-region (point) eol) - (unless (eobp) - (forward-char)) - - (setq header - (make-full-mail-header - number ; number - (condition-case () ; subject - (gnus-remove-odd-characters - (funcall gnus-decode-encoded-word-function - (setq x (nnheader-nov-field)))) - (error x)) - (condition-case () ; from - (gnus-remove-odd-characters - (funcall gnus-decode-encoded-address-function - (setq x (nnheader-nov-field)))) - (error x)) - (nnheader-nov-field) ; date - (nnheader-nov-read-message-id) ; id - (setq references (nnheader-nov-field)) ; refs - (nnheader-nov-read-integer) ; chars - (nnheader-nov-read-integer) ; lines - (unless (eobp) - (if (looking-at "Xref: ") - (goto-char (match-end 0))) - (nnheader-nov-field)) ; Xref - (nnheader-nov-parse-extra)))) ; extra - - (widen)) - - (when (and (string= references "") - (setq in-reply-to (mail-header-extra header)) - (setq in-reply-to (cdr (assq 'In-Reply-To in-reply-to)))) - (mail-header-set-references - header (gnus-extract-message-id-from-in-reply-to in-reply-to))) - - (when gnus-alter-header-function - (funcall gnus-alter-header-function header)) - (gnus-dependencies-add-header header dependencies force-new))) - -(defun gnus-build-get-header (id) - "Look through the buffer of NOV lines and find the header to ID. -Enter this line into the dependencies hash table, and return -the id of the parent article (if any)." - (let ((deps gnus-newsgroup-dependencies) - found header) - (prog1 - (save-excursion - (set-buffer nntp-server-buffer) - (let ((case-fold-search nil)) - (goto-char (point-min)) - (while (and (not found) - (search-forward id nil t)) - (beginning-of-line) - (setq found (looking-at - (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s" - (regexp-quote id)))) - (or found (beginning-of-line 2))) - (when found - (beginning-of-line) - (and - (setq header (gnus-nov-parse-line - (read (current-buffer)) deps)) - (gnus-parent-id (mail-header-references header)))))) - (when header - (let ((number (mail-header-number header))) - (push number gnus-newsgroup-limit) - (push header gnus-newsgroup-headers) - (if (memq number gnus-newsgroup-unselected) - (progn - (setq gnus-newsgroup-unreads - (gnus-add-to-sorted-list gnus-newsgroup-unreads - number)) - (setq gnus-newsgroup-unselected - (delq number gnus-newsgroup-unselected))) - (push number gnus-newsgroup-ancient))))))) - -(defun gnus-build-all-threads () - "Read all the headers." - (let ((gnus-summary-ignore-duplicates t) - (mail-parse-charset gnus-newsgroup-charset) - (dependencies gnus-newsgroup-dependencies) - header article) - (save-excursion - (set-buffer nntp-server-buffer) - (let ((case-fold-search nil)) - (goto-char (point-min)) - (while (not (eobp)) - (ignore-errors - (setq article (read (current-buffer)) - header (gnus-nov-parse-line article dependencies))) - (when header - (save-excursion - (set-buffer gnus-summary-buffer) - (push header gnus-newsgroup-headers) - (if (memq (setq article (mail-header-number header)) - gnus-newsgroup-unselected) - (progn - (setq gnus-newsgroup-unreads - (gnus-add-to-sorted-list - gnus-newsgroup-unreads article)) - (setq gnus-newsgroup-unselected - (delq article gnus-newsgroup-unselected))) - (push article gnus-newsgroup-ancient))) - (forward-line 1))))))) - -(defun gnus-summary-update-article-line (article header) - "Update the line for ARTICLE using HEADER." - (let* ((id (mail-header-id header)) - (thread (gnus-id-to-thread id))) - (unless thread - (error "Article in no thread")) - ;; Update the thread. - (setcar thread header) - (gnus-summary-goto-subject article) - (let* ((datal (gnus-data-find-list article)) - (data (car datal)) - (buffer-read-only nil) - (level (gnus-summary-thread-level))) - (gnus-delete-line) - (let ((inserted (- (point) - (progn - (gnus-summary-insert-line - header level nil - (memq article gnus-newsgroup-undownloaded) - (gnus-article-mark article) - (memq article gnus-newsgroup-replied) - (memq article gnus-newsgroup-expirable) - ;; Only insert the Subject string when it's different - ;; from the previous Subject string. - (if (and - gnus-show-threads - (gnus-subject-equal - (condition-case () - (mail-header-subject - (gnus-data-header - (cadr - (gnus-data-find-list - article - (gnus-data-list t))))) - ;; Error on the side of excessive subjects. - (error "")) - (mail-header-subject header))) - "" - (mail-header-subject header)) - nil (cdr (assq article gnus-newsgroup-scored)) - (memq article gnus-newsgroup-processable)) - (point))))) - (when (cdr datal) - (gnus-data-update-list - (cdr datal) - (- (gnus-data-pos data) (gnus-data-pos (cadr datal)) inserted))))))) - -(defun gnus-summary-update-article (article &optional iheader) - "Update ARTICLE in the summary buffer." - (set-buffer gnus-summary-buffer) - (let* ((header (gnus-summary-article-header article)) - (id (mail-header-id header)) - (data (gnus-data-find article)) - (thread (gnus-id-to-thread id)) - (references (mail-header-references header)) - (parent - (gnus-id-to-thread - (or (gnus-parent-id - (when (and references - (not (equal "" references))) - references)) - "none"))) - (buffer-read-only nil) - (old (car thread))) - (when thread - (unless iheader - (setcar thread nil) - (when parent - (delq thread parent))) - (if (gnus-summary-insert-subject id header) - ;; Set the (possibly) new article number in the data structure. - (gnus-data-set-number data (gnus-id-to-article id)) - (setcar thread old) - nil)))) - -(defun gnus-rebuild-thread (id &optional line) - "Rebuild the thread containing ID. -If LINE, insert the rebuilt thread starting on line LINE." - (let ((buffer-read-only nil) - old-pos current thread data) - (if (not gnus-show-threads) - (setq thread (list (car (gnus-id-to-thread id)))) - ;; Get the thread this article is part of. - (setq thread (gnus-remove-thread id))) - (setq old-pos (gnus-point-at-bol)) - (setq current (save-excursion - (and (re-search-backward "[\r\n]" nil t) - (gnus-summary-article-number)))) - ;; If this is a gathered thread, we have to go some re-gathering. - (when (stringp (car thread)) - (let ((subject (car thread)) - roots thr) - (setq thread (cdr thread)) - (while thread - (unless (memq (setq thr (gnus-id-to-thread - (gnus-root-id - (mail-header-id (caar thread))))) - roots) - (push thr roots)) - (setq thread (cdr thread))) - ;; We now have all (unique) roots. - (if (= (length roots) 1) - ;; All the loose roots are now one solid root. - (setq thread (car roots)) - (setq thread (cons subject (gnus-sort-threads roots)))))) - (let (threads) - ;; We then insert this thread into the summary buffer. - (when line - (goto-char (point-min)) - (forward-line (1- line))) - (let (gnus-newsgroup-data gnus-newsgroup-threads) - (if gnus-show-threads - (gnus-summary-prepare-threads (gnus-cut-threads (list thread))) - (gnus-summary-prepare-unthreaded thread)) - (setq data (nreverse gnus-newsgroup-data)) - (setq threads gnus-newsgroup-threads)) - ;; We splice the new data into the data structure. - ;;!!! This is kinda bogus. We assume that in LINE is non-nil, - ;;!!! then we want to insert at the beginning of the buffer. - ;;!!! That happens to be true with Gnus now, but that may - ;;!!! change in the future. Perhaps. - (gnus-data-enter-list - (if line nil current) data (- (point) old-pos)) - (setq gnus-newsgroup-threads - (nconc threads gnus-newsgroup-threads)) - (gnus-data-compute-positions)))) - -(defun gnus-number-to-header (number) - "Return the header for article NUMBER." - (let ((headers gnus-newsgroup-headers)) - (while (and headers - (not (= number (mail-header-number (car headers))))) - (pop headers)) - (when headers - (car headers)))) - -(defun gnus-parent-headers (in-headers &optional generation) - "Return the headers of the GENERATIONeth parent of HEADERS." - (unless generation - (setq generation 1)) - (let ((parent t) - (headers in-headers) - references) - (while (and parent - (not (zerop generation)) - (setq references (mail-header-references headers))) - (setq headers (if (and references - (setq parent (gnus-parent-id references))) - (car (gnus-id-to-thread parent)) - nil)) - (decf generation)) - (and (not (eq headers in-headers)) - headers))) - -(defun gnus-id-to-thread (id) - "Return the (sub-)thread where ID appears." - (gnus-gethash id gnus-newsgroup-dependencies)) - -(defun gnus-id-to-article (id) - "Return the article number of ID." - (let ((thread (gnus-id-to-thread id))) - (when (and thread - (car thread)) - (mail-header-number (car thread))))) - -(defun gnus-id-to-header (id) - "Return the article headers of ID." - (car (gnus-id-to-thread id))) - -(defun gnus-article-displayed-root-p (article) - "Say whether ARTICLE is a root(ish) article." - (let ((level (gnus-summary-thread-level article)) - (refs (mail-header-references (gnus-summary-article-header article))) - particle) - (cond - ((null level) nil) - ((zerop level) t) - ((null refs) t) - ((null (gnus-parent-id refs)) t) - ((and (= 1 level) - (null (setq particle (gnus-id-to-article - (gnus-parent-id refs)))) - (null (gnus-summary-thread-level particle))))))) - -(defun gnus-root-id (id) - "Return the id of the root of the thread where ID appears." - (let (last-id prev) - (while (and id (setq prev (car (gnus-id-to-thread id)))) - (setq last-id id - id (gnus-parent-id (mail-header-references prev)))) - last-id)) - -(defun gnus-articles-in-thread (thread) - "Return the list of articles in THREAD." - (cons (mail-header-number (car thread)) - (apply 'nconc (mapcar 'gnus-articles-in-thread (cdr thread))))) - -(defun gnus-remove-thread (id &optional dont-remove) - "Remove the thread that has ID in it." - (let (headers thread last-id) - ;; First go up in this thread until we find the root. - (setq last-id (gnus-root-id id) - headers (message-flatten-list (gnus-id-to-thread last-id))) - ;; We have now found the real root of this thread. It might have - ;; been gathered into some loose thread, so we have to search - ;; through the threads to find the thread we wanted. - (let ((threads gnus-newsgroup-threads) - sub) - (while threads - (setq sub (car threads)) - (if (stringp (car sub)) - ;; This is a gathered thread, so we look at the roots - ;; below it to find whether this article is in this - ;; gathered root. - (progn - (setq sub (cdr sub)) - (while sub - (when (member (caar sub) headers) - (setq thread (car threads) - threads nil - sub nil)) - (setq sub (cdr sub)))) - ;; It's an ordinary thread, so we check it. - (when (eq (car sub) (car headers)) - (setq thread sub - threads nil))) - (setq threads (cdr threads))) - ;; If this article is in no thread, then it's a root. - (if thread - (unless dont-remove - (setq gnus-newsgroup-threads (delq thread gnus-newsgroup-threads))) - (setq thread (gnus-id-to-thread last-id))) - (when thread - (prog1 - thread ; We return this thread. - (unless dont-remove - (if (stringp (car thread)) - (progn - ;; If we use dummy roots, then we have to remove the - ;; dummy root as well. - (when (eq gnus-summary-make-false-root 'dummy) - ;; We go to the dummy root by going to - ;; the first sub-"thread", and then one line up. - (gnus-summary-goto-article - (mail-header-number (caadr thread))) - (forward-line -1) - (gnus-delete-line) - (gnus-data-compute-positions)) - (setq thread (cdr thread)) - (while thread - (gnus-remove-thread-1 (car thread)) - (setq thread (cdr thread)))) - (gnus-remove-thread-1 thread)))))))) - -(defun gnus-remove-thread-1 (thread) - "Remove the thread THREAD recursively." - (let ((number (mail-header-number (pop thread))) - d) - (setq thread (reverse thread)) - (while thread - (gnus-remove-thread-1 (pop thread))) - (when (setq d (gnus-data-find number)) - (goto-char (gnus-data-pos d)) - (gnus-summary-show-thread) - (gnus-data-remove - number - (- (gnus-point-at-bol) - (prog1 - (1+ (gnus-point-at-eol)) - (gnus-delete-line))))))) - -(defun gnus-sort-threads-recursive (threads func) - (sort (mapcar (lambda (thread) - (cons (car thread) - (and (cdr thread) - (gnus-sort-threads-recursive (cdr thread) func)))) - threads) func)) - -(defun gnus-sort-threads-loop (threads func) - (let* ((superthread (cons nil threads)) - (stack (list (cons superthread threads))) - remaining-threads thread) - (while stack - (setq remaining-threads (cdr (car stack))) - (if remaining-threads - (progn (setq thread (car remaining-threads)) - (setcdr (car stack) (cdr remaining-threads)) - (if (cdr thread) - (push (cons thread (cdr thread)) stack))) - (setq thread (caar stack)) - (setcdr thread (sort (cdr thread) func)) - (pop stack))) - (cdr superthread))) - -(defun gnus-sort-threads (threads) - "Sort THREADS." - (if (not gnus-thread-sort-functions) - threads - (gnus-message 8 "Sorting threads...") - (prog1 - (condition-case nil - (let ((max-lisp-eval-depth (max max-lisp-eval-depth 5000))) - (gnus-sort-threads-recursive - threads (gnus-make-sort-function gnus-thread-sort-functions))) - ;; Even after binding max-lisp-eval-depth, the recursive - ;; sorter might fail for very long threads. In that case, - ;; try using a (less well-tested) non-recursive sorter. - (error (gnus-sort-threads-loop - threads (gnus-make-sort-function - gnus-thread-sort-functions)))) - (gnus-message 8 "Sorting threads...done")))) - -(defun gnus-sort-articles (articles) - "Sort ARTICLES." - (when gnus-article-sort-functions - (gnus-message 7 "Sorting articles...") - (prog1 - (setq gnus-newsgroup-headers - (sort articles (gnus-make-sort-function - gnus-article-sort-functions))) - (gnus-message 7 "Sorting articles...done")))) - -;; Written by Hallvard B Furuseth . -(defmacro gnus-thread-header (thread) - "Return header of first article in THREAD. -Note that THREAD must never, ever be anything else than a variable - -using some other form will lead to serious barfage." - (or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread))) - ;; (8% speedup to gnus-summary-prepare, just for fun :-) - (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" - (vector thread) 2)) - -(defsubst gnus-article-sort-by-number (h1 h2) - "Sort articles by article number." - (< (mail-header-number h1) - (mail-header-number h2))) - -(defun gnus-thread-sort-by-number (h1 h2) - "Sort threads by root article number." - (gnus-article-sort-by-number - (gnus-thread-header h1) (gnus-thread-header h2))) - -(defsubst gnus-article-sort-by-random (h1 h2) - "Sort articles randomly." - (zerop (random 2))) - -(defun gnus-thread-sort-by-random (h1 h2) - "Sort threads randomly." - (gnus-article-sort-by-random - (gnus-thread-header h1) (gnus-thread-header h2))) - -(defsubst gnus-article-sort-by-lines (h1 h2) - "Sort articles by article Lines header." - (< (mail-header-lines h1) - (mail-header-lines h2))) - -(defun gnus-thread-sort-by-lines (h1 h2) - "Sort threads by root article Lines header." - (gnus-article-sort-by-lines - (gnus-thread-header h1) (gnus-thread-header h2))) - -(defsubst gnus-article-sort-by-chars (h1 h2) - "Sort articles by octet length." - (< (mail-header-chars h1) - (mail-header-chars h2))) - -(defun gnus-thread-sort-by-chars (h1 h2) - "Sort threads by root article octet length." - (gnus-article-sort-by-chars - (gnus-thread-header h1) (gnus-thread-header h2))) - -(defsubst gnus-article-sort-by-author (h1 h2) - "Sort articles by root author." - (gnus-string< - (let ((extract (funcall - gnus-extract-address-components - (mail-header-from h1)))) - (or (car extract) (cadr extract) "")) - (let ((extract (funcall - gnus-extract-address-components - (mail-header-from h2)))) - (or (car extract) (cadr extract) "")))) - -(defun gnus-thread-sort-by-author (h1 h2) - "Sort threads by root author." - (gnus-article-sort-by-author - (gnus-thread-header h1) (gnus-thread-header h2))) - -(defsubst gnus-article-sort-by-subject (h1 h2) - "Sort articles by root subject." - (gnus-string< - (downcase (gnus-simplify-subject-re (mail-header-subject h1))) - (downcase (gnus-simplify-subject-re (mail-header-subject h2))))) - -(defun gnus-thread-sort-by-subject (h1 h2) - "Sort threads by root subject." - (gnus-article-sort-by-subject - (gnus-thread-header h1) (gnus-thread-header h2))) - -(defsubst gnus-article-sort-by-date (h1 h2) - "Sort articles by root article date." - (time-less-p - (gnus-date-get-time (mail-header-date h1)) - (gnus-date-get-time (mail-header-date h2)))) - -(defun gnus-thread-sort-by-date (h1 h2) - "Sort threads by root article date." - (gnus-article-sort-by-date - (gnus-thread-header h1) (gnus-thread-header h2))) - -(defsubst gnus-article-sort-by-score (h1 h2) - "Sort articles by root article score. -Unscored articles will be counted as having a score of zero." - (> (or (cdr (assq (mail-header-number h1) - gnus-newsgroup-scored)) - gnus-summary-default-score 0) - (or (cdr (assq (mail-header-number h2) - gnus-newsgroup-scored)) - gnus-summary-default-score 0))) - -(defun gnus-thread-sort-by-score (h1 h2) - "Sort threads by root article score." - (gnus-article-sort-by-score - (gnus-thread-header h1) (gnus-thread-header h2))) - -(defun gnus-thread-sort-by-total-score (h1 h2) - "Sort threads by the sum of all scores in the thread. -Unscored articles will be counted as having a score of zero." - (> (gnus-thread-total-score h1) (gnus-thread-total-score h2))) - -(defun gnus-thread-total-score (thread) - ;; This function find the total score of THREAD. - (cond - ((null thread) - 0) - ((consp thread) - (if (stringp (car thread)) - (apply gnus-thread-score-function 0 - (mapcar 'gnus-thread-total-score-1 (cdr thread))) - (gnus-thread-total-score-1 thread))) - (t - (gnus-thread-total-score-1 (list thread))))) - -(defun gnus-thread-sort-by-most-recent-number (h1 h2) - "Sort threads such that the thread with the most recently arrived article comes first." - (> (gnus-thread-highest-number h1) (gnus-thread-highest-number h2))) - -(defun gnus-thread-highest-number (thread) - "Return the highest article number in THREAD." - (apply 'max (mapcar (lambda (header) - (mail-header-number header)) - (message-flatten-list thread)))) - -(defun gnus-thread-sort-by-most-recent-date (h1 h2) - "Sort threads such that the thread with the most recently dated article comes first." - (> (gnus-thread-latest-date h1) (gnus-thread-latest-date h2))) - -(defun gnus-thread-latest-date (thread) - "Return the highest article date in THREAD." - (let ((previous-time 0)) - (apply 'max - (mapcar - (lambda (header) - (setq previous-time - (condition-case () - (time-to-seconds (mail-header-parse-date - (mail-header-date header))) - (error previous-time)))) - (sort - (message-flatten-list thread) - (lambda (h1 h2) - (< (mail-header-number h1) - (mail-header-number h2)))))))) - -(defun gnus-thread-total-score-1 (root) - ;; This function find the total score of the thread below ROOT. - (setq root (car root)) - (apply gnus-thread-score-function - (or (append - (mapcar 'gnus-thread-total-score - (cdr (gnus-id-to-thread (mail-header-id root)))) - (when (> (mail-header-number root) 0) - (list (or (cdr (assq (mail-header-number root) - gnus-newsgroup-scored)) - gnus-summary-default-score 0)))) - (list gnus-summary-default-score) - '(0)))) - -;; Added by Per Abrahamsen . -(defvar gnus-tmp-prev-subject nil) -(defvar gnus-tmp-false-parent nil) -(defvar gnus-tmp-root-expunged nil) -(defvar gnus-tmp-dummy-line nil) - -(eval-when-compile (defvar gnus-tmp-header)) -(defun gnus-extra-header (type &optional header) - "Return the extra header of TYPE." - (or (cdr (assq type (mail-header-extra (or header gnus-tmp-header)))) - "")) - -(defvar gnus-tmp-thread-tree-header-string "") - -(defcustom gnus-sum-thread-tree-root "> " - "With %B spec, used for the root of a thread. -If nil, use subject instead." - :version "22.1" - :type '(radio (const :format "%v " nil) string) - :group 'gnus-thread) -(defcustom gnus-sum-thread-tree-false-root "> " - "With %B spec, used for a false root of a thread. -If nil, use subject instead." - :version "22.1" - :type '(radio (const :format "%v " nil) string) - :group 'gnus-thread) -(defcustom gnus-sum-thread-tree-single-indent "" - "With %B spec, used for a thread with just one message. -If nil, use subject instead." - :version "22.1" - :type '(radio (const :format "%v " nil) string) - :group 'gnus-thread) -(defcustom gnus-sum-thread-tree-vertical "| " - "With %B spec, used for drawing a vertical line." - :version "22.1" - :type 'string - :group 'gnus-thread) -(defcustom gnus-sum-thread-tree-indent " " - "With %B spec, used for indenting." - :version "22.1" - :type 'string - :group 'gnus-thread) -(defcustom gnus-sum-thread-tree-leaf-with-other "+-> " - "With %B spec, used for a leaf with brothers." - :version "22.1" - :type 'string - :group 'gnus-thread) -(defcustom gnus-sum-thread-tree-single-leaf "\\-> " - "With %B spec, used for a leaf without brothers." - :version "22.1" - :type 'string - :group 'gnus-thread) - -(defun gnus-summary-prepare-threads (threads) - "Prepare summary buffer from THREADS and indentation LEVEL. -THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])' -or a straight list of headers." - (gnus-message 7 "Generating summary...") - - (setq gnus-newsgroup-threads threads) - (beginning-of-line) - - (let ((gnus-tmp-level 0) - (default-score (or gnus-summary-default-score 0)) - (gnus-visual-p (gnus-visual-p 'summary-highlight 'highlight)) - (building-line-count gnus-summary-display-while-building) - (building-count (integerp gnus-summary-display-while-building)) - thread number subject stack state gnus-tmp-gathered beg-match - new-roots gnus-tmp-new-adopts thread-end simp-subject - gnus-tmp-header gnus-tmp-unread gnus-tmp-downloaded - gnus-tmp-replied gnus-tmp-subject-or-nil - gnus-tmp-dummy gnus-tmp-indentation gnus-tmp-lines gnus-tmp-score - gnus-tmp-score-char gnus-tmp-from gnus-tmp-name - gnus-tmp-number gnus-tmp-opening-bracket gnus-tmp-closing-bracket - tree-stack) - - (setq gnus-tmp-prev-subject nil - gnus-tmp-thread-tree-header-string "") - - (if (vectorp (car threads)) - ;; If this is a straight (sic) list of headers, then a - ;; threaded summary display isn't required, so we just create - ;; an unthreaded one. - (gnus-summary-prepare-unthreaded threads) - - ;; Do the threaded display. - - (if gnus-summary-display-while-building - (switch-to-buffer (buffer-name))) - (while (or threads stack gnus-tmp-new-adopts new-roots) - - (if (and (= gnus-tmp-level 0) - (or (not stack) - (= (caar stack) 0)) - (not gnus-tmp-false-parent) - (or gnus-tmp-new-adopts new-roots)) - (if gnus-tmp-new-adopts - (setq gnus-tmp-level (if gnus-tmp-root-expunged 0 1) - thread (list (car gnus-tmp-new-adopts)) - gnus-tmp-header (caar thread) - gnus-tmp-new-adopts (cdr gnus-tmp-new-adopts)) - (when new-roots - (setq thread (list (car new-roots)) - gnus-tmp-header (caar thread) - new-roots (cdr new-roots)))) - - (if threads - ;; If there are some threads, we do them before the - ;; threads on the stack. - (setq thread threads - gnus-tmp-header (caar thread)) - ;; There were no current threads, so we pop something off - ;; the stack. - (setq state (car stack) - gnus-tmp-level (car state) - tree-stack (cadr state) - thread (caddr state) - stack (cdr stack) - gnus-tmp-header (caar thread)))) - - (setq gnus-tmp-false-parent nil) - (setq gnus-tmp-root-expunged nil) - (setq thread-end nil) - - (if (stringp gnus-tmp-header) - ;; The header is a dummy root. - (cond - ((eq gnus-summary-make-false-root 'adopt) - ;; We let the first article adopt the rest. - (setq gnus-tmp-new-adopts (nconc gnus-tmp-new-adopts - (cddar thread))) - (setq gnus-tmp-gathered - (nconc (mapcar - (lambda (h) (mail-header-number (car h))) - (cddar thread)) - gnus-tmp-gathered)) - (setq thread (cons (list (caar thread) - (cadar thread)) - (cdr thread))) - (setq gnus-tmp-level -1 - gnus-tmp-false-parent t)) - ((eq gnus-summary-make-false-root 'empty) - ;; We print adopted articles with empty subject fields. - (setq gnus-tmp-gathered - (nconc (mapcar - (lambda (h) (mail-header-number (car h))) - (cddar thread)) - gnus-tmp-gathered)) - (setq gnus-tmp-level -1)) - ((eq gnus-summary-make-false-root 'dummy) - ;; We remember that we probably want to output a dummy - ;; root. - (setq gnus-tmp-dummy-line gnus-tmp-header) - (setq gnus-tmp-prev-subject gnus-tmp-header)) - (t - ;; We do not make a root for the gathered - ;; sub-threads at all. - (setq gnus-tmp-level -1))) - - (setq number (mail-header-number gnus-tmp-header) - subject (mail-header-subject gnus-tmp-header) - simp-subject (gnus-simplify-subject-fully subject)) - - (cond - ;; If the thread has changed subject, we might want to make - ;; this subthread into a root. - ((and (null gnus-thread-ignore-subject) - (not (zerop gnus-tmp-level)) - gnus-tmp-prev-subject - (not (string= gnus-tmp-prev-subject simp-subject))) - (setq new-roots (nconc new-roots (list (car thread))) - thread-end t - gnus-tmp-header nil)) - ;; If the article lies outside the current limit, - ;; then we do not display it. - ((not (memq number gnus-newsgroup-limit)) - (setq gnus-tmp-gathered - (nconc (mapcar - (lambda (h) (mail-header-number (car h))) - (cdar thread)) - gnus-tmp-gathered)) - (setq gnus-tmp-new-adopts (if (cdar thread) - (append gnus-tmp-new-adopts - (cdar thread)) - gnus-tmp-new-adopts) - thread-end t - gnus-tmp-header nil) - (when (zerop gnus-tmp-level) - (setq gnus-tmp-root-expunged t))) - ;; Perhaps this article is to be marked as read? - ((and gnus-summary-mark-below - (< (or (cdr (assq number gnus-newsgroup-scored)) - default-score) - gnus-summary-mark-below) - ;; Don't touch sparse articles. - (not (gnus-summary-article-sparse-p number)) - (not (gnus-summary-article-ancient-p number))) - (setq gnus-newsgroup-unreads - (delq number gnus-newsgroup-unreads)) - (if gnus-newsgroup-auto-expire - (setq gnus-newsgroup-expirable - (gnus-add-to-sorted-list - gnus-newsgroup-expirable number)) - (push (cons number gnus-low-score-mark) - gnus-newsgroup-reads)))) - - (when gnus-tmp-header - ;; We may have an old dummy line to output before this - ;; article. - (when (and gnus-tmp-dummy-line - (gnus-subject-equal - gnus-tmp-dummy-line - (mail-header-subject gnus-tmp-header))) - (gnus-summary-insert-dummy-line - gnus-tmp-dummy-line (mail-header-number gnus-tmp-header)) - (setq gnus-tmp-dummy-line nil)) - - ;; Compute the mark. - (setq gnus-tmp-unread (gnus-article-mark number)) - - (push (gnus-data-make number gnus-tmp-unread (1+ (point)) - gnus-tmp-header gnus-tmp-level) - gnus-newsgroup-data) - - ;; Actually insert the line. - (setq - gnus-tmp-subject-or-nil - (cond - ((and gnus-thread-ignore-subject - gnus-tmp-prev-subject - (not (string= gnus-tmp-prev-subject simp-subject))) - subject) - ((zerop gnus-tmp-level) - (if (and (eq gnus-summary-make-false-root 'empty) - (memq number gnus-tmp-gathered) - gnus-tmp-prev-subject - (string= gnus-tmp-prev-subject simp-subject)) - gnus-summary-same-subject - subject)) - (t gnus-summary-same-subject))) - (if (and (eq gnus-summary-make-false-root 'adopt) - (= gnus-tmp-level 1) - (memq number gnus-tmp-gathered)) - (setq gnus-tmp-opening-bracket ?\< - gnus-tmp-closing-bracket ?\>) - (setq gnus-tmp-opening-bracket ?\[ - gnus-tmp-closing-bracket ?\])) - (if (>= gnus-tmp-level (length gnus-thread-indent-array)) - (gnus-make-thread-indent-array - (max (* 2 (length gnus-thread-indent-array)) - gnus-tmp-level))) - (setq - gnus-tmp-indentation - (aref gnus-thread-indent-array gnus-tmp-level) - gnus-tmp-lines (mail-header-lines gnus-tmp-header) - gnus-tmp-score (or (cdr (assq number gnus-newsgroup-scored)) - gnus-summary-default-score 0) - gnus-tmp-score-char - (if (or (null gnus-summary-default-score) - (<= (abs (- gnus-tmp-score gnus-summary-default-score)) - gnus-summary-zcore-fuzz)) - ? ;Whitespace - (if (< gnus-tmp-score gnus-summary-default-score) - gnus-score-below-mark gnus-score-over-mark)) - gnus-tmp-replied - (cond ((memq number gnus-newsgroup-processable) - gnus-process-mark) - ((memq number gnus-newsgroup-cached) - gnus-cached-mark) - ((memq number gnus-newsgroup-replied) - gnus-replied-mark) - ((memq number gnus-newsgroup-forwarded) - gnus-forwarded-mark) - ((memq number gnus-newsgroup-saved) - gnus-saved-mark) - ((memq number gnus-newsgroup-recent) - gnus-recent-mark) - ((memq number gnus-newsgroup-unseen) - gnus-unseen-mark) - (t gnus-no-mark)) - gnus-tmp-downloaded - (cond ((memq number gnus-newsgroup-undownloaded) - gnus-undownloaded-mark) - (gnus-newsgroup-agentized - gnus-downloaded-mark) - (t - gnus-no-mark)) - gnus-tmp-from (mail-header-from gnus-tmp-header) - gnus-tmp-name - (cond - ((string-match "<[^>]+> *$" gnus-tmp-from) - (setq beg-match (match-beginning 0)) - (or (and (string-match "^\".+\"" gnus-tmp-from) - (substring gnus-tmp-from 1 (1- (match-end 0)))) - (substring gnus-tmp-from 0 beg-match))) - ((string-match "(.+)" gnus-tmp-from) - (substring gnus-tmp-from - (1+ (match-beginning 0)) (1- (match-end 0)))) - (t gnus-tmp-from)) - - ;; Do the %B string - gnus-tmp-thread-tree-header-string - (cond - ((not gnus-show-threads) "") - ((zerop gnus-tmp-level) - (cond ((cdar thread) - (or gnus-sum-thread-tree-root subject)) - (gnus-tmp-new-adopts - (or gnus-sum-thread-tree-false-root subject)) - (t - (or gnus-sum-thread-tree-single-indent subject)))) - (t - (concat (apply 'concat - (mapcar (lambda (item) - (if (= item 1) - gnus-sum-thread-tree-vertical - gnus-sum-thread-tree-indent)) - (cdr (reverse tree-stack)))) - (if (nth 1 thread) - gnus-sum-thread-tree-leaf-with-other - gnus-sum-thread-tree-single-leaf))))) - (when (string= gnus-tmp-name "") - (setq gnus-tmp-name gnus-tmp-from)) - (unless (numberp gnus-tmp-lines) - (setq gnus-tmp-lines -1)) - (if (= gnus-tmp-lines -1) - (setq gnus-tmp-lines "?") - (setq gnus-tmp-lines (number-to-string gnus-tmp-lines))) - (gnus-put-text-property - (point) - (progn (eval gnus-summary-line-format-spec) (point)) - 'gnus-number number) - (when gnus-visual-p - (forward-line -1) - (gnus-run-hooks 'gnus-summary-update-hook) - (forward-line 1)) - - (setq gnus-tmp-prev-subject simp-subject))) - - (when (nth 1 thread) - (push (list (max 0 gnus-tmp-level) - (copy-sequence tree-stack) - (nthcdr 1 thread)) - stack)) - (push (if (nth 1 thread) 1 0) tree-stack) - (incf gnus-tmp-level) - (setq threads (if thread-end nil (cdar thread))) - (if gnus-summary-display-while-building - (if building-count - (progn - ;; use a set frequency - (setq building-line-count (1- building-line-count)) - (when (= building-line-count 0) - (sit-for 0) - (setq building-line-count - gnus-summary-display-while-building))) - ;; always - (sit-for 0))) - (unless threads - (setq gnus-tmp-level 0))))) - (gnus-message 7 "Generating summary...done")) - -(defun gnus-summary-prepare-unthreaded (headers) - "Generate an unthreaded summary buffer based on HEADERS." - (let (header number mark) - - (beginning-of-line) - - (while headers - ;; We may have to root out some bad articles... - (when (memq (setq number (mail-header-number - (setq header (pop headers)))) - gnus-newsgroup-limit) - ;; Mark article as read when it has a low score. - (when (and gnus-summary-mark-below - (< (or (cdr (assq number gnus-newsgroup-scored)) - gnus-summary-default-score 0) - gnus-summary-mark-below) - (not (gnus-summary-article-ancient-p number))) - (setq gnus-newsgroup-unreads - (delq number gnus-newsgroup-unreads)) - (if gnus-newsgroup-auto-expire - (push number gnus-newsgroup-expirable) - (push (cons number gnus-low-score-mark) - gnus-newsgroup-reads))) - - (setq mark (gnus-article-mark number)) - (push (gnus-data-make number mark (1+ (point)) header 0) - gnus-newsgroup-data) - (gnus-summary-insert-line - header 0 number - (memq number gnus-newsgroup-undownloaded) - mark (memq number gnus-newsgroup-replied) - (memq number gnus-newsgroup-expirable) - (mail-header-subject header) nil - (cdr (assq number gnus-newsgroup-scored)) - (memq number gnus-newsgroup-processable)))))) - -(defun gnus-summary-remove-list-identifiers () - "Remove list identifiers in `gnus-list-identifiers' from articles in the current group." - (let ((regexp (if (consp gnus-list-identifiers) - (mapconcat 'identity gnus-list-identifiers " *\\|") - gnus-list-identifiers)) - changed subject) - (when regexp - (dolist (header gnus-newsgroup-headers) - (setq subject (mail-header-subject header) - changed nil) - (while (string-match - (concat "^\\(R[Ee]: +\\)*\\(" regexp " *\\)") - subject) - (setq subject - (concat (substring subject 0 (match-beginning 2)) - (substring subject (match-end 0))) - changed t)) - (when (and changed - (string-match - "^\\(\\(R[Ee]: +\\)+\\)R[Ee]: +" subject)) - (setq subject - (concat (substring subject 0 (match-beginning 1)) - (substring subject (match-end 1))))) - (when changed - (mail-header-set-subject header subject)))))) - -(defun gnus-fetch-headers (articles) - "Fetch headers of ARTICLES." - (let ((name (gnus-group-decoded-name gnus-newsgroup-name))) - (gnus-message 5 "Fetching headers for %s..." name) - (prog1 - (if (eq 'nov - (setq gnus-headers-retrieved-by - (gnus-retrieve-headers - articles gnus-newsgroup-name - ;; We might want to fetch old headers, but - ;; not if there is only 1 article. - (and (or (and - (not (eq gnus-fetch-old-headers 'some)) - (not (numberp gnus-fetch-old-headers))) - (> (length articles) 1)) - gnus-fetch-old-headers)))) - (gnus-get-newsgroup-headers-xover - articles nil nil gnus-newsgroup-name t) - (gnus-get-newsgroup-headers)) - (gnus-message 5 "Fetching headers for %s...done" name)))) - -(defun gnus-select-newsgroup (group &optional read-all select-articles) - "Select newsgroup GROUP. -If READ-ALL is non-nil, all articles in the group are selected. -If SELECT-ARTICLES, only select those articles from GROUP." - (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) - ;;!!! Dirty hack; should be removed. - (gnus-summary-ignore-duplicates - (if (eq (car (gnus-find-method-for-group group)) 'nnvirtual) - t - gnus-summary-ignore-duplicates)) - (info (nth 2 entry)) - articles fetched-articles cached) - - (unless (gnus-check-server - (set (make-local-variable 'gnus-current-select-method) - (gnus-find-method-for-group group))) - (error "Couldn't open server")) - - (or (and entry (not (eq (car entry) t))) ; Either it's active... - (gnus-activate-group group) ; Or we can activate it... - (progn ; Or we bug out. - (when (equal major-mode 'gnus-summary-mode) - (gnus-kill-buffer (current-buffer))) - (error "Couldn't activate group %s: %s" - (gnus-group-decoded-name group) (gnus-status-message group)))) - - (unless (gnus-request-group group t) - (when (equal major-mode 'gnus-summary-mode) - (gnus-kill-buffer (current-buffer))) - (error "Couldn't request group %s: %s" - (gnus-group-decoded-name group) (gnus-status-message group))) - - (when gnus-agent - (gnus-agent-possibly-alter-active group (gnus-active group) info) - - (setq gnus-summary-use-undownloaded-faces - (gnus-agent-find-parameter - group - 'agent-enable-undownloaded-faces))) - - (setq gnus-newsgroup-name group - gnus-newsgroup-unselected nil - gnus-newsgroup-unreads (gnus-list-of-unread-articles group)) - - (let ((display (gnus-group-find-parameter group 'display))) - (setq gnus-newsgroup-display - (cond - ((not (zerop (or (car-safe read-all) 0))) - ;; The user entered the group with C-u SPC/RET, let's show - ;; all articles. - 'gnus-not-ignore) - ((eq display 'all) - 'gnus-not-ignore) - ((arrayp display) - (gnus-summary-display-make-predicate (mapcar 'identity display))) - ((numberp display) - ;; The following is probably the "correct" solution, but - ;; it makes Gnus fetch all headers and then limit the - ;; articles (which is slow), so instead we hack the - ;; select-articles parameter instead. -- Simon Josefsson - ;; - ;; - ;; (gnus-byte-compile - ;; `(lambda () (> number ,(- (cdr (gnus-active group)) - ;; display))))) - (setq select-articles - (gnus-uncompress-range - (cons (let ((tmp (- (cdr (gnus-active group)) display))) - (if (> tmp 0) - tmp - 1)) - (cdr (gnus-active group))))) - nil) - (t - nil)))) - - (gnus-summary-setup-default-charset) - - ;; Kludge to avoid having cached articles nixed out in virtual groups. - (when (gnus-virtual-group-p group) - (setq cached gnus-newsgroup-cached)) - - (setq gnus-newsgroup-unreads - (gnus-sorted-ndifference - (gnus-sorted-ndifference gnus-newsgroup-unreads - gnus-newsgroup-marked) - gnus-newsgroup-dormant)) - - (setq gnus-newsgroup-processable nil) - - (gnus-update-read-articles group gnus-newsgroup-unreads) - - ;; Adjust and set lists of article marks. - (when info - (gnus-adjust-marked-articles info)) - (if (setq articles select-articles) - (setq gnus-newsgroup-unselected - (gnus-sorted-difference gnus-newsgroup-unreads articles)) - (setq articles (gnus-articles-to-read group read-all))) - - (cond - ((null articles) - ;;(gnus-message 3 "Couldn't select newsgroup -- no articles to display") - 'quit) - ((eq articles 0) nil) - (t - ;; Init the dependencies hash table. - (setq gnus-newsgroup-dependencies - (gnus-make-hashtable (length articles))) - (gnus-set-global-variables) - ;; Retrieve the headers and read them in. - - (setq gnus-newsgroup-headers (gnus-fetch-headers articles)) - - ;; Kludge to avoid having cached articles nixed out in virtual groups. - (when cached - (setq gnus-newsgroup-cached cached)) - - ;; Suppress duplicates? - (when gnus-suppress-duplicates - (gnus-dup-suppress-articles)) - - ;; Set the initial limit. - (setq gnus-newsgroup-limit (copy-sequence articles)) - ;; Remove canceled articles from the list of unread articles. - (setq fetched-articles - (mapcar (lambda (headers) (mail-header-number headers)) - gnus-newsgroup-headers)) - (setq gnus-newsgroup-articles fetched-articles) - (setq gnus-newsgroup-unreads - (gnus-sorted-nintersection - gnus-newsgroup-unreads fetched-articles)) - (gnus-compute-unseen-list) - - ;; Removed marked articles that do not exist. - (gnus-update-missing-marks - (gnus-sorted-difference articles fetched-articles)) - ;; We might want to build some more threads first. - (when (and gnus-fetch-old-headers - (eq gnus-headers-retrieved-by 'nov)) - (if (eq gnus-fetch-old-headers 'invisible) - (gnus-build-all-threads) - (gnus-build-old-threads))) - ;; Let the Gnus agent mark articles as read. - (when gnus-agent - (gnus-agent-get-undownloaded-list)) - ;; Remove list identifiers from subject - (when gnus-list-identifiers - (gnus-summary-remove-list-identifiers)) - ;; Check whether auto-expire is to be done in this group. - (setq gnus-newsgroup-auto-expire - (gnus-group-auto-expirable-p group)) - ;; Set up the article buffer now, if necessary. - (unless gnus-single-article-buffer - (gnus-article-setup-buffer)) - ;; First and last article in this newsgroup. - (when gnus-newsgroup-headers - (setq gnus-newsgroup-begin - (mail-header-number (car gnus-newsgroup-headers)) - gnus-newsgroup-end - (mail-header-number - (gnus-last-element gnus-newsgroup-headers)))) - ;; GROUP is successfully selected. - (or gnus-newsgroup-headers t))))) - -(defun gnus-compute-unseen-list () - ;; The `seen' marks are treated specially. - (if (not gnus-newsgroup-seen) - (setq gnus-newsgroup-unseen gnus-newsgroup-articles) - (setq gnus-newsgroup-unseen - (gnus-inverse-list-range-intersection - gnus-newsgroup-articles gnus-newsgroup-seen)))) - -(defun gnus-summary-display-make-predicate (display) - (require 'gnus-agent) - (when (= (length display) 1) - (setq display (car display))) - (unless gnus-summary-display-cache - (dolist (elem (append '((unread . unread) - (read . read) - (unseen . unseen)) - gnus-article-mark-lists)) - (push (cons (cdr elem) - (gnus-byte-compile - `(lambda () (gnus-article-marked-p ',(cdr elem))))) - gnus-summary-display-cache))) - (let ((gnus-category-predicate-alist gnus-summary-display-cache) - (gnus-category-predicate-cache gnus-summary-display-cache)) - (gnus-get-predicate display))) - -;; Uses the dynamically bound `number' variable. -(eval-when-compile - (defvar number)) -(defun gnus-article-marked-p (type &optional article) - (let ((article (or article number))) - (cond - ((eq type 'tick) - (memq article gnus-newsgroup-marked)) - ((eq type 'spam) - (memq article gnus-newsgroup-spam-marked)) - ((eq type 'unsend) - (memq article gnus-newsgroup-unsendable)) - ((eq type 'undownload) - (memq article gnus-newsgroup-undownloaded)) - ((eq type 'download) - (memq article gnus-newsgroup-downloadable)) - ((eq type 'unread) - (memq article gnus-newsgroup-unreads)) - ((eq type 'read) - (memq article gnus-newsgroup-reads)) - ((eq type 'dormant) - (memq article gnus-newsgroup-dormant) ) - ((eq type 'expire) - (memq article gnus-newsgroup-expirable)) - ((eq type 'reply) - (memq article gnus-newsgroup-replied)) - ((eq type 'killed) - (memq article gnus-newsgroup-killed)) - ((eq type 'bookmark) - (assq article gnus-newsgroup-bookmarks)) - ((eq type 'score) - (assq article gnus-newsgroup-scored)) - ((eq type 'save) - (memq article gnus-newsgroup-saved)) - ((eq type 'cache) - (memq article gnus-newsgroup-cached)) - ((eq type 'forward) - (memq article gnus-newsgroup-forwarded)) - ((eq type 'seen) - (not (memq article gnus-newsgroup-unseen))) - ((eq type 'recent) - (memq article gnus-newsgroup-recent)) - (t t)))) - -(defun gnus-articles-to-read (group &optional read-all) - "Find out what articles the user wants to read." - (let* ((articles - ;; Select all articles if `read-all' is non-nil, or if there - ;; are no unread articles. - (if (or read-all - (and (zerop (length gnus-newsgroup-marked)) - (zerop (length gnus-newsgroup-unreads))) - ;; Fetch all if the predicate is non-nil. - gnus-newsgroup-display) - ;; We want to select the headers for all the articles in - ;; the group, so we select either all the active - ;; articles in the group, or (if that's nil), the - ;; articles in the cache. - (or - (if gnus-newsgroup-maximum-articles - (let ((active (gnus-active group))) - (gnus-uncompress-range - (cons (max (car active) - (- (cdr active) - gnus-newsgroup-maximum-articles - -1)) - (cdr active)))) - (gnus-uncompress-range (gnus-active group))) - (gnus-cache-articles-in-group group)) - ;; Select only the "normal" subset of articles. - (gnus-sorted-nunion - (gnus-sorted-union gnus-newsgroup-dormant gnus-newsgroup-marked) - gnus-newsgroup-unreads))) - (scored-list (gnus-killed-articles gnus-newsgroup-killed articles)) - (scored (length scored-list)) - (number (length articles)) - (marked (+ (length gnus-newsgroup-marked) - (length gnus-newsgroup-dormant))) - (select - (cond - ((numberp read-all) - read-all) - ((numberp gnus-newsgroup-display) - gnus-newsgroup-display) - (t - (condition-case () - (cond - ((and (or (<= scored marked) (= scored number)) - (numberp gnus-large-newsgroup) - (> number gnus-large-newsgroup)) - (let* ((cursor-in-echo-area nil) - (initial (gnus-parameter-large-newsgroup-initial - gnus-newsgroup-name)) - (input - (read-string - (format - "How many articles from %s (%s %d): " - (gnus-limit-string - (gnus-group-decoded-name gnus-newsgroup-name) - 35) - (if initial "max" "default") - number) - (if initial - (cons (number-to-string initial) - 0))))) - (if (string-match "^[ \t]*$" input) number input))) - ((and (> scored marked) (< scored number) - (> (- scored number) 20)) - (let ((input - (read-string - (format "%s %s (%d scored, %d total): " - "How many articles from" - (gnus-group-decoded-name group) - scored number)))) - (if (string-match "^[ \t]*$" input) - number input))) - (t number)) - (quit - (message "Quit getting the articles to read") - nil)))))) - (setq select (if (stringp select) (string-to-number select) select)) - (if (or (null select) (zerop select)) - select - (if (and (not (zerop scored)) (<= (abs select) scored)) - (progn - (setq articles (sort scored-list '<)) - (setq number (length articles))) - (setq articles (copy-sequence articles))) - - (when (< (abs select) number) - (if (< select 0) - ;; Select the N oldest articles. - (setcdr (nthcdr (1- (abs select)) articles) nil) - ;; Select the N most recent articles. - (setq articles (nthcdr (- number select) articles)))) - (setq gnus-newsgroup-unselected - (gnus-sorted-difference gnus-newsgroup-unreads articles)) - (when gnus-alter-articles-to-read-function - (setq articles - (sort - (funcall gnus-alter-articles-to-read-function - gnus-newsgroup-name articles) - '<))) - articles))) - -(defun gnus-killed-articles (killed articles) - (let (out) - (while articles - (when (inline (gnus-member-of-range (car articles) killed)) - (push (car articles) out)) - (setq articles (cdr articles))) - out)) - -(defun gnus-uncompress-marks (marks) - "Uncompress the mark ranges in MARKS." - (let ((uncompressed '(score bookmark)) - out) - (while marks - (if (memq (caar marks) uncompressed) - (push (car marks) out) - (push (cons (caar marks) (gnus-uncompress-range (cdar marks))) out)) - (setq marks (cdr marks))) - out)) - -(defun gnus-article-mark-to-type (mark) - "Return the type of MARK." - (or (cadr (assq mark gnus-article-special-mark-lists)) - 'list)) - -(defun gnus-article-unpropagatable-p (mark) - "Return whether MARK should be propagated to back end." - (memq mark gnus-article-unpropagated-mark-lists)) - -(defun gnus-adjust-marked-articles (info) - "Set all article lists and remove all marks that are no longer valid." - (let* ((marked-lists (gnus-info-marks info)) - (active (gnus-active (gnus-info-group info))) - (min (car active)) - (max (cdr active)) - (types gnus-article-mark-lists) - marks var articles article mark mark-type - bgn end) - - (dolist (marks marked-lists) - (setq mark (car marks) - mark-type (gnus-article-mark-to-type mark) - var (intern (format "gnus-newsgroup-%s" (car (rassq mark types))))) - - ;; We set the variable according to the type of the marks list, - ;; and then adjust the marks to a subset of the active articles. - (cond - ;; Adjust "simple" lists - compressed yet unsorted - ((eq mark-type 'list) - ;; Simultaneously uncompress and clip to active range - ;; See gnus-uncompress-range for a description of possible marks - (let (l lh) - (if (not (cadr marks)) - (set var nil) - (setq articles (if (numberp (cddr marks)) - (list (cdr marks)) - (cdr marks)) - lh (cons nil nil) - l lh) - - (while (setq article (pop articles)) - (cond ((consp article) - (setq bgn (max (car article) min) - end (min (cdr article) max)) - (while (<= bgn end) - (setq l (setcdr l (cons bgn nil)) - bgn (1+ bgn)))) - ((and (<= min article) - (>= max article)) - (setq l (setcdr l (cons article nil)))))) - (set var (cdr lh))))) - ;; Adjust assocs. - ((eq mark-type 'tuple) - (set var (setq articles (cdr marks))) - (when (not (listp (cdr (symbol-value var)))) - (set var (list (symbol-value var)))) - (when (not (listp (cdr articles))) - (setq articles (list articles))) - (while articles - (when (or (not (consp (setq article (pop articles)))) - (< (car article) min) - (> (car article) max)) - (set var (delq article (symbol-value var)))))) - ;; Adjust ranges (sloppily). - ((eq mark-type 'range) - (cond - ((eq mark 'seen) - ;; Fix the record for `seen' if it looks like (seen NUM1 . NUM2). - ;; It should be (seen (NUM1 . NUM2)). - (when (numberp (cddr marks)) - (setcdr marks (list (cdr marks)))) - (setq articles (cdr marks)) - (while (and articles - (or (and (consp (car articles)) - (> min (cdar articles))) - (and (numberp (car articles)) - (> min (car articles))))) - (pop articles)) - (set var articles)))))))) - -(defun gnus-update-missing-marks (missing) - "Go through the list of MISSING articles and remove them from the mark lists." - (when missing - (let (var m) - ;; Go through all types. - (dolist (elem gnus-article-mark-lists) - (when (eq (gnus-article-mark-to-type (cdr elem)) 'list) - (setq var (intern (format "gnus-newsgroup-%s" (car elem)))) - (when (symbol-value var) - ;; This list has articles. So we delete all missing - ;; articles from it. - (setq m missing) - (while m - (set var (delq (pop m) (symbol-value var)))))))))) - -(defun gnus-update-marks () - "Enter the various lists of marked articles into the newsgroup info list." - (let ((types gnus-article-mark-lists) - (info (gnus-get-info gnus-newsgroup-name)) - type list newmarked symbol delta-marks) - (when info - ;; Add all marks lists to the list of marks lists. - (while (setq type (pop types)) - (setq list (symbol-value - (setq symbol - (intern (format "gnus-newsgroup-%s" (car type)))))) - - (when list - ;; Get rid of the entries of the articles that have the - ;; default score. - (when (and (eq (cdr type) 'score) - gnus-save-score - list) - (let* ((arts list) - (prev (cons nil list)) - (all prev)) - (while arts - (if (or (not (consp (car arts))) - (= (cdar arts) gnus-summary-default-score)) - (setcdr prev (cdr arts)) - (setq prev arts)) - (setq arts (cdr arts))) - (setq list (cdr all))))) - - (when (eq (cdr type) 'seen) - (setq list (gnus-range-add list gnus-newsgroup-unseen))) - - (when (eq (gnus-article-mark-to-type (cdr type)) 'list) - (setq list (gnus-compress-sequence (set symbol (sort list '<)) t))) - - (when (and (gnus-check-backend-function - 'request-set-mark gnus-newsgroup-name) - (not (gnus-article-unpropagatable-p (cdr type)))) - (let* ((old (cdr (assq (cdr type) (gnus-info-marks info)))) - (del (gnus-remove-from-range (gnus-copy-sequence old) list)) - (add (gnus-remove-from-range - (gnus-copy-sequence list) old))) - (when add - (push (list add 'add (list (cdr type))) delta-marks)) - (when del - (push (list del 'del (list (cdr type))) delta-marks)))) - - (when list - (push (cons (cdr type) list) newmarked))) - - (when delta-marks - (unless (gnus-check-group gnus-newsgroup-name) - (error "Can't open server for %s" gnus-newsgroup-name)) - (gnus-request-set-mark gnus-newsgroup-name delta-marks)) - - ;; Enter these new marks into the info of the group. - (if (nthcdr 3 info) - (setcar (nthcdr 3 info) newmarked) - ;; Add the marks lists to the end of the info. - (when newmarked - (setcdr (nthcdr 2 info) (list newmarked)))) - - ;; Cut off the end of the info if there's nothing else there. - (let ((i 5)) - (while (and (> i 2) - (not (nth i info))) - (when (nthcdr (decf i) info) - (setcdr (nthcdr i info) nil))))))) - -(defun gnus-set-mode-line (where) - "Set the mode line of the article or summary buffers. -If WHERE is `summary', the summary mode line format will be used." - ;; Is this mode line one we keep updated? - (when (and (memq where gnus-updated-mode-lines) - (symbol-value - (intern (format "gnus-%s-mode-line-format-spec" where)))) - (let (mode-string) - (save-excursion - ;; We evaluate this in the summary buffer since these - ;; variables are buffer-local to that buffer. - (set-buffer gnus-summary-buffer) - ;; We bind all these variables that are used in the `eval' form - ;; below. - (let* ((mformat (symbol-value - (intern - (format "gnus-%s-mode-line-format-spec" where)))) - (gnus-tmp-group-name (gnus-mode-string-quote - (gnus-group-decoded-name - gnus-newsgroup-name))) - (gnus-tmp-article-number (or gnus-current-article 0)) - (gnus-tmp-unread gnus-newsgroup-unreads) - (gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads)) - (gnus-tmp-unselected (length gnus-newsgroup-unselected)) - (gnus-tmp-unread-and-unselected - (cond ((and (zerop gnus-tmp-unread-and-unticked) - (zerop gnus-tmp-unselected)) - "") - ((zerop gnus-tmp-unselected) - (format "{%d more}" gnus-tmp-unread-and-unticked)) - (t (format "{%d(+%d) more}" - gnus-tmp-unread-and-unticked - gnus-tmp-unselected)))) - (gnus-tmp-subject - (if (and gnus-current-headers - (vectorp gnus-current-headers)) - (gnus-mode-string-quote - (mail-header-subject gnus-current-headers)) - "")) - bufname-length max-len - gnus-tmp-header) ;; passed as argument to any user-format-funcs - (setq mode-string (eval mformat)) - (setq bufname-length (if (string-match "%b" mode-string) - (- (length - (buffer-name - (if (eq where 'summary) - nil - (get-buffer gnus-article-buffer)))) - 2) - 0)) - (setq max-len (max 4 (if gnus-mode-non-string-length - (- (window-width) - gnus-mode-non-string-length - bufname-length) - (length mode-string)))) - ;; We might have to chop a bit of the string off... - (when (> (length mode-string) max-len) - (setq mode-string - (concat (truncate-string-to-width mode-string (- max-len 3)) - "..."))) - ;; Pad the mode string a bit. - (setq mode-string (format (format "%%-%ds" max-len) mode-string)))) - ;; Update the mode line. - (setq mode-line-buffer-identification - (gnus-mode-line-buffer-identification (list mode-string))) - (set-buffer-modified-p t)))) - -(defun gnus-create-xref-hashtb (from-newsgroup headers unreads) - "Go through the HEADERS list and add all Xrefs to a hash table. -The resulting hash table is returned, or nil if no Xrefs were found." - (let* ((virtual (gnus-virtual-group-p from-newsgroup)) - (prefix (if virtual "" (gnus-group-real-prefix from-newsgroup))) - (xref-hashtb (gnus-make-hashtable)) - start group entry number xrefs header) - (while headers - (setq header (pop headers)) - (when (and (setq xrefs (mail-header-xref header)) - (not (memq (setq number (mail-header-number header)) - unreads))) - (setq start 0) - (while (string-match "\\([^ ]+\\)[:/]\\([0-9]+\\)" xrefs start) - (setq start (match-end 0)) - (setq group (if prefix - (concat prefix (substring xrefs (match-beginning 1) - (match-end 1))) - (substring xrefs (match-beginning 1) (match-end 1)))) - (setq number - (string-to-number (substring xrefs (match-beginning 2) - (match-end 2)))) - (if (setq entry (gnus-gethash group xref-hashtb)) - (setcdr entry (cons number (cdr entry))) - (gnus-sethash group (cons number nil) xref-hashtb))))) - (and start xref-hashtb))) - -(defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads) - "Look through all the headers and mark the Xrefs as read." - (let ((virtual (gnus-virtual-group-p from-newsgroup)) - name entry info xref-hashtb idlist method nth4) - (save-excursion - (set-buffer gnus-group-buffer) - (when (setq xref-hashtb - (gnus-create-xref-hashtb from-newsgroup headers unreads)) - (mapatoms - (lambda (group) - (unless (string= from-newsgroup (setq name (symbol-name group))) - (setq idlist (symbol-value group)) - ;; Dead groups are not updated. - (and (prog1 - (setq entry (gnus-gethash name gnus-newsrc-hashtb) - info (nth 2 entry)) - (when (stringp (setq nth4 (gnus-info-method info))) - (setq nth4 (gnus-server-to-method nth4)))) - ;; Only do the xrefs if the group has the same - ;; select method as the group we have just read. - (or (gnus-methods-equal-p - nth4 (gnus-find-method-for-group from-newsgroup)) - virtual - (equal nth4 (setq method (gnus-find-method-for-group - from-newsgroup))) - (and (equal (car nth4) (car method)) - (equal (nth 1 nth4) (nth 1 method)))) - gnus-use-cross-reference - (or (not (eq gnus-use-cross-reference t)) - virtual - ;; Only do cross-references on subscribed - ;; groups, if that is what is wanted. - (<= (gnus-info-level info) gnus-level-subscribed)) - (gnus-group-make-articles-read name idlist)))) - xref-hashtb))))) - -(defun gnus-compute-read-articles (group articles) - (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) - (info (nth 2 entry)) - (active (gnus-active group)) - ninfo) - (when entry - ;; First peel off all invalid article numbers. - (when active - (let ((ids articles) - id first) - (while (setq id (pop ids)) - (when (and first (> id (cdr active))) - ;; We'll end up in this situation in one particular - ;; obscure situation. If you re-scan a group and get - ;; a new article that is cross-posted to a different - ;; group that has not been re-scanned, you might get - ;; crossposted article that has a higher number than - ;; Gnus believes possible. So we re-activate this - ;; group as well. This might mean doing the - ;; crossposting thingy will *increase* the number - ;; of articles in some groups. Tsk, tsk. - (setq active (or (gnus-activate-group group) active))) - (when (or (> id (cdr active)) - (< id (car active))) - (setq articles (delq id articles)))))) - ;; If the read list is nil, we init it. - (if (and active - (null (gnus-info-read info)) - (> (car active) 1)) - (setq ninfo (cons 1 (1- (car active)))) - (setq ninfo (gnus-info-read info))) - ;; Then we add the read articles to the range. - (gnus-add-to-range - ninfo (setq articles (sort articles '<)))))) - -(defun gnus-group-make-articles-read (group articles) - "Update the info of GROUP to say that ARTICLES are read." - (let* ((num 0) - (entry (gnus-gethash group gnus-newsrc-hashtb)) - (info (nth 2 entry)) - (active (gnus-active group)) - range) - (when entry - (setq range (gnus-compute-read-articles group articles)) - (save-excursion - (set-buffer gnus-group-buffer) - (gnus-undo-register - `(progn - (gnus-info-set-marks ',info ',(gnus-info-marks info) t) - (gnus-info-set-read ',info ',(gnus-info-read info)) - (gnus-get-unread-articles-in-group ',info (gnus-active ,group)) - (gnus-request-set-mark ,group (list (list ',range 'del '(read)))) - (gnus-group-update-group ,group t)))) - ;; Add the read articles to the range. - (gnus-info-set-read info range) - (gnus-request-set-mark group (list (list range 'add '(read)))) - ;; Then we have to re-compute how many unread - ;; articles there are in this group. - (when active - (cond - ((not range) - (setq num (- (1+ (cdr active)) (car active)))) - ((not (listp (cdr range))) - (setq num (- (cdr active) (- (1+ (cdr range)) - (car range))))) - (t - (while range - (if (numberp (car range)) - (setq num (1+ num)) - (setq num (+ num (- (1+ (cdar range)) (caar range))))) - (setq range (cdr range))) - (setq num (- (cdr active) num)))) - ;; Update the number of unread articles. - (setcar entry num) - ;; Update the group buffer. - (unless (gnus-ephemeral-group-p group) - (gnus-group-update-group group t)))))) - -(defvar gnus-newsgroup-none-id 0) - -(defun gnus-get-newsgroup-headers (&optional dependencies force-new) - (let ((cur nntp-server-buffer) - (dependencies - (or dependencies - (save-excursion (set-buffer gnus-summary-buffer) - gnus-newsgroup-dependencies))) - headers id end ref - (mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets - (save-excursion (condition-case nil - (set-buffer gnus-summary-buffer) - (error)) - gnus-newsgroup-ignored-charsets))) - (save-excursion - (set-buffer nntp-server-buffer) - ;; Translate all TAB characters into SPACE characters. - (subst-char-in-region (point-min) (point-max) ?\t ? t) - (subst-char-in-region (point-min) (point-max) ?\r ? t) - (ietf-drums-unfold-fws) - (gnus-run-hooks 'gnus-parse-headers-hook) - (let ((case-fold-search t) - in-reply-to header p lines chars) - (goto-char (point-min)) - ;; Search to the beginning of the next header. Error messages - ;; do not begin with 2 or 3. - (while (re-search-forward "^[23][0-9]+ " nil t) - (setq id nil - ref nil) - ;; This implementation of this function, with nine - ;; search-forwards instead of the one re-search-forward and - ;; a case (which basically was the old function) is actually - ;; about twice as fast, even though it looks messier. You - ;; can't have everything, I guess. Speed and elegance - ;; doesn't always go hand in hand. - (setq - header - (vector - ;; Number. - (prog1 - (read cur) - (end-of-line) - (setq p (point)) - (narrow-to-region (point) - (or (and (search-forward "\n.\n" nil t) - (- (point) 2)) - (point)))) - ;; Subject. - (progn - (goto-char p) - (if (search-forward "\nsubject:" nil t) - (funcall gnus-decode-encoded-word-function - (nnheader-header-value)) - "(none)")) - ;; From. - (progn - (goto-char p) - (if (search-forward "\nfrom:" nil t) - (funcall gnus-decode-encoded-address-function - (nnheader-header-value)) - "(nobody)")) - ;; Date. - (progn - (goto-char p) - (if (search-forward "\ndate:" nil t) - (nnheader-header-value) "")) - ;; Message-ID. - (progn - (goto-char p) - (setq id (if (re-search-forward - "^message-id: *\\(<[^\n\t> ]+>\\)" nil t) - ;; We do it this way to make sure the Message-ID - ;; is (somewhat) syntactically valid. - (buffer-substring (match-beginning 1) - (match-end 1)) - ;; If there was no message-id, we just fake one - ;; to make subsequent routines simpler. - (nnheader-generate-fake-message-id)))) - ;; References. - (progn - (goto-char p) - (if (search-forward "\nreferences:" nil t) - (progn - (setq end (point)) - (prog1 - (nnheader-header-value) - (setq ref - (buffer-substring - (progn - (end-of-line) - (search-backward ">" end t) - (1+ (point))) - (progn - (search-backward "<" end t) - (point)))))) - ;; Get the references from the in-reply-to header if there - ;; were no references and the in-reply-to header looks - ;; promising. - (if (and (search-forward "\nin-reply-to:" nil t) - (setq in-reply-to (nnheader-header-value)) - (string-match "<[^>]+>" in-reply-to)) - (let (ref2) - (setq ref (substring in-reply-to (match-beginning 0) - (match-end 0))) - (while (string-match "<[^>]+>" in-reply-to (match-end 0)) - (setq ref2 (substring in-reply-to (match-beginning 0) - (match-end 0))) - (when (> (length ref2) (length ref)) - (setq ref ref2))) - ref) - (setq ref nil)))) - ;; Chars. - (progn - (goto-char p) - (if (search-forward "\nchars: " nil t) - (if (numberp (setq chars (ignore-errors (read cur)))) - chars -1) - -1)) - ;; Lines. - (progn - (goto-char p) - (if (search-forward "\nlines: " nil t) - (if (numberp (setq lines (ignore-errors (read cur)))) - lines -1) - -1)) - ;; Xref. - (progn - (goto-char p) - (and (search-forward "\nxref:" nil t) - (nnheader-header-value))) - ;; Extra. - (when gnus-extra-headers - (let ((extra gnus-extra-headers) - out) - (while extra - (goto-char p) - (when (search-forward - (concat "\n" (symbol-name (car extra)) ":") nil t) - (push (cons (car extra) (nnheader-header-value)) - out)) - (pop extra)) - out)))) - (when (equal id ref) - (setq ref nil)) - - (when gnus-alter-header-function - (funcall gnus-alter-header-function header) - (setq id (mail-header-id header) - ref (gnus-parent-id (mail-header-references header)))) - - (when (setq header - (gnus-dependencies-add-header - header dependencies force-new)) - (push header headers)) - (goto-char (point-max)) - (widen)) - (nreverse headers))))) - -;; Goes through the xover lines and returns a list of vectors -(defun gnus-get-newsgroup-headers-xover (sequence &optional - force-new dependencies - group also-fetch-heads) - "Parse the news overview data in the server buffer. -Return a list of headers that match SEQUENCE (see -`nntp-retrieve-headers')." - ;; Get the Xref when the users reads the articles since most/some - ;; NNTP servers do not include Xrefs when using XOVER. - (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs)) - (let ((mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets) - (cur nntp-server-buffer) - (dependencies (or dependencies gnus-newsgroup-dependencies)) - (allp (cond - ((eq gnus-read-all-available-headers t) - t) - ((and (stringp gnus-read-all-available-headers) - group) - (string-match gnus-read-all-available-headers group)) - (t - nil))) - number headers header) - (save-excursion - (set-buffer nntp-server-buffer) - (subst-char-in-region (point-min) (point-max) ?\r ? t) - ;; Allow the user to mangle the headers before parsing them. - (gnus-run-hooks 'gnus-parse-headers-hook) - (goto-char (point-min)) - (gnus-parse-without-error - (while (and (or sequence allp) - (not (eobp))) - (setq number (read cur)) - (when (not allp) - (while (and sequence - (< (car sequence) number)) - (setq sequence (cdr sequence)))) - (when (and (or allp - (and sequence - (eq number (car sequence)))) - (progn - (setq sequence (cdr sequence)) - (setq header (inline - (gnus-nov-parse-line - number dependencies force-new))))) - (push header headers)) - (forward-line 1))) - ;; A common bug in inn is that if you have posted an article and - ;; then retrieves the active file, it will answer correctly -- - ;; the new article is included. However, a NOV entry for the - ;; article may not have been generated yet, so this may fail. - ;; We work around this problem by retrieving the last few - ;; headers using HEAD. - (if (or (not also-fetch-heads) - (not sequence)) - ;; We (probably) got all the headers. - (nreverse headers) - (let ((gnus-nov-is-evil t)) - (nconc - (nreverse headers) - (when (eq (gnus-retrieve-headers sequence group) 'headers) - (gnus-get-newsgroup-headers)))))))) - -(defun gnus-article-get-xrefs () - "Fill in the Xref value in `gnus-current-headers', if necessary. -This is meant to be called in `gnus-article-internal-prepare-hook'." - (let ((headers (save-excursion (set-buffer gnus-summary-buffer) - gnus-current-headers))) - (or (not gnus-use-cross-reference) - (not headers) - (and (mail-header-xref headers) - (not (string= (mail-header-xref headers) ""))) - (let ((case-fold-search t) - xref) - (save-restriction - (nnheader-narrow-to-headers) - (goto-char (point-min)) - (when (or (and (not (eobp)) - (eq (downcase (char-after)) ?x) - (looking-at "Xref:")) - (search-forward "\nXref:" nil t)) - (goto-char (1+ (match-end 0))) - (setq xref (buffer-substring (point) (gnus-point-at-eol))) - (mail-header-set-xref headers xref))))))) - -(defun gnus-summary-insert-subject (id &optional old-header use-old-header) - "Find article ID and insert the summary line for that article. -OLD-HEADER can either be a header or a line number to insert -the subject line on." - (let* ((line (and (numberp old-header) old-header)) - (old-header (and (vectorp old-header) old-header)) - (header (cond ((and old-header use-old-header) - old-header) - ((and (numberp id) - (gnus-number-to-header id)) - (gnus-number-to-header id)) - (t - (gnus-read-header id)))) - (number (and (numberp id) id)) - d) - (when header - ;; Rebuild the thread that this article is part of and go to the - ;; article we have fetched. - (when (and (not gnus-show-threads) - old-header) - (when (and number - (setq d (gnus-data-find (mail-header-number old-header)))) - (goto-char (gnus-data-pos d)) - (gnus-data-remove - number - (- (gnus-point-at-bol) - (prog1 - (1+ (gnus-point-at-eol)) - (gnus-delete-line)))))) - ;; Remove list identifiers from subject. - (when gnus-list-identifiers - (let ((gnus-newsgroup-headers (list header))) - (gnus-summary-remove-list-identifiers))) - (when old-header - (mail-header-set-number header (mail-header-number old-header))) - (setq gnus-newsgroup-sparse - (delq (setq number (mail-header-number header)) - gnus-newsgroup-sparse)) - (setq gnus-newsgroup-ancient (delq number gnus-newsgroup-ancient)) - (push number gnus-newsgroup-limit) - (gnus-rebuild-thread (mail-header-id header) line) - (gnus-summary-goto-subject number nil t)) - (when (and (numberp number) - (> number 0)) - ;; We have to update the boundaries even if we can't fetch the - ;; article if ID is a number -- so that the next `P' or `N' - ;; command will fetch the previous (or next) article even - ;; if the one we tried to fetch this time has been canceled. - (when (> number gnus-newsgroup-end) - (setq gnus-newsgroup-end number)) - (when (< number gnus-newsgroup-begin) - (setq gnus-newsgroup-begin number)) - (setq gnus-newsgroup-unselected - (delq number gnus-newsgroup-unselected))) - ;; Report back a success? - (and header (mail-header-number header)))) - -;;; Process/prefix in the summary buffer - -(defun gnus-summary-work-articles (n) - "Return a list of articles to be worked upon. -The prefix argument, the list of process marked articles, and the -current article will be taken into consideration." - (save-excursion - (set-buffer gnus-summary-buffer) - (cond - (n - ;; A numerical prefix has been given. - (setq n (prefix-numeric-value n)) - (let ((backward (< n 0)) - (n (abs (prefix-numeric-value n))) - articles article) - (save-excursion - (while - (and (> n 0) - (push (setq article (gnus-summary-article-number)) - articles) - (if backward - (gnus-summary-find-prev nil article) - (gnus-summary-find-next nil article))) - (decf n))) - (nreverse articles))) - ((and (gnus-region-active-p) (mark)) - (message "region active") - ;; Work on the region between point and mark. - (let ((max (max (point) (mark))) - articles article) - (save-excursion - (goto-char (min (point) (mark))) - (while - (and - (push (setq article (gnus-summary-article-number)) articles) - (gnus-summary-find-next nil article) - (< (point) max))) - (nreverse articles)))) - (gnus-newsgroup-processable - ;; There are process-marked articles present. - ;; Save current state. - (gnus-summary-save-process-mark) - ;; Return the list. - (reverse gnus-newsgroup-processable)) - (t - ;; Just return the current article. - (list (gnus-summary-article-number)))))) - -(defmacro gnus-summary-iterate (arg &rest forms) - "Iterate over the process/prefixed articles and do FORMS. -ARG is the interactive prefix given to the command. FORMS will be -executed with point over the summary line of the articles." - (let ((articles (make-symbol "gnus-summary-iterate-articles"))) - `(let ((,articles (gnus-summary-work-articles ,arg))) - (while ,articles - (gnus-summary-goto-subject (car ,articles)) - ,@forms - (pop ,articles))))) - -(put 'gnus-summary-iterate 'lisp-indent-function 1) -(put 'gnus-summary-iterate 'edebug-form-spec '(form body)) - -(defun gnus-summary-save-process-mark () - "Push the current set of process marked articles on the stack." - (interactive) - (push (copy-sequence gnus-newsgroup-processable) - gnus-newsgroup-process-stack)) - -(defun gnus-summary-kill-process-mark () - "Push the current set of process marked articles on the stack and unmark." - (interactive) - (gnus-summary-save-process-mark) - (gnus-summary-unmark-all-processable)) - -(defun gnus-summary-yank-process-mark () - "Pop the last process mark state off the stack and restore it." - (interactive) - (unless gnus-newsgroup-process-stack - (error "Empty mark stack")) - (gnus-summary-process-mark-set (pop gnus-newsgroup-process-stack))) - -(defun gnus-summary-process-mark-set (set) - "Make SET into the current process marked articles." - (gnus-summary-unmark-all-processable) - (while set - (gnus-summary-set-process-mark (pop set)))) - -;;; Searching and stuff - -(defun gnus-summary-search-group (&optional backward use-level) - "Search for next unread newsgroup. -If optional argument BACKWARD is non-nil, search backward instead." - (save-excursion - (set-buffer gnus-group-buffer) - (when (gnus-group-search-forward - backward nil (if use-level (gnus-group-group-level) nil)) - (gnus-group-group-name)))) - -(defun gnus-summary-best-group (&optional exclude-group) - "Find the name of the best unread group. -If EXCLUDE-GROUP, do not go to this group." - (save-excursion - (set-buffer gnus-group-buffer) - (save-excursion - (gnus-group-best-unread-group exclude-group)))) - -(defun gnus-summary-find-next (&optional unread article backward) - (if backward - (gnus-summary-find-prev unread article) - (let* ((dummy (gnus-summary-article-intangible-p)) - (article (or article (gnus-summary-article-number))) - (data (gnus-data-find-list article)) - result) - (when (and (not dummy) - (or (not gnus-summary-check-current) - (not unread) - (not (gnus-data-unread-p (car data))))) - (setq data (cdr data))) - (when (setq result - (if unread - (progn - (while data - (unless (memq (gnus-data-number (car data)) - (cond - ((eq gnus-auto-goto-ignores - 'always-undownloaded) - gnus-newsgroup-undownloaded) - (gnus-plugged - nil) - ((eq gnus-auto-goto-ignores - 'unfetched) - gnus-newsgroup-unfetched) - ((eq gnus-auto-goto-ignores - 'undownloaded) - gnus-newsgroup-undownloaded))) - (when (gnus-data-unread-p (car data)) - (setq result (car data) - data nil))) - (setq data (cdr data))) - result) - (car data))) - (goto-char (gnus-data-pos result)) - (gnus-data-number result))))) - -(defun gnus-summary-find-prev (&optional unread article) - (let* ((eobp (eobp)) - (article (or article (gnus-summary-article-number))) - (data (gnus-data-find-list article (gnus-data-list 'rev))) - result) - (when (and (not eobp) - (or (not gnus-summary-check-current) - (not unread) - (not (gnus-data-unread-p (car data))))) - (setq data (cdr data))) - (when (setq result - (if unread - (progn - (while data - (unless (memq (gnus-data-number (car data)) - (cond - ((eq gnus-auto-goto-ignores - 'always-undownloaded) - gnus-newsgroup-undownloaded) - (gnus-plugged - nil) - ((eq gnus-auto-goto-ignores - 'unfetched) - gnus-newsgroup-unfetched) - ((eq gnus-auto-goto-ignores - 'undownloaded) - gnus-newsgroup-undownloaded))) - (when (gnus-data-unread-p (car data)) - (setq result (car data) - data nil))) - (setq data (cdr data))) - result) - (car data))) - (goto-char (gnus-data-pos result)) - (gnus-data-number result)))) - -(defun gnus-summary-find-subject (subject &optional unread backward article) - (let* ((simp-subject (gnus-simplify-subject-fully subject)) - (article (or article (gnus-summary-article-number))) - (articles (gnus-data-list backward)) - (arts (gnus-data-find-list article articles)) - result) - (when (or (not gnus-summary-check-current) - (not unread) - (not (gnus-data-unread-p (car arts)))) - (setq arts (cdr arts))) - (while arts - (and (or (not unread) - (gnus-data-unread-p (car arts))) - (vectorp (gnus-data-header (car arts))) - (gnus-subject-equal - simp-subject (mail-header-subject (gnus-data-header (car arts))) t) - (setq result (car arts) - arts nil)) - (setq arts (cdr arts))) - (and result - (goto-char (gnus-data-pos result)) - (gnus-data-number result)))) - -(defun gnus-summary-search-forward (&optional unread subject backward) - "Search forward for an article. -If UNREAD, look for unread articles. If SUBJECT, look for -articles with that subject. If BACKWARD, search backward instead." - (cond (subject (gnus-summary-find-subject subject unread backward)) - (backward (gnus-summary-find-prev unread)) - (t (gnus-summary-find-next unread)))) - -(defun gnus-recenter (&optional n) - "Center point in window and redisplay frame. -Also do horizontal recentering." - (interactive "P") - (when (and gnus-auto-center-summary - (not (eq gnus-auto-center-summary 'vertical))) - (gnus-horizontal-recenter)) - (recenter n)) - -(defun gnus-summary-recenter () - "Center point in the summary window. -If `gnus-auto-center-summary' is nil, or the article buffer isn't -displayed, no centering will be performed." - ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle). - ;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu. - (interactive) - ;; The user has to want it. - (when gnus-auto-center-summary - (let* ((top (cond ((< (window-height) 4) 0) - ((< (window-height) 7) 1) - (t (if (numberp gnus-auto-center-summary) - gnus-auto-center-summary - 2)))) - (height (1- (window-height))) - (bottom (save-excursion (goto-char (point-max)) - (forward-line (- height)) - (point))) - (window (get-buffer-window (current-buffer)))) - (when (get-buffer-window gnus-article-buffer) - ;; Only do recentering when the article buffer is displayed, - ;; Set the window start to either `bottom', which is the biggest - ;; possible valid number, or the second line from the top, - ;; whichever is the least. - (let ((top-pos (save-excursion (forward-line (- top)) (point)))) - (if (> bottom top-pos) - ;; Keep the second line from the top visible - (set-window-start window top-pos t) - ;; Try to keep the bottom line visible; if it's partially - ;; obscured, either scroll one more line to make it fully - ;; visible, or revert to using TOP-POS. - (save-excursion - (goto-char (point-max)) - (forward-line -1) - (let ((last-line-start (point))) - (goto-char bottom) - (set-window-start window (point) t) - (when (not (pos-visible-in-window-p last-line-start window)) - (forward-line 1) - (set-window-start window (min (point) top-pos) t))))))) - ;; Do horizontal recentering while we're at it. - (when (and (get-buffer-window (current-buffer) t) - (not (eq gnus-auto-center-summary 'vertical))) - (let ((selected (selected-window))) - (select-window (get-buffer-window (current-buffer) t)) - (gnus-summary-position-point) - (gnus-horizontal-recenter) - (select-window selected)))))) - -(defun gnus-summary-jump-to-group (newsgroup) - "Move point to NEWSGROUP in group mode buffer." - ;; Keep update point of group mode buffer if visible. - (if (eq (current-buffer) (get-buffer gnus-group-buffer)) - (save-window-excursion - ;; Take care of tree window mode. - (when (get-buffer-window gnus-group-buffer) - (pop-to-buffer gnus-group-buffer)) - (gnus-group-jump-to-group newsgroup)) - (save-excursion - ;; Take care of tree window mode. - (if (get-buffer-window gnus-group-buffer) - (pop-to-buffer gnus-group-buffer) - (set-buffer gnus-group-buffer)) - (gnus-group-jump-to-group newsgroup)))) - -;; This function returns a list of article numbers based on the -;; difference between the ranges of read articles in this group and -;; the range of active articles. -(defun gnus-list-of-unread-articles (group) - (let* ((read (gnus-info-read (gnus-get-info group))) - (active (or (gnus-active group) (gnus-activate-group group))) - (last (cdr active)) - (bottom (if gnus-newsgroup-maximum-articles - (max (car active) - (- last gnus-newsgroup-maximum-articles -1)) - (car active))) - first nlast unread) - ;; If none are read, then all are unread. - (if (not read) - (setq first bottom) - ;; If the range of read articles is a single range, then the - ;; first unread article is the article after the last read - ;; article. Sounds logical, doesn't it? - (if (and (not (listp (cdr read))) - (or (< (car read) bottom) - (progn (setq read (list read)) - nil))) - (setq first (max bottom (1+ (cdr read)))) - ;; `read' is a list of ranges. - (when (/= (setq nlast (or (and (numberp (car read)) (car read)) - (caar read))) - 1) - (setq first bottom)) - (while read - (when first - (while (< first nlast) - (setq unread (cons first unread) - first (1+ first)))) - (setq first (1+ (if (atom (car read)) (car read) (cdar read)))) - (setq nlast (if (atom (cadr read)) (cadr read) (caadr read))) - (setq read (cdr read))))) - ;; And add the last unread articles. - (while (<= first last) - (setq unread (cons first unread) - first (1+ first))) - ;; Return the list of unread articles. - (delq 0 (nreverse unread)))) - -(defun gnus-list-of-read-articles (group) - "Return a list of unread, unticked and non-dormant articles." - (let* ((info (gnus-get-info group)) - (marked (gnus-info-marks info)) - (active (gnus-active group))) - (and info active - (gnus-list-range-difference - (gnus-list-range-difference - (gnus-sorted-complement - (gnus-uncompress-range - (if gnus-newsgroup-maximum-articles - (cons (max (car active) - (- (cdr active) - gnus-newsgroup-maximum-articles - -1)) - (cdr active)) - active)) - (gnus-list-of-unread-articles group)) - (cdr (assq 'dormant marked))) - (cdr (assq 'tick marked)))))) - -;; This function returns a sequence of article numbers based on the -;; difference between the ranges of read articles in this group and -;; the range of active articles. -(defun gnus-sequence-of-unread-articles (group) - (let* ((read (gnus-info-read (gnus-get-info group))) - (active (or (gnus-active group) (gnus-activate-group group))) - (last (cdr active)) - (bottom (if gnus-newsgroup-maximum-articles - (max (car active) - (- last gnus-newsgroup-maximum-articles -1)) - (car active))) - first nlast unread) - ;; If none are read, then all are unread. - (if (not read) - (setq first bottom) - ;; If the range of read articles is a single range, then the - ;; first unread article is the article after the last read - ;; article. Sounds logical, doesn't it? - (if (and (not (listp (cdr read))) - (or (< (car read) bottom) - (progn (setq read (list read)) - nil))) - (setq first (max bottom (1+ (cdr read)))) - ;; `read' is a list of ranges. - (when (/= (setq nlast (or (and (numberp (car read)) (car read)) - (caar read))) - 1) - (setq first bottom)) - (while read - (when first - (push (cons first nlast) unread)) - (setq first (1+ (if (atom (car read)) (car read) (cdar read)))) - (setq nlast (if (atom (cadr read)) (cadr read) (caadr read))) - (setq read (cdr read))))) - ;; And add the last unread articles. - (cond ((not (and first last)) - nil) - ((< first last) - (push (cons first last) unread)) - ((= first last) - (push first unread))) - ;; Return the sequence of unread articles. - (delq 0 (nreverse unread)))) - -;; Various summary commands - -(defun gnus-summary-select-article-buffer () - "Reconfigure windows to show article buffer." - (interactive) - (if (not (gnus-buffer-live-p gnus-article-buffer)) - (error "There is no article buffer for this summary buffer") - (gnus-configure-windows 'article) - (select-window (get-buffer-window gnus-article-buffer)))) - -(defun gnus-summary-universal-argument (arg) - "Perform any operation on all articles that are process/prefixed." - (interactive "P") - (let ((articles (gnus-summary-work-articles arg)) - func article) - (if (eq - (setq - func - (key-binding - (read-key-sequence - (substitute-command-keys - "\\\\[gnus-summary-universal-argument]")))) - 'undefined) - (gnus-error 1 "Undefined key") - (save-excursion - (while articles - (gnus-summary-goto-subject (setq article (pop articles))) - (let (gnus-newsgroup-processable) - (command-execute func)) - (gnus-summary-remove-process-mark article))))) - (gnus-summary-position-point)) - -(defun gnus-summary-toggle-truncation (&optional arg) - "Toggle truncation of summary lines. -With ARG, turn line truncation on if ARG is positive." - (interactive "P") - (setq truncate-lines - (if (null arg) (not truncate-lines) - (> (prefix-numeric-value arg) 0))) - (redraw-display)) - -(defun gnus-summary-find-for-reselect () - "Return the number of an article to stay on across a reselect. -The current article is considered, then following articles, then previous -articles. An article is sought which is not cancelled and isn't a temporary -insertion from another group. If there's no such then return a dummy 0." - (let (found) - (dolist (rev '(nil t)) - (unless found ; don't demand the reverse list if we don't need it - (let ((data (gnus-data-find-list - (gnus-summary-article-number) (gnus-data-list rev)))) - (while (and data (not found)) - (if (and (< 0 (gnus-data-number (car data))) - (not (eq gnus-canceled-mark (gnus-data-mark (car data))))) - (setq found (gnus-data-number (car data)))) - (setq data (cdr data)))))) - (or found 0))) - -(defun gnus-summary-reselect-current-group (&optional all rescan) - "Exit and then reselect the current newsgroup. -The prefix argument ALL means to select all articles." - (interactive "P") - (when (gnus-ephemeral-group-p gnus-newsgroup-name) - (error "Ephemeral groups can't be reselected")) - (let ((current-subject (gnus-summary-find-for-reselect)) - (group gnus-newsgroup-name)) - (setq gnus-newsgroup-begin nil) - (gnus-summary-exit nil 'leave-hidden) - ;; We have to adjust the point of group mode buffer because - ;; point was moved to the next unread newsgroup by exiting. - (gnus-summary-jump-to-group group) - (when rescan - (save-excursion - (gnus-group-get-new-news-this-group 1))) - (gnus-group-read-group all t) - (gnus-summary-goto-subject current-subject nil t))) - -(defun gnus-summary-rescan-group (&optional all) - "Exit the newsgroup, ask for new articles, and select the newsgroup." - (interactive "P") - (gnus-summary-reselect-current-group all t)) - -(defun gnus-summary-update-info (&optional non-destructive) - (save-excursion - (let ((group gnus-newsgroup-name)) - (when group - (when gnus-newsgroup-kill-headers - (setq gnus-newsgroup-killed - (gnus-compress-sequence - (gnus-sorted-union - (gnus-list-range-intersection - gnus-newsgroup-unselected gnus-newsgroup-killed) - gnus-newsgroup-unreads) - t))) - (unless (listp (cdr gnus-newsgroup-killed)) - (setq gnus-newsgroup-killed (list gnus-newsgroup-killed))) - (let ((headers gnus-newsgroup-headers)) - ;; Set the new ranges of read articles. - (save-excursion - (set-buffer gnus-group-buffer) - (gnus-undo-force-boundary)) - (gnus-update-read-articles - group (gnus-sorted-union - gnus-newsgroup-unreads gnus-newsgroup-unselected)) - ;; Set the current article marks. - (let ((gnus-newsgroup-scored - (if (and (not gnus-save-score) - (not non-destructive)) - nil - gnus-newsgroup-scored))) - (save-excursion - (gnus-update-marks))) - ;; Do the cross-ref thing. - (when gnus-use-cross-reference - (gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads)) - ;; Do not switch windows but change the buffer to work. - (set-buffer gnus-group-buffer) - (unless (gnus-ephemeral-group-p group) - (gnus-group-update-group group))))))) - -(defun gnus-summary-save-newsrc (&optional force) - "Save the current number of read/marked articles in the dribble buffer. -The dribble buffer will then be saved. -If FORCE (the prefix), also save the .newsrc file(s)." - (interactive "P") - (gnus-summary-update-info t) - (if force - (gnus-save-newsrc-file) - (gnus-dribble-save))) - -(defun gnus-summary-exit (&optional temporary leave-hidden) - "Exit reading current newsgroup, and then return to group selection mode. -`gnus-exit-group-hook' is called with no arguments if that value is non-nil." - (interactive) - (gnus-set-global-variables) - (when (gnus-buffer-live-p gnus-article-buffer) - (save-excursion - (set-buffer gnus-article-buffer) - (mm-destroy-parts gnus-article-mime-handles) - ;; Set it to nil for safety reason. - (setq gnus-article-mime-handle-alist nil) - (setq gnus-article-mime-handles nil))) - (gnus-kill-save-kill-buffer) - (gnus-async-halt-prefetch) - (let* ((group gnus-newsgroup-name) - (quit-config (gnus-group-quit-config gnus-newsgroup-name)) - (gnus-group-is-exiting-p t) - (mode major-mode) - (group-point nil) - (buf (current-buffer))) - (unless quit-config - ;; Do adaptive scoring, and possibly save score files. - (when gnus-newsgroup-adaptive - (gnus-score-adaptive)) - (when gnus-use-scoring - (gnus-score-save))) - (gnus-run-hooks 'gnus-summary-prepare-exit-hook) - ;; If we have several article buffers, we kill them at exit. - (unless gnus-single-article-buffer - (gnus-kill-buffer gnus-original-article-buffer) - (setq gnus-article-current nil)) - (when gnus-use-cache - (gnus-cache-possibly-remove-articles) - (gnus-cache-save-buffers)) - (gnus-async-prefetch-remove-group group) - (when gnus-suppress-duplicates - (gnus-dup-enter-articles)) - (when gnus-use-trees - (gnus-tree-close group)) - (when gnus-use-cache - (gnus-cache-write-active)) - ;; Remove entries for this group. - (nnmail-purge-split-history (gnus-group-real-name group)) - ;; Make all changes in this group permanent. - (unless quit-config - (gnus-run-hooks 'gnus-exit-group-hook) - (gnus-summary-update-info)) - (gnus-close-group group) - ;; Make sure where we were, and go to next newsgroup. - (set-buffer gnus-group-buffer) - (unless quit-config - (gnus-group-jump-to-group group)) - (gnus-run-hooks 'gnus-summary-exit-hook) - (unless (or quit-config - ;; If this group has disappeared from the summary - ;; buffer, don't skip forwards. - (not (string= group (gnus-group-group-name)))) - (gnus-group-next-unread-group 1)) - (setq group-point (point)) - (if temporary - nil ;Nothing to do. - ;; If we have several article buffers, we kill them at exit. - (unless gnus-single-article-buffer - (gnus-kill-buffer gnus-article-buffer) - (gnus-kill-buffer gnus-original-article-buffer) - (setq gnus-article-current nil)) - (set-buffer buf) - (if (not gnus-kill-summary-on-exit) - (progn - (gnus-deaden-summary) - (setq mode nil)) - ;; We set all buffer-local variables to nil. It is unclear why - ;; this is needed, but if we don't, buffer-local variables are - ;; not garbage-collected, it seems. This would the lead to en - ;; ever-growing Emacs. - (gnus-summary-clear-local-variables) - (let ((gnus-summary-local-variables gnus-newsgroup-variables)) - (gnus-summary-clear-local-variables)) - (when (get-buffer gnus-article-buffer) - (bury-buffer gnus-article-buffer)) - ;; We clear the global counterparts of the buffer-local - ;; variables as well, just to be on the safe side. - (set-buffer gnus-group-buffer) - (gnus-summary-clear-local-variables) - (let ((gnus-summary-local-variables gnus-newsgroup-variables)) - (gnus-summary-clear-local-variables)) - ;; Return to group mode buffer. - (when (eq mode 'gnus-summary-mode) - (gnus-kill-buffer buf))) - (setq gnus-current-select-method gnus-select-method) - (set-buffer gnus-group-buffer) - (if quit-config - (gnus-handle-ephemeral-exit quit-config) - (goto-char group-point) - ;; If gnus-group-buffer is already displayed, make sure we also move - ;; the cursor in the window that displays it. - (let ((win (get-buffer-window (current-buffer) 0))) - (if win (set-window-point win (point)))) - (unless leave-hidden - (gnus-configure-windows 'group 'force))) - ;; Clear the current group name. - (unless quit-config - (setq gnus-newsgroup-name nil))))) - -(defalias 'gnus-summary-quit 'gnus-summary-exit-no-update) -(defun gnus-summary-exit-no-update (&optional no-questions) - "Quit reading current newsgroup without updating read article info." - (interactive) - (let* ((group gnus-newsgroup-name) - (gnus-group-is-exiting-p t) - (gnus-group-is-exiting-without-update-p t) - (quit-config (gnus-group-quit-config group))) - (when (or no-questions - gnus-expert-user - (gnus-y-or-n-p "Discard changes to this group and exit? ")) - (gnus-async-halt-prefetch) - (run-hooks 'gnus-summary-prepare-exit-hook) - (when (gnus-buffer-live-p gnus-article-buffer) - (save-excursion - (set-buffer gnus-article-buffer) - (mm-destroy-parts gnus-article-mime-handles) - ;; Set it to nil for safety reason. - (setq gnus-article-mime-handle-alist nil) - (setq gnus-article-mime-handles nil))) - ;; If we have several article buffers, we kill them at exit. - (unless gnus-single-article-buffer - (gnus-kill-buffer gnus-article-buffer) - (gnus-kill-buffer gnus-original-article-buffer) - (setq gnus-article-current nil)) - (if (not gnus-kill-summary-on-exit) - (gnus-deaden-summary) - (gnus-close-group group) - (gnus-summary-clear-local-variables) - (let ((gnus-summary-local-variables gnus-newsgroup-variables)) - (gnus-summary-clear-local-variables)) - (set-buffer gnus-group-buffer) - (gnus-summary-clear-local-variables) - (let ((gnus-summary-local-variables gnus-newsgroup-variables)) - (gnus-summary-clear-local-variables)) - (gnus-kill-buffer gnus-summary-buffer)) - (unless gnus-single-article-buffer - (setq gnus-article-current nil)) - (when gnus-use-trees - (gnus-tree-close group)) - (gnus-async-prefetch-remove-group group) - (when (get-buffer gnus-article-buffer) - (bury-buffer gnus-article-buffer)) - ;; Return to the group buffer. - (gnus-configure-windows 'group 'force) - ;; Clear the current group name. - (setq gnus-newsgroup-name nil) - (unless (gnus-ephemeral-group-p group) - (gnus-group-update-group group)) - (when (equal (gnus-group-group-name) group) - (gnus-group-next-unread-group 1)) - (when quit-config - (gnus-handle-ephemeral-exit quit-config))))) - -(defun gnus-handle-ephemeral-exit (quit-config) - "Handle movement when leaving an ephemeral group. -The state which existed when entering the ephemeral is reset." - (if (not (buffer-name (car quit-config))) - (gnus-configure-windows 'group 'force) - (set-buffer (car quit-config)) - (cond ((eq major-mode 'gnus-summary-mode) - (gnus-set-global-variables)) - ((eq major-mode 'gnus-article-mode) - (save-excursion - ;; The `gnus-summary-buffer' variable may point - ;; to the old summary buffer when using a single - ;; article buffer. - (unless (gnus-buffer-live-p gnus-summary-buffer) - (set-buffer gnus-group-buffer)) - (set-buffer gnus-summary-buffer) - (gnus-set-global-variables)))) - (if (or (eq (cdr quit-config) 'article) - (eq (cdr quit-config) 'pick)) - (progn - ;; The current article may be from the ephemeral group - ;; thus it is best that we reload this article - ;; - ;; If we're exiting from a large digest, this can be - ;; extremely slow. So, it's better not to reload it. -- jh. - ;;(gnus-summary-show-article) - (if (and (boundp 'gnus-pick-mode) (symbol-value 'gnus-pick-mode)) - (gnus-configure-windows 'pick 'force) - (gnus-configure-windows (cdr quit-config) 'force))) - (gnus-configure-windows (cdr quit-config) 'force)) - (when (eq major-mode 'gnus-summary-mode) - (gnus-summary-next-subject 1 nil t) - (gnus-summary-recenter) - (gnus-summary-position-point)))) - -;;; Dead summaries. - -(defvar gnus-dead-summary-mode-map nil) - -(unless gnus-dead-summary-mode-map - (setq gnus-dead-summary-mode-map (make-keymap)) - (suppress-keymap gnus-dead-summary-mode-map) - (substitute-key-definition - 'undefined 'gnus-summary-wake-up-the-dead gnus-dead-summary-mode-map) - (dolist (key '("\C-d" "\r" "\177" [delete])) - (define-key gnus-dead-summary-mode-map - key 'gnus-summary-wake-up-the-dead)) - (dolist (key '("q" "Q")) - (define-key gnus-dead-summary-mode-map key 'bury-buffer))) - -(defvar gnus-dead-summary-mode nil - "Minor mode for Gnus summary buffers.") - -(defun gnus-dead-summary-mode (&optional arg) - "Minor mode for Gnus summary buffers." - (interactive "P") - (when (eq major-mode 'gnus-summary-mode) - (make-local-variable 'gnus-dead-summary-mode) - (setq gnus-dead-summary-mode - (if (null arg) (not gnus-dead-summary-mode) - (> (prefix-numeric-value arg) 0))) - (when gnus-dead-summary-mode - (gnus-add-minor-mode - 'gnus-dead-summary-mode " Dead" gnus-dead-summary-mode-map)))) - -(defun gnus-deaden-summary () - "Make the current summary buffer into a dead summary buffer." - ;; Kill any previous dead summary buffer. - (when (and gnus-dead-summary - (buffer-name gnus-dead-summary)) - (save-excursion - (set-buffer gnus-dead-summary) - (when gnus-dead-summary-mode - (kill-buffer (current-buffer))))) - ;; Make this the current dead summary. - (setq gnus-dead-summary (current-buffer)) - (gnus-dead-summary-mode 1) - (let ((name (buffer-name))) - (when (string-match "Summary" name) - (rename-buffer - (concat (substring name 0 (match-beginning 0)) "Dead " - (substring name (match-beginning 0))) - t) - (bury-buffer)))) - -(defun gnus-kill-or-deaden-summary (buffer) - "Kill or deaden the summary BUFFER." - (save-excursion - (when (and (buffer-name buffer) - (not gnus-single-article-buffer)) - (save-excursion - (set-buffer buffer) - (gnus-kill-buffer gnus-article-buffer) - (gnus-kill-buffer gnus-original-article-buffer))) - (cond - ;; Kill the buffer. - (gnus-kill-summary-on-exit - (when (and gnus-use-trees - (gnus-buffer-exists-p buffer)) - (save-excursion - (set-buffer buffer) - (gnus-tree-close gnus-newsgroup-name))) - (gnus-kill-buffer buffer)) - ;; Deaden the buffer. - ((gnus-buffer-exists-p buffer) - (save-excursion - (set-buffer buffer) - (gnus-deaden-summary)))))) - -(defun gnus-summary-wake-up-the-dead (&rest args) - "Wake up the dead summary buffer." - (interactive) - (gnus-dead-summary-mode -1) - (let ((name (buffer-name))) - (when (string-match "Dead " name) - (rename-buffer - (concat (substring name 0 (match-beginning 0)) - (substring name (match-end 0))) - t))) - (gnus-message 3 "This dead summary is now alive again")) - -;; Suggested by Andrew Eskilsson . -(defun gnus-summary-fetch-faq (&optional faq-dir) - "Fetch the FAQ for the current group. -If FAQ-DIR (the prefix), prompt for a directory to search for the faq -in." - (interactive - (list - (when current-prefix-arg - (completing-read - "FAQ dir: " (and (listp gnus-group-faq-directory) - (mapcar (lambda (file) (list file)) - gnus-group-faq-directory)))))) - (let (gnus-faq-buffer) - (when (setq gnus-faq-buffer - (gnus-group-fetch-faq gnus-newsgroup-name faq-dir)) - (gnus-configure-windows 'summary-faq)))) - -;; Suggested by Per Abrahamsen . -(defun gnus-summary-describe-group (&optional force) - "Describe the current newsgroup." - (interactive "P") - (gnus-group-describe-group force gnus-newsgroup-name)) - -(defun gnus-summary-describe-briefly () - "Describe summary mode commands briefly." - (interactive) - (gnus-message 6 (substitute-command-keys "\\\\[gnus-summary-next-page]:Select \\[gnus-summary-next-unread-article]:Forward \\[gnus-summary-prev-unread-article]:Backward \\[gnus-summary-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-summary-describe-briefly]:This help"))) - -;; Walking around group mode buffer from summary mode. - -(defun gnus-summary-next-group (&optional no-article target-group backward) - "Exit current newsgroup and then select next unread newsgroup. -If prefix argument NO-ARTICLE is non-nil, no article is selected -initially. If TARGET-GROUP, go to this group. If BACKWARD, go to -previous group instead." - (interactive "P") - ;; Stop pre-fetching. - (gnus-async-halt-prefetch) - (let ((current-group gnus-newsgroup-name) - (current-buffer (current-buffer)) - entered) - ;; First we semi-exit this group to update Xrefs and all variables. - ;; We can't do a real exit, because the window conf must remain - ;; the same in case the user is prompted for info, and we don't - ;; want the window conf to change before that... - (gnus-summary-exit t) - (while (not entered) - ;; Then we find what group we are supposed to enter. - (set-buffer gnus-group-buffer) - (gnus-group-jump-to-group current-group) - (setq target-group - (or target-group - (if (eq gnus-keep-same-level 'best) - (gnus-summary-best-group gnus-newsgroup-name) - (gnus-summary-search-group backward gnus-keep-same-level)))) - (if (not target-group) - ;; There are no further groups, so we return to the group - ;; buffer. - (progn - (gnus-message 5 "Returning to the group buffer") - (setq entered t) - (when (gnus-buffer-live-p current-buffer) - (set-buffer current-buffer) - (gnus-summary-exit)) - (gnus-run-hooks 'gnus-group-no-more-groups-hook)) - ;; We try to enter the target group. - (gnus-group-jump-to-group target-group) - (let ((unreads (gnus-group-group-unread))) - (if (and (or (eq t unreads) - (and unreads (not (zerop unreads)))) - (gnus-summary-read-group - target-group nil no-article - (and (buffer-name current-buffer) current-buffer) - nil backward)) - (setq entered t) - (setq current-group target-group - target-group nil))))))) - -(defun gnus-summary-prev-group (&optional no-article) - "Exit current newsgroup and then select previous unread newsgroup. -If prefix argument NO-ARTICLE is non-nil, no article is selected initially." - (interactive "P") - (gnus-summary-next-group no-article nil t)) - -;; Walking around summary lines. - -(defun gnus-summary-first-subject (&optional unread undownloaded unseen) - "Go to the first subject satisfying any non-nil constraint. -If UNREAD is non-nil, the article should be unread. -If UNDOWNLOADED is non-nil, the article should be undownloaded. -If UNSEEN is non-nil, the article should be unseen. -Returns the article selected or nil if there are no matching articles." - (interactive "P") - (cond - ;; Empty summary. - ((null gnus-newsgroup-data) - (gnus-message 3 "No articles in the group") - nil) - ;; Pick the first article. - ((not (or unread undownloaded unseen)) - (goto-char (gnus-data-pos (car gnus-newsgroup-data))) - (gnus-data-number (car gnus-newsgroup-data))) - ;; Find the first unread article. - (t - (let ((data gnus-newsgroup-data)) - (while (and data - (let ((num (gnus-data-number (car data)))) - (or (memq num gnus-newsgroup-unfetched) - (not (or (and unread - (memq num gnus-newsgroup-unreads)) - (and undownloaded - (memq num gnus-newsgroup-undownloaded)) - (and unseen - (memq num gnus-newsgroup-unseen))))))) - (setq data (cdr data))) - (prog1 - (if data - (progn - (goto-char (gnus-data-pos (car data))) - (gnus-data-number (car data))) - (gnus-message 3 "No more%s articles" - (let* ((r (when unread " unread")) - (d (when undownloaded " undownloaded")) - (s (when unseen " unseen")) - (l (delq nil (list r d s)))) - (cond ((= 3 (length l)) - (concat r "," d ", or" s)) - ((= 2 (length l)) - (concat (car l) ", or" (cadr l))) - ((= 1 (length l)) - (car l)) - (t - "")))) - nil - ) - (gnus-summary-position-point)))))) - -(defun gnus-summary-next-subject (n &optional unread dont-display) - "Go to next N'th summary line. -If N is negative, go to the previous N'th subject line. -If UNREAD is non-nil, only unread articles are selected. -The difference between N and the actual number of steps taken is -returned." - (interactive "p") - (let ((backward (< n 0)) - (n (abs n))) - (while (and (> n 0) - (if backward - (gnus-summary-find-prev unread) - (gnus-summary-find-next unread))) - (unless (zerop (setq n (1- n))) - (gnus-summary-show-thread))) - (when (/= 0 n) - (gnus-message 7 "No more%s articles" - (if unread " unread" ""))) - (unless dont-display - (gnus-summary-recenter) - (gnus-summary-position-point)) - n)) - -(defun gnus-summary-next-unread-subject (n) - "Go to next N'th unread summary line." - (interactive "p") - (gnus-summary-next-subject n t)) - -(defun gnus-summary-prev-subject (n &optional unread) - "Go to previous N'th summary line. -If optional argument UNREAD is non-nil, only unread article is selected." - (interactive "p") - (gnus-summary-next-subject (- n) unread)) - -(defun gnus-summary-prev-unread-subject (n) - "Go to previous N'th unread summary line." - (interactive "p") - (gnus-summary-next-subject (- n) t)) - -(defun gnus-summary-goto-subjects (articles) - "Insert the subject header for ARTICLES in the current buffer." - (save-excursion - (dolist (article articles) - (gnus-summary-goto-subject article t))) - (gnus-summary-limit (append articles gnus-newsgroup-limit)) - (gnus-summary-position-point)) - -(defun gnus-summary-goto-subject (article &optional force silent) - "Go the subject line of ARTICLE. -If FORCE, also allow jumping to articles not currently shown." - (interactive "nArticle number: ") - (unless (numberp article) - (error "Article %s is not a number" article)) - (let ((b (point)) - (data (gnus-data-find article))) - ;; We read in the article if we have to. - (and (not data) - force - (gnus-summary-insert-subject - article - (if (or (numberp force) (vectorp force)) force) - t) - (setq data (gnus-data-find article))) - (goto-char b) - (if (not data) - (progn - (unless silent - (gnus-message 3 "Can't find article %d" article)) - nil) - (let ((pt (gnus-data-pos data))) - (goto-char pt) - (gnus-summary-set-article-display-arrow pt)) - (gnus-summary-position-point) - article))) - -;; Walking around summary lines with displaying articles. - -(defun gnus-summary-expand-window (&optional arg) - "Make the summary buffer take up the entire Emacs frame. -Given a prefix, will force an `article' buffer configuration." - (interactive "P") - (if arg - (gnus-configure-windows 'article 'force) - (gnus-configure-windows 'summary 'force))) - -(defun gnus-summary-display-article (article &optional all-header) - "Display ARTICLE in article buffer." - (when (gnus-buffer-live-p gnus-article-buffer) - (with-current-buffer gnus-article-buffer - (mm-enable-multibyte))) - (gnus-set-global-variables) - (when (gnus-buffer-live-p gnus-article-buffer) - (with-current-buffer gnus-article-buffer - (setq gnus-article-charset gnus-newsgroup-charset) - (setq gnus-article-ignored-charsets gnus-newsgroup-ignored-charsets) - (mm-enable-multibyte))) - (if (null article) - nil - (prog1 - (if gnus-summary-display-article-function - (funcall gnus-summary-display-article-function article all-header) - (gnus-article-prepare article all-header)) - (gnus-run-hooks 'gnus-select-article-hook) - (when (and gnus-current-article - (not (zerop gnus-current-article))) - (gnus-summary-goto-subject gnus-current-article)) - (gnus-summary-recenter) - (when (and gnus-use-trees gnus-show-threads) - (gnus-possibly-generate-tree article) - (gnus-highlight-selected-tree article)) - ;; Successfully display article. - (gnus-article-set-window-start - (cdr (assq article gnus-newsgroup-bookmarks)))))) - -(defun gnus-summary-select-article (&optional all-headers force pseudo article) - "Select the current article. -If ALL-HEADERS is non-nil, show all header fields. If FORCE is -non-nil, the article will be re-fetched even if it already present in -the article buffer. If PSEUDO is non-nil, pseudo-articles will also -be displayed." - ;; Make sure we are in the summary buffer to work around bbdb bug. - (unless (eq major-mode 'gnus-summary-mode) - (set-buffer gnus-summary-buffer)) - (let ((article (or article (gnus-summary-article-number))) - (all-headers (not (not all-headers))) ;Must be t or nil. - gnus-summary-display-article-function) - (and (not pseudo) - (gnus-summary-article-pseudo-p article) - (error "This is a pseudo-article")) - (save-excursion - (set-buffer gnus-summary-buffer) - (if (or (and gnus-single-article-buffer - (or (null gnus-current-article) - (null gnus-article-current) - (null (get-buffer gnus-article-buffer)) - (not (eq article (cdr gnus-article-current))) - (not (equal (car gnus-article-current) - gnus-newsgroup-name)))) - (and (not gnus-single-article-buffer) - (or (null gnus-current-article) - (not (eq gnus-current-article article)))) - force) - ;; The requested article is different from the current article. - (progn - (gnus-summary-display-article article all-headers) - (when (gnus-buffer-live-p gnus-article-buffer) - (with-current-buffer gnus-article-buffer - (if (not gnus-article-decoded-p) ;; a local variable - (mm-disable-multibyte)))) - (gnus-article-set-window-start - (cdr (assq article gnus-newsgroup-bookmarks))) - article) - 'old)))) - -(defun gnus-summary-force-verify-and-decrypt () - "Display buttons for signed/encrypted parts and verify/decrypt them." - (interactive) - (let ((mm-verify-option 'known) - (mm-decrypt-option 'known) - (gnus-article-emulate-mime t) - (gnus-buttonized-mime-types (append (list "multipart/signed" - "multipart/encrypted") - gnus-buttonized-mime-types))) - (gnus-summary-select-article nil 'force))) - -(defun gnus-summary-set-current-mark (&optional current-mark) - "Obsolete function." - nil) - -(defun gnus-summary-next-article (&optional unread subject backward push) - "Select the next article. -If UNREAD, only unread articles are selected. -If SUBJECT, only articles with SUBJECT are selected. -If BACKWARD, the previous article is selected instead of the next." - (interactive "P") - ;; Make sure we are in the summary buffer. - (unless (eq major-mode 'gnus-summary-mode) - (set-buffer gnus-summary-buffer)) - (cond - ;; Is there such an article? - ((and (gnus-summary-search-forward unread subject backward) - (or (gnus-summary-display-article (gnus-summary-article-number)) - (eq (gnus-summary-article-mark) gnus-canceled-mark))) - (gnus-summary-position-point)) - ;; If not, we try the first unread, if that is wanted. - ((and subject - gnus-auto-select-same - (gnus-summary-first-unread-article)) - (gnus-summary-position-point) - (gnus-message 6 "Wrapped")) - ;; Try to get next/previous article not displayed in this group. - ((and gnus-auto-extend-newsgroup - (not unread) (not subject)) - (gnus-summary-goto-article - (if backward (1- gnus-newsgroup-begin) (1+ gnus-newsgroup-end)) - nil (count-lines (point-min) (point)))) - ;; Go to next/previous group. - (t - (unless (gnus-ephemeral-group-p gnus-newsgroup-name) - (gnus-summary-jump-to-group gnus-newsgroup-name)) - (let ((cmd last-command-char) - (point - (save-excursion - (set-buffer gnus-group-buffer) - (point))) - (group - (if (eq gnus-keep-same-level 'best) - (gnus-summary-best-group gnus-newsgroup-name) - (gnus-summary-search-group backward gnus-keep-same-level)))) - ;; For some reason, the group window gets selected. We change - ;; it back. - (select-window (get-buffer-window (current-buffer))) - ;; Select next unread newsgroup automagically. - (cond - ((or (not gnus-auto-select-next) - (not cmd)) - (gnus-message 7 "No more%s articles" (if unread " unread" ""))) - ((or (eq gnus-auto-select-next 'quietly) - (and (eq gnus-auto-select-next 'slightly-quietly) - push) - (and (eq gnus-auto-select-next 'almost-quietly) - (gnus-summary-last-article-p))) - ;; Select quietly. - (if (gnus-ephemeral-group-p gnus-newsgroup-name) - (gnus-summary-exit) - (gnus-message 7 "No more%s articles (%s)..." - (if unread " unread" "") - (if group (concat "selecting " group) - "exiting")) - (gnus-summary-next-group nil group backward))) - (t - (when (gnus-key-press-event-p last-input-event) - (gnus-summary-walk-group-buffer - gnus-newsgroup-name cmd unread backward point)))))))) - -(defun gnus-summary-walk-group-buffer (from-group cmd unread backward start) - (let ((keystrokes '((?\C-n (gnus-group-next-unread-group 1)) - (?\C-p (gnus-group-prev-unread-group 1)))) - (cursor-in-echo-area t) - keve key group ended prompt) - (save-excursion - (set-buffer gnus-group-buffer) - (goto-char start) - (setq group - (if (eq gnus-keep-same-level 'best) - (gnus-summary-best-group gnus-newsgroup-name) - (gnus-summary-search-group backward gnus-keep-same-level)))) - (while (not ended) - (setq prompt - (format - "No more%s articles%s " (if unread " unread" "") - (if (and group - (not (gnus-ephemeral-group-p gnus-newsgroup-name))) - (format " (Type %s for %s [%s])" - (single-key-description cmd) - (gnus-group-decoded-name group) - (car (gnus-gethash group gnus-newsrc-hashtb))) - (format " (Type %s to exit %s)" - (single-key-description cmd) - (gnus-group-decoded-name gnus-newsgroup-name))))) - ;; Confirm auto selection. - (setq key (car (setq keve (gnus-read-event-char prompt))) - ended t) - (cond - ((assq key keystrokes) - (let ((obuf (current-buffer))) - (switch-to-buffer gnus-group-buffer) - (when group - (gnus-group-jump-to-group group)) - (eval (cadr (assq key keystrokes))) - (setq group (gnus-group-group-name)) - (switch-to-buffer obuf)) - (setq ended nil)) - ((equal key cmd) - (if (or (not group) - (gnus-ephemeral-group-p gnus-newsgroup-name)) - (gnus-summary-exit) - (gnus-summary-next-group nil group backward))) - (t - (push (cdr keve) unread-command-events)))))) - -(defun gnus-summary-next-unread-article () - "Select unread article after current one." - (interactive) - (gnus-summary-next-article - (or (not (eq gnus-summary-goto-unread 'never)) - (gnus-summary-last-article-p (gnus-summary-article-number))) - (and gnus-auto-select-same - (gnus-summary-article-subject)))) - -(defun gnus-summary-prev-article (&optional unread subject) - "Select the article before the current one. -If UNREAD is non-nil, only unread articles are selected." - (interactive "P") - (gnus-summary-next-article unread subject t)) - -(defun gnus-summary-prev-unread-article () - "Select unread article before current one." - (interactive) - (gnus-summary-prev-article - (or (not (eq gnus-summary-goto-unread 'never)) - (gnus-summary-first-article-p (gnus-summary-article-number))) - (and gnus-auto-select-same - (gnus-summary-article-subject)))) - -(defun gnus-summary-next-page (&optional lines circular stop) - "Show next page of the selected article. -If at the end of the current article, select the next article. -LINES says how many lines should be scrolled up. - -If CIRCULAR is non-nil, go to the start of the article instead of -selecting the next article when reaching the end of the current -article. - -If STOP is non-nil, just stop when reaching the end of the message. - -Also see the variable `gnus-article-skip-boring'." - (interactive "P") - (setq gnus-summary-buffer (current-buffer)) - (gnus-set-global-variables) - (let ((article (gnus-summary-article-number)) - (article-window (get-buffer-window gnus-article-buffer t)) - endp) - ;; If the buffer is empty, we have no article. - (unless article - (error "No article to select")) - (gnus-configure-windows 'article) - (if (eq (cdr (assq article gnus-newsgroup-reads)) gnus-canceled-mark) - (if (and (eq gnus-summary-goto-unread 'never) - (not (gnus-summary-last-article-p article))) - (gnus-summary-next-article) - (gnus-summary-next-unread-article)) - (if (or (null gnus-current-article) - (null gnus-article-current) - (/= article (cdr gnus-article-current)) - (not (equal (car gnus-article-current) gnus-newsgroup-name))) - ;; Selected subject is different from current article's. - (gnus-summary-display-article article) - (when article-window - (gnus-eval-in-buffer-window gnus-article-buffer - (setq endp (or (gnus-article-next-page lines) - (gnus-article-only-boring-p)))) - (when endp - (cond (stop - (gnus-message 3 "End of message")) - (circular - (gnus-summary-beginning-of-article)) - (lines - (gnus-message 3 "End of message")) - ((null lines) - (if (and (eq gnus-summary-goto-unread 'never) - (not (gnus-summary-last-article-p article))) - (gnus-summary-next-article) - (gnus-summary-next-unread-article)))))))) - (gnus-summary-recenter) - (gnus-summary-position-point))) - -(defun gnus-summary-prev-page (&optional lines move) - "Show previous page of selected article. -Argument LINES specifies lines to be scrolled down. -If MOVE, move to the previous unread article if point is at -the beginning of the buffer." - (interactive "P") - (let ((article (gnus-summary-article-number)) - (article-window (get-buffer-window gnus-article-buffer t)) - endp) - (gnus-configure-windows 'article) - (if (or (null gnus-current-article) - (null gnus-article-current) - (/= article (cdr gnus-article-current)) - (not (equal (car gnus-article-current) gnus-newsgroup-name))) - ;; Selected subject is different from current article's. - (gnus-summary-display-article article) - (gnus-summary-recenter) - (when article-window - (gnus-eval-in-buffer-window gnus-article-buffer - (setq endp (gnus-article-prev-page lines))) - (when (and move endp) - (cond (lines - (gnus-message 3 "Beginning of message")) - ((null lines) - (if (and (eq gnus-summary-goto-unread 'never) - (not (gnus-summary-first-article-p article))) - (gnus-summary-prev-article) - (gnus-summary-prev-unread-article)))))))) - (gnus-summary-position-point)) - -(defun gnus-summary-prev-page-or-article (&optional lines) - "Show previous page of selected article. -Argument LINES specifies lines to be scrolled down. -If at the beginning of the article, go to the next article." - (interactive "P") - (gnus-summary-prev-page lines t)) - -(defun gnus-summary-scroll-up (lines) - "Scroll up (or down) one line current article. -Argument LINES specifies lines to be scrolled up (or down if negative)." - (interactive "p") - (gnus-configure-windows 'article) - (gnus-summary-show-thread) - (when (eq (gnus-summary-select-article nil nil 'pseudo) 'old) - (gnus-eval-in-buffer-window gnus-article-buffer - (cond ((> lines 0) - (when (gnus-article-next-page lines) - (gnus-message 3 "End of message"))) - ((< lines 0) - (gnus-article-prev-page (- lines)))))) - (gnus-summary-recenter) - (gnus-summary-position-point)) - -(defun gnus-summary-scroll-down (lines) - "Scroll down (or up) one line current article. -Argument LINES specifies lines to be scrolled down (or up if negative)." - (interactive "p") - (gnus-summary-scroll-up (- lines))) - -(defun gnus-summary-next-same-subject () - "Select next article which has the same subject as current one." - (interactive) - (gnus-summary-next-article nil (gnus-summary-article-subject))) - -(defun gnus-summary-prev-same-subject () - "Select previous article which has the same subject as current one." - (interactive) - (gnus-summary-prev-article nil (gnus-summary-article-subject))) - -(defun gnus-summary-next-unread-same-subject () - "Select next unread article which has the same subject as current one." - (interactive) - (gnus-summary-next-article t (gnus-summary-article-subject))) - -(defun gnus-summary-prev-unread-same-subject () - "Select previous unread article which has the same subject as current one." - (interactive) - (gnus-summary-prev-article t (gnus-summary-article-subject))) - -(defun gnus-summary-first-unread-article () - "Select the first unread article. -Return nil if there are no unread articles." - (interactive) - (prog1 - (when (gnus-summary-first-subject t) - (gnus-summary-show-thread) - (gnus-summary-first-subject t) - (gnus-summary-display-article (gnus-summary-article-number))) - (gnus-summary-position-point))) - -(defun gnus-summary-first-unread-subject () - "Place the point on the subject line of the first unread article. -Return nil if there are no unread articles." - (interactive) - (prog1 - (when (gnus-summary-first-subject t) - (gnus-summary-show-thread) - (gnus-summary-first-subject t)) - (gnus-summary-position-point))) - -(defun gnus-summary-first-unseen-subject () - "Place the point on the subject line of the first unseen article. -Return nil if there are no unseen articles." - (interactive) - (prog1 - (when (gnus-summary-first-subject nil nil t) - (gnus-summary-show-thread) - (gnus-summary-first-subject nil nil t)) - (gnus-summary-position-point))) - -(defun gnus-summary-first-unseen-or-unread-subject () - "Place the point on the subject line of the first unseen article or, -if all article have been seen, on the subject line of the first unread -article." - (interactive) - (prog1 - (unless (when (gnus-summary-first-subject nil nil t) - (gnus-summary-show-thread) - (gnus-summary-first-subject nil nil t)) - (when (gnus-summary-first-subject t) - (gnus-summary-show-thread) - (gnus-summary-first-subject t))) - (gnus-summary-position-point))) - -(defun gnus-summary-first-article () - "Select the first article. -Return nil if there are no articles." - (interactive) - (prog1 - (when (gnus-summary-first-subject) - (gnus-summary-show-thread) - (gnus-summary-first-subject) - (gnus-summary-display-article (gnus-summary-article-number))) - (gnus-summary-position-point))) - -(defun gnus-summary-best-unread-article (&optional arg) - "Select the unread article with the highest score. -If given a prefix argument, select the next unread article that has a -score higher than the default score." - (interactive "P") - (let ((article (if arg - (gnus-summary-better-unread-subject) - (gnus-summary-best-unread-subject)))) - (if article - (gnus-summary-goto-article article) - (error "No unread articles")))) - -(defun gnus-summary-best-unread-subject () - "Select the unread subject with the highest score." - (interactive) - (let ((best -1000000) - (data gnus-newsgroup-data) - article score) - (while data - (and (gnus-data-unread-p (car data)) - (> (setq score - (gnus-summary-article-score (gnus-data-number (car data)))) - best) - (setq best score - article (gnus-data-number (car data)))) - (setq data (cdr data))) - (when article - (gnus-summary-goto-subject article)) - (gnus-summary-position-point) - article)) - -(defun gnus-summary-better-unread-subject () - "Select the first unread subject that has a score over the default score." - (interactive) - (let ((data gnus-newsgroup-data) - article score) - (while (and (setq article (gnus-data-number (car data))) - (or (gnus-data-read-p (car data)) - (not (> (gnus-summary-article-score article) - gnus-summary-default-score)))) - (setq data (cdr data))) - (when article - (gnus-summary-goto-subject article)) - (gnus-summary-position-point) - article)) - -(defun gnus-summary-last-subject () - "Go to the last displayed subject line in the group." - (let ((article (gnus-data-number (car (gnus-data-list t))))) - (when article - (gnus-summary-goto-subject article)))) - -(defun gnus-summary-goto-article (article &optional all-headers force) - "Fetch ARTICLE (article number or Message-ID) and display it if it exists. -If ALL-HEADERS is non-nil, no header lines are hidden. -If FORCE, go to the article even if it isn't displayed. If FORCE -is a number, it is the line the article is to be displayed on." - (interactive - (list - (completing-read - "Article number or Message-ID: " - (mapcar (lambda (number) (list (int-to-string number))) - gnus-newsgroup-limit)) - current-prefix-arg - t)) - (prog1 - (if (and (stringp article) - (string-match "@\\|%40" article)) - (gnus-summary-refer-article article) - (when (stringp article) - (setq article (string-to-number article))) - (if (gnus-summary-goto-subject article force) - (gnus-summary-display-article article all-headers) - (gnus-message 4 "Couldn't go to article %s" article) nil)) - (gnus-summary-position-point))) - -(defun gnus-summary-goto-last-article () - "Go to the previously read article." - (interactive) - (prog1 - (when gnus-last-article - (gnus-summary-goto-article gnus-last-article nil t)) - (gnus-summary-position-point))) - -(defun gnus-summary-pop-article (number) - "Pop one article off the history and go to the previous. -NUMBER articles will be popped off." - (interactive "p") - (let (to) - (setq gnus-newsgroup-history - (cdr (setq to (nthcdr number gnus-newsgroup-history)))) - (if to - (gnus-summary-goto-article (car to) nil t) - (error "Article history empty"))) - (gnus-summary-position-point)) - -;; Summary commands and functions for limiting the summary buffer. - -(defun gnus-summary-limit-to-articles (n) - "Limit the summary buffer to the next N articles. -If not given a prefix, use the process marked articles instead." - (interactive "P") - (prog1 - (let ((articles (gnus-summary-work-articles n))) - (setq gnus-newsgroup-processable nil) - (gnus-summary-limit articles)) - (gnus-summary-position-point))) - -(defun gnus-summary-pop-limit (&optional total) - "Restore the previous limit. -If given a prefix, remove all limits." - (interactive "P") - (when total - (setq gnus-newsgroup-limits - (list (mapcar (lambda (h) (mail-header-number h)) - gnus-newsgroup-headers)))) - (unless gnus-newsgroup-limits - (error "No limit to pop")) - (prog1 - (gnus-summary-limit nil 'pop) - (gnus-summary-position-point))) - -(defun gnus-summary-limit-to-subject (subject &optional header not-matching) - "Limit the summary buffer to articles that have subjects that match a regexp. -If NOT-MATCHING, excluding articles that have subjects that match a regexp." - (interactive - (list (read-string (if current-prefix-arg - "Exclude subject (regexp): " - "Limit to subject (regexp): ")) - nil current-prefix-arg)) - (unless header - (setq header "subject")) - (when (not (equal "" subject)) - (prog1 - (let ((articles (gnus-summary-find-matching - (or header "subject") subject 'all nil nil - not-matching))) - (unless articles - (error "Found no matches for \"%s\"" subject)) - (gnus-summary-limit articles)) - (gnus-summary-position-point)))) - -(defun gnus-summary-limit-to-author (from &optional not-matching) - "Limit the summary buffer to articles that have authors that match a regexp. -If NOT-MATCHING, excluding articles that have authors that match a regexp." - (interactive - (list (read-string (if current-prefix-arg - "Exclude author (regexp): " - "Limit to author (regexp): ")) - current-prefix-arg)) - (gnus-summary-limit-to-subject from "from" not-matching)) - -(defun gnus-summary-limit-to-age (age &optional younger-p) - "Limit the summary buffer to articles that are older than (or equal) AGE days. -If YOUNGER-P (the prefix) is non-nil, limit the summary buffer to -articles that are younger than AGE days." - (interactive - (let ((younger current-prefix-arg) - (days-got nil) - days) - (while (not days-got) - (setq days (if younger - (read-string "Limit to articles younger than (in days, older when negative): ") - (read-string - "Limit to articles older than (in days, younger when negative): "))) - (when (> (length days) 0) - (setq days (read days))) - (if (numberp days) - (progn - (setq days-got t) - (if (< days 0) - (progn - (setq younger (not younger)) - (setq days (* days -1))))) - (message "Please enter a number.") - (sleep-for 1))) - (list days younger))) - (prog1 - (let ((data gnus-newsgroup-data) - (cutoff (days-to-time age)) - articles d date is-younger) - (while (setq d (pop data)) - (when (and (vectorp (gnus-data-header d)) - (setq date (mail-header-date (gnus-data-header d)))) - (setq is-younger (time-less-p - (time-since (condition-case () - (date-to-time date) - (error '(0 0)))) - cutoff)) - (when (if younger-p - is-younger - (not is-younger)) - (push (gnus-data-number d) articles)))) - (gnus-summary-limit (nreverse articles))) - (gnus-summary-position-point))) - -(defun gnus-summary-limit-to-extra (header regexp &optional not-matching) - "Limit the summary buffer to articles that match an 'extra' header." - (interactive - (let ((header - (intern - (gnus-completing-read-with-default - (symbol-name (car gnus-extra-headers)) - (if current-prefix-arg - "Exclude extra header" - "Limit extra header") - (mapcar (lambda (x) - (cons (symbol-name x) x)) - gnus-extra-headers) - nil - t)))) - (list header - (read-string (format "%s header %s (regexp): " - (if current-prefix-arg "Exclude" "Limit to") - header)) - current-prefix-arg))) - (when (not (equal "" regexp)) - (prog1 - (let ((articles (gnus-summary-find-matching - (cons 'extra header) regexp 'all nil nil - not-matching))) - (unless articles - (error "Found no matches for \"%s\"" regexp)) - (gnus-summary-limit articles)) - (gnus-summary-position-point)))) - -(defun gnus-summary-limit-to-display-predicate () - "Limit the summary buffer to the predicated in the `display' group parameter." - (interactive) - (unless gnus-newsgroup-display - (error "There is no `display' group parameter")) - (let (articles) - (dolist (number gnus-newsgroup-articles) - (when (funcall gnus-newsgroup-display) - (push number articles))) - (gnus-summary-limit articles)) - (gnus-summary-position-point)) - -(defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread) -(make-obsolete - 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread) - -(defun gnus-summary-limit-to-unread (&optional all) - "Limit the summary buffer to articles that are not marked as read. -If ALL is non-nil, limit strictly to unread articles." - (interactive "P") - (if all - (gnus-summary-limit-to-marks (char-to-string gnus-unread-mark)) - (gnus-summary-limit-to-marks - ;; Concat all the marks that say that an article is read and have - ;; those removed. - (list gnus-del-mark gnus-read-mark gnus-ancient-mark - gnus-killed-mark gnus-spam-mark gnus-kill-file-mark - gnus-low-score-mark gnus-expirable-mark - gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark - gnus-duplicate-mark gnus-souped-mark) - 'reverse))) - -(defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-exclude-marks) -(make-obsolete 'gnus-summary-delete-marked-with - 'gnus-summary-limit-exclude-marks) - -(defun gnus-summary-limit-exclude-marks (marks &optional reverse) - "Exclude articles that are marked with MARKS (e.g. \"DK\"). -If REVERSE, limit the summary buffer to articles that are marked -with MARKS. MARKS can either be a string of marks or a list of marks. -Returns how many articles were removed." - (interactive "sMarks: ") - (gnus-summary-limit-to-marks marks t)) - -(defun gnus-summary-limit-to-marks (marks &optional reverse) - "Limit the summary buffer to articles that are marked with MARKS (e.g. \"DK\"). -If REVERSE (the prefix), limit the summary buffer to articles that are -not marked with MARKS. MARKS can either be a string of marks or a -list of marks. -Returns how many articles were removed." - (interactive "sMarks: \nP") - (prog1 - (let ((data gnus-newsgroup-data) - (marks (if (listp marks) marks - (append marks nil))) ; Transform to list. - articles) - (while data - (when (if reverse (not (memq (gnus-data-mark (car data)) marks)) - (memq (gnus-data-mark (car data)) marks)) - (push (gnus-data-number (car data)) articles)) - (setq data (cdr data))) - (gnus-summary-limit articles)) - (gnus-summary-position-point))) - -(defun gnus-summary-limit-to-score (score) - "Limit to articles with score at or above SCORE." - (interactive "NLimit to articles with score of at least: ") - (let ((data gnus-newsgroup-data) - articles) - (while data - (when (>= (gnus-summary-article-score (gnus-data-number (car data))) - score) - (push (gnus-data-number (car data)) articles)) - (setq data (cdr data))) - (prog1 - (gnus-summary-limit articles) - (gnus-summary-position-point)))) - -(defun gnus-summary-limit-to-unseen () - "Limit to unseen articles." - (interactive) - (prog1 - (gnus-summary-limit gnus-newsgroup-unseen) - (gnus-summary-position-point))) - -(defun gnus-summary-limit-include-thread (id) - "Display all the hidden articles that is in the thread with ID in it. -When called interactively, ID is the Message-ID of the current -article." - (interactive (list (mail-header-id (gnus-summary-article-header)))) - (let ((articles (gnus-articles-in-thread - (gnus-id-to-thread (gnus-root-id id))))) - (prog1 - (gnus-summary-limit (nconc articles gnus-newsgroup-limit)) - (gnus-summary-limit-include-matching-articles - "subject" - (regexp-quote (gnus-simplify-subject-re - (mail-header-subject (gnus-id-to-header id))))) - (gnus-summary-position-point)))) - -(defun gnus-summary-limit-include-matching-articles (header regexp) - "Display all the hidden articles that have HEADERs that match REGEXP." - (interactive (list (read-string "Match on header: ") - (read-string "Regexp: "))) - (let ((articles (gnus-find-matching-articles header regexp))) - (prog1 - (gnus-summary-limit (nconc articles gnus-newsgroup-limit)) - (gnus-summary-position-point)))) - -(defun gnus-summary-insert-dormant-articles () - "Insert all the dormant articles for this group into the current buffer." - (interactive) - (let ((gnus-verbose (max 6 gnus-verbose))) - (if (not gnus-newsgroup-dormant) - (gnus-message 3 "No dormant articles for this group") - (gnus-summary-goto-subjects gnus-newsgroup-dormant)))) - -(defun gnus-summary-limit-include-dormant () - "Display all the hidden articles that are marked as dormant. -Note that this command only works on a subset of the articles currently -fetched for this group." - (interactive) - (unless gnus-newsgroup-dormant - (error "There are no dormant articles in this group")) - (prog1 - (gnus-summary-limit (append gnus-newsgroup-dormant gnus-newsgroup-limit)) - (gnus-summary-position-point))) - -(defun gnus-summary-limit-exclude-dormant () - "Hide all dormant articles." - (interactive) - (prog1 - (gnus-summary-limit-to-marks (list gnus-dormant-mark) 'reverse) - (gnus-summary-position-point))) - -(defun gnus-summary-limit-exclude-childless-dormant () - "Hide all dormant articles that have no children." - (interactive) - (let ((data (gnus-data-list t)) - articles d children) - ;; Find all articles that are either not dormant or have - ;; children. - (while (setq d (pop data)) - (when (or (not (= (gnus-data-mark d) gnus-dormant-mark)) - (and (setq children - (gnus-article-children (gnus-data-number d))) - (let (found) - (while children - (when (memq (car children) articles) - (setq children nil - found t)) - (pop children)) - found))) - (push (gnus-data-number d) articles))) - ;; Do the limiting. - (prog1 - (gnus-summary-limit articles) - (gnus-summary-position-point)))) - -(defun gnus-summary-limit-mark-excluded-as-read (&optional all) - "Mark all unread excluded articles as read. -If ALL, mark even excluded ticked and dormants as read." - (interactive "P") - (setq gnus-newsgroup-limit (sort gnus-newsgroup-limit '<)) - (let ((articles (gnus-sorted-ndifference - (sort - (mapcar (lambda (h) (mail-header-number h)) - gnus-newsgroup-headers) - '<) - gnus-newsgroup-limit)) - article) - (setq gnus-newsgroup-unreads - (gnus-sorted-intersection gnus-newsgroup-unreads - gnus-newsgroup-limit)) - (if all - (setq gnus-newsgroup-dormant nil - gnus-newsgroup-marked nil - gnus-newsgroup-reads - (nconc - (mapcar (lambda (n) (cons n gnus-catchup-mark)) articles) - gnus-newsgroup-reads)) - (while (setq article (pop articles)) - (unless (or (memq article gnus-newsgroup-dormant) - (memq article gnus-newsgroup-marked)) - (push (cons article gnus-catchup-mark) gnus-newsgroup-reads)))))) - -(defun gnus-summary-limit (articles &optional pop) - (if pop - ;; We pop the previous limit off the stack and use that. - (setq articles (car gnus-newsgroup-limits) - gnus-newsgroup-limits (cdr gnus-newsgroup-limits)) - ;; We use the new limit, so we push the old limit on the stack. - (push gnus-newsgroup-limit gnus-newsgroup-limits)) - ;; Set the limit. - (setq gnus-newsgroup-limit articles) - (let ((total (length gnus-newsgroup-data)) - (data (gnus-data-find-list (gnus-summary-article-number))) - (gnus-summary-mark-below nil) ; Inhibit this. - found) - ;; This will do all the work of generating the new summary buffer - ;; according to the new limit. - (gnus-summary-prepare) - ;; Hide any threads, possibly. - (gnus-summary-maybe-hide-threads) - ;; Try to return to the article you were at, or one in the - ;; neighborhood. - (when data - ;; We try to find some article after the current one. - (while data - (when (gnus-summary-goto-subject (gnus-data-number (car data)) nil t) - (setq data nil - found t)) - (setq data (cdr data)))) - (unless found - ;; If there is no data, that means that we were after the last - ;; article. The same goes when we can't find any articles - ;; after the current one. - (goto-char (point-max)) - (gnus-summary-find-prev)) - (gnus-set-mode-line 'summary) - ;; We return how many articles were removed from the summary - ;; buffer as a result of the new limit. - (- total (length gnus-newsgroup-data)))) - -(defsubst gnus-invisible-cut-children (threads) - (let ((num 0)) - (while threads - (when (memq (mail-header-number (caar threads)) gnus-newsgroup-limit) - (incf num)) - (pop threads)) - (< num 2))) - -(defsubst gnus-cut-thread (thread) - "Go forwards in the thread until we find an article that we want to display." - (when (or (eq gnus-fetch-old-headers 'some) - (eq gnus-fetch-old-headers 'invisible) - (numberp gnus-fetch-old-headers) - (eq gnus-build-sparse-threads 'some) - (eq gnus-build-sparse-threads 'more)) - ;; Deal with old-fetched headers and sparse threads. - (while (and - thread - (or - (gnus-summary-article-sparse-p (mail-header-number (car thread))) - (gnus-summary-article-ancient-p - (mail-header-number (car thread)))) - (if (or (<= (length (cdr thread)) 1) - (eq gnus-fetch-old-headers 'invisible)) - (setq gnus-newsgroup-limit - (delq (mail-header-number (car thread)) - gnus-newsgroup-limit) - thread (cadr thread)) - (when (gnus-invisible-cut-children (cdr thread)) - (let ((th (cdr thread))) - (while th - (if (memq (mail-header-number (caar th)) - gnus-newsgroup-limit) - (setq thread (car th) - th nil) - (setq th (cdr th)))))))))) - thread) - -(defun gnus-cut-threads (threads) - "Cut off all uninteresting articles from the beginning of THREADS." - (when (or (eq gnus-fetch-old-headers 'some) - (eq gnus-fetch-old-headers 'invisible) - (numberp gnus-fetch-old-headers) - (eq gnus-build-sparse-threads 'some) - (eq gnus-build-sparse-threads 'more)) - (let ((th threads)) - (while th - (setcar th (gnus-cut-thread (car th))) - (setq th (cdr th))))) - ;; Remove nixed out threads. - (delq nil threads)) - -(defun gnus-summary-initial-limit (&optional show-if-empty) - "Figure out what the initial limit is supposed to be on group entry. -This entails weeding out unwanted dormants, low-scored articles, -fetch-old-headers verbiage, and so on." - ;; Most groups have nothing to remove. - (if (or gnus-inhibit-limiting - (and (null gnus-newsgroup-dormant) - (eq gnus-newsgroup-display 'gnus-not-ignore) - (not (eq gnus-fetch-old-headers 'some)) - (not (numberp gnus-fetch-old-headers)) - (not (eq gnus-fetch-old-headers 'invisible)) - (null gnus-summary-expunge-below) - (not (eq gnus-build-sparse-threads 'some)) - (not (eq gnus-build-sparse-threads 'more)) - (null gnus-thread-expunge-below) - (not gnus-use-nocem))) - () ; Do nothing. - (push gnus-newsgroup-limit gnus-newsgroup-limits) - (setq gnus-newsgroup-limit nil) - (mapatoms - (lambda (node) - (unless (car (symbol-value node)) - ;; These threads have no parents -- they are roots. - (let ((nodes (cdr (symbol-value node))) - thread) - (while nodes - (if (and gnus-thread-expunge-below - (< (gnus-thread-total-score (car nodes)) - gnus-thread-expunge-below)) - (gnus-expunge-thread (pop nodes)) - (setq thread (pop nodes)) - (gnus-summary-limit-children thread)))))) - gnus-newsgroup-dependencies) - ;; If this limitation resulted in an empty group, we might - ;; pop the previous limit and use it instead. - (when (and (not gnus-newsgroup-limit) - show-if-empty) - (setq gnus-newsgroup-limit (pop gnus-newsgroup-limits))) - gnus-newsgroup-limit)) - -(defun gnus-summary-limit-children (thread) - "Return 1 if this subthread is visible and 0 if it is not." - ;; First we get the number of visible children to this thread. This - ;; is done by recursing down the thread using this function, so this - ;; will really go down to a leaf article first, before slowly - ;; working its way up towards the root. - (when thread - (let* ((max-lisp-eval-depth (max 5000 max-lisp-eval-depth)) - (children - (if (cdr thread) - (apply '+ (mapcar 'gnus-summary-limit-children - (cdr thread))) - 0)) - (number (mail-header-number (car thread))) - score) - (if (and - (not (memq number gnus-newsgroup-marked)) - (or - ;; If this article is dormant and has absolutely no visible - ;; children, then this article isn't visible. - (and (memq number gnus-newsgroup-dormant) - (zerop children)) - ;; If this is "fetch-old-headered" and there is no - ;; visible children, then we don't want this article. - (and (or (eq gnus-fetch-old-headers 'some) - (numberp gnus-fetch-old-headers)) - (gnus-summary-article-ancient-p number) - (zerop children)) - ;; If this is "fetch-old-headered" and `invisible', then - ;; we don't want this article. - (and (eq gnus-fetch-old-headers 'invisible) - (gnus-summary-article-ancient-p number)) - ;; If this is a sparsely inserted article with no children, - ;; we don't want it. - (and (eq gnus-build-sparse-threads 'some) - (gnus-summary-article-sparse-p number) - (zerop children)) - ;; If we use expunging, and this article is really - ;; low-scored, then we don't want this article. - (when (and gnus-summary-expunge-below - (< (setq score - (or (cdr (assq number gnus-newsgroup-scored)) - gnus-summary-default-score)) - gnus-summary-expunge-below)) - ;; We increase the expunge-tally here, but that has - ;; nothing to do with the limits, really. - (incf gnus-newsgroup-expunged-tally) - ;; We also mark as read here, if that's wanted. - (when (and gnus-summary-mark-below - (< score gnus-summary-mark-below)) - (setq gnus-newsgroup-unreads - (delq number gnus-newsgroup-unreads)) - (if gnus-newsgroup-auto-expire - (push number gnus-newsgroup-expirable) - (push (cons number gnus-low-score-mark) - gnus-newsgroup-reads))) - t) - ;; Do the `display' group parameter. - (and gnus-newsgroup-display - (not (funcall gnus-newsgroup-display))) - ;; Check NoCeM things. - (if (and gnus-use-nocem - (gnus-nocem-unwanted-article-p - (mail-header-id (car thread)))) - (progn - (setq gnus-newsgroup-unreads - (delq number gnus-newsgroup-unreads)) - t)))) - ;; Nope, invisible article. - 0 - ;; Ok, this article is to be visible, so we add it to the limit - ;; and return 1. - (push number gnus-newsgroup-limit) - 1)))) - -(defun gnus-expunge-thread (thread) - "Mark all articles in THREAD as read." - (let* ((number (mail-header-number (car thread)))) - (incf gnus-newsgroup-expunged-tally) - ;; We also mark as read here, if that's wanted. - (setq gnus-newsgroup-unreads - (delq number gnus-newsgroup-unreads)) - (if gnus-newsgroup-auto-expire - (push number gnus-newsgroup-expirable) - (push (cons number gnus-low-score-mark) - gnus-newsgroup-reads))) - ;; Go recursively through all subthreads. - (mapcar 'gnus-expunge-thread (cdr thread))) - -;; Summary article oriented commands - -(defun gnus-summary-refer-parent-article (n) - "Refer parent article N times. -If N is negative, go to ancestor -N instead. -The difference between N and the number of articles fetched is returned." - (interactive "p") - (let ((skip 1) - error header ref) - (when (not (natnump n)) - (setq skip (abs n) - n 1)) - (while (and (> n 0) - (not error)) - (setq header (gnus-summary-article-header)) - (if (and (eq (mail-header-number header) - (cdr gnus-article-current)) - (equal gnus-newsgroup-name - (car gnus-article-current))) - ;; If we try to find the parent of the currently - ;; displayed article, then we take a look at the actual - ;; References header, since this is slightly more - ;; reliable than the References field we got from the - ;; server. - (save-excursion - (set-buffer gnus-original-article-buffer) - (nnheader-narrow-to-headers) - (unless (setq ref (message-fetch-field "references")) - (when (setq ref (message-fetch-field "in-reply-to")) - (setq ref (gnus-extract-message-id-from-in-reply-to ref)))) - (widen)) - (setq ref - ;; It's not the current article, so we take a bet on - ;; the value we got from the server. - (mail-header-references header))) - (if (and ref - (not (equal ref ""))) - (unless (gnus-summary-refer-article (gnus-parent-id ref skip)) - (gnus-message 1 "Couldn't find parent")) - (gnus-message 1 "No references in article %d" - (gnus-summary-article-number)) - (setq error t)) - (decf n)) - (gnus-summary-position-point) - n)) - -(defun gnus-summary-refer-references () - "Fetch all articles mentioned in the References header. -Return the number of articles fetched." - (interactive) - (let ((ref (mail-header-references (gnus-summary-article-header))) - (current (gnus-summary-article-number)) - (n 0)) - (if (or (not ref) - (equal ref "")) - (error "No References in the current article") - ;; For each Message-ID in the References header... - (while (string-match "<[^>]*>" ref) - (incf n) - ;; ... fetch that article. - (gnus-summary-refer-article - (prog1 (match-string 0 ref) - (setq ref (substring ref (match-end 0)))))) - (gnus-summary-goto-subject current) - (gnus-summary-position-point) - n))) - -(defun gnus-summary-refer-thread (&optional limit) - "Fetch all articles in the current thread. -If LIMIT (the numerical prefix), fetch that many old headers instead -of what's specified by the `gnus-refer-thread-limit' variable." - (interactive "P") - (let ((id (mail-header-id (gnus-summary-article-header))) - (limit (if limit (prefix-numeric-value limit) - gnus-refer-thread-limit))) - (unless (eq gnus-fetch-old-headers 'invisible) - (gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name) - ;; Retrieve the headers and read them in. - (if (eq (if (numberp limit) - (gnus-retrieve-headers - (list (min - (+ (mail-header-number - (gnus-summary-article-header)) - limit) - gnus-newsgroup-end)) - gnus-newsgroup-name (* limit 2)) - ;; gnus-refer-thread-limit is t, i.e. fetch _all_ - ;; headers. - (gnus-retrieve-headers (list gnus-newsgroup-end) - gnus-newsgroup-name limit)) - 'nov) - (gnus-build-all-threads) - (error "Can't fetch thread from back ends that don't support NOV")) - (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name)) - (gnus-summary-limit-include-thread id))) - -(defun gnus-summary-refer-article (message-id) - "Fetch an article specified by MESSAGE-ID." - (interactive "sMessage-ID: ") - (when (and (stringp message-id) - (not (zerop (length message-id)))) - (setq message-id (gnus-replace-in-string message-id " " "")) - ;; Construct the correct Message-ID if necessary. - ;; Suggested by tale@pawl.rpi.edu. - (unless (string-match "^<" message-id) - (setq message-id (concat "<" message-id))) - (unless (string-match ">$" message-id) - (setq message-id (concat message-id ">"))) - ;; People often post MIDs from URLs, so unhex it: - (unless (string-match "@" message-id) - (setq message-id (gnus-url-unhex-string message-id))) - (let* ((header (gnus-id-to-header message-id)) - (sparse (and header - (gnus-summary-article-sparse-p - (mail-header-number header)) - (memq (mail-header-number header) - gnus-newsgroup-limit))) - number) - (cond - ;; If the article is present in the buffer we just go to it. - ((and header - (or (not (gnus-summary-article-sparse-p - (mail-header-number header))) - sparse)) - (prog1 - (gnus-summary-goto-article - (mail-header-number header) nil t) - (when sparse - (gnus-summary-update-article (mail-header-number header))))) - (t - ;; We fetch the article. - (catch 'found - (dolist (gnus-override-method (gnus-refer-article-methods)) - (when (and (gnus-check-server gnus-override-method) - ;; Fetch the header, - (setq number (gnus-summary-insert-subject message-id))) - ;; and display the article. - (gnus-summary-select-article nil nil nil number) - (throw 'found t))) - (gnus-message 3 "Couldn't fetch article %s" message-id))))))) - -(defun gnus-refer-article-methods () - "Return a list of referable methods." - (cond - ;; No method, so we default to current and native. - ((null gnus-refer-article-method) - (list gnus-current-select-method gnus-select-method)) - ;; Current. - ((eq 'current gnus-refer-article-method) - (list gnus-current-select-method)) - ;; List of select methods. - ((not (and (symbolp (car gnus-refer-article-method)) - (assq (car gnus-refer-article-method) nnoo-definition-alist))) - (let (out) - (dolist (method gnus-refer-article-method) - (push (if (eq 'current method) - gnus-current-select-method - method) - out)) - (nreverse out))) - ;; One single select method. - (t - (list gnus-refer-article-method)))) - -(defun gnus-summary-edit-parameters () - "Edit the group parameters of the current group." - (interactive) - (gnus-group-edit-group gnus-newsgroup-name 'params)) - -(defun gnus-summary-customize-parameters () - "Customize the group parameters of the current group." - (interactive) - (gnus-group-customize gnus-newsgroup-name)) - -(defun gnus-summary-enter-digest-group (&optional force) - "Enter an nndoc group based on the current article. -If FORCE, force a digest interpretation. If not, try -to guess what the document format is." - (interactive "P") - (let ((conf gnus-current-window-configuration)) - (save-window-excursion - (save-excursion - (let (gnus-article-prepare-hook - gnus-display-mime-function - gnus-break-pages) - (gnus-summary-select-article)))) - (setq gnus-current-window-configuration conf) - (let* ((name (format "%s-%d" - (gnus-group-prefixed-name - gnus-newsgroup-name (list 'nndoc "")) - (save-excursion - (set-buffer gnus-summary-buffer) - gnus-current-article))) - (ogroup gnus-newsgroup-name) - (params (append (gnus-info-params (gnus-get-info ogroup)) - (list (cons 'to-group ogroup)) - (list (cons 'parent-group ogroup)) - (list (cons 'save-article-group ogroup)))) - (case-fold-search t) - (buf (current-buffer)) - dig to-address) - (save-excursion - (set-buffer gnus-original-article-buffer) - ;; Have the digest group inherit the main mail address of - ;; the parent article. - (when (setq to-address (or (gnus-fetch-field "reply-to") - (gnus-fetch-field "from"))) - (setq params - (append - (list (cons 'to-address - (funcall gnus-decode-encoded-address-function - to-address)))))) - (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*")) - (insert-buffer-substring gnus-original-article-buffer) - ;; Remove lines that may lead nndoc to misinterpret the - ;; document type. - (narrow-to-region - (goto-char (point-min)) - (or (search-forward "\n\n" nil t) (point))) - (goto-char (point-min)) - (delete-matching-lines "^Path:\\|^From ") - (widen)) - (unwind-protect - (if (let ((gnus-newsgroup-ephemeral-charset gnus-newsgroup-charset) - (gnus-newsgroup-ephemeral-ignored-charsets - gnus-newsgroup-ignored-charsets)) - (gnus-group-read-ephemeral-group - name `(nndoc ,name (nndoc-address ,(get-buffer dig)) - (nndoc-article-type - ,(if force 'mbox 'guess))) - t nil nil nil - `((adapt-file . ,(gnus-score-file-name gnus-newsgroup-name - "ADAPT"))))) - ;; Make all postings to this group go to the parent group. - (nconc (gnus-info-params (gnus-get-info name)) - params) - ;; Couldn't select this doc group. - (switch-to-buffer buf) - (gnus-set-global-variables) - (gnus-configure-windows 'summary) - (gnus-message 3 "Article couldn't be entered?")) - (kill-buffer dig))))) - -(defun gnus-summary-read-document (n) - "Open a new group based on the current article(s). -This will allow you to read digests and other similar -documents as newsgroups. -Obeys the standard process/prefix convention." - (interactive "P") - (let* ((articles (gnus-summary-work-articles n)) - (ogroup gnus-newsgroup-name) - (params (append (gnus-info-params (gnus-get-info ogroup)) - (list (cons 'to-group ogroup)))) - article group egroup groups vgroup) - (while (setq article (pop articles)) - (setq group (format "%s-%d" gnus-newsgroup-name article)) - (gnus-summary-remove-process-mark article) - (when (gnus-summary-display-article article) - (save-excursion - (with-temp-buffer - (insert-buffer-substring gnus-original-article-buffer) - ;; Remove some headers that may lead nndoc to make - ;; the wrong guess. - (message-narrow-to-head) - (goto-char (point-min)) - (delete-matching-lines "^\\(Path\\):\\|^From ") - (widen) - (if (setq egroup - (gnus-group-read-ephemeral-group - group `(nndoc ,group (nndoc-address ,(current-buffer)) - (nndoc-article-type guess)) - t nil t)) - (progn - ;; Make all postings to this group go to the parent group. - (nconc (gnus-info-params (gnus-get-info egroup)) - params) - (push egroup groups)) - ;; Couldn't select this doc group. - (gnus-error 3 "Article couldn't be entered")))))) - ;; Now we have selected all the documents. - (cond - ((not groups) - (error "None of the articles could be interpreted as documents")) - ((gnus-group-read-ephemeral-group - (setq vgroup (format - "nnvirtual:%s-%s" gnus-newsgroup-name - (format-time-string "%Y%m%dT%H%M%S" (current-time)))) - `(nnvirtual ,vgroup (nnvirtual-component-groups ,groups)) - t - (cons (current-buffer) 'summary))) - (t - (error "Couldn't select virtual nndoc group"))))) - -(defun gnus-summary-isearch-article (&optional regexp-p) - "Do incremental search forward on the current article. -If REGEXP-P (the prefix) is non-nil, do regexp isearch." - (interactive "P") - (gnus-summary-select-article) - (gnus-configure-windows 'article) - (gnus-eval-in-buffer-window gnus-article-buffer - (save-restriction - (widen) - (isearch-forward regexp-p)))) - -(defun gnus-summary-search-article-forward (regexp &optional backward) - "Search for an article containing REGEXP forward. -If BACKWARD, search backward instead." - (interactive - (list (read-string - (format "Search article %s (regexp%s): " - (if current-prefix-arg "backward" "forward") - (if gnus-last-search-regexp - (concat ", default " gnus-last-search-regexp) - ""))) - current-prefix-arg)) - (if (string-equal regexp "") - (setq regexp (or gnus-last-search-regexp "")) - (setq gnus-last-search-regexp regexp) - (setq gnus-article-before-search gnus-current-article)) - ;; Intentionally set gnus-last-article. - (setq gnus-last-article gnus-article-before-search) - (let ((gnus-last-article gnus-last-article)) - (if (gnus-summary-search-article regexp backward) - (gnus-summary-show-thread) - (signal 'search-failed (list regexp))))) - -(defun gnus-summary-search-article-backward (regexp) - "Search for an article containing REGEXP backward." - (interactive - (list (read-string - (format "Search article backward (regexp%s): " - (if gnus-last-search-regexp - (concat ", default " gnus-last-search-regexp) - ""))))) - (gnus-summary-search-article-forward regexp 'backward)) - -(defun gnus-summary-search-article (regexp &optional backward) - "Search for an article containing REGEXP. -Optional argument BACKWARD means do search for backward. -`gnus-select-article-hook' is not called during the search." - ;; We have to require this here to make sure that the following - ;; dynamic binding isn't shadowed by autoloading. - (require 'gnus-async) - (require 'gnus-art) - (let ((gnus-select-article-hook nil) ;Disable hook. - (gnus-article-prepare-hook nil) - (gnus-mark-article-hook nil) ;Inhibit marking as read. - (gnus-use-article-prefetch nil) - (gnus-xmas-force-redisplay nil) ;Inhibit XEmacs redisplay. - (gnus-use-trees nil) ;Inhibit updating tree buffer. - (gnus-visual nil) - (gnus-keep-backlog nil) - (gnus-break-pages nil) - (gnus-summary-display-arrow nil) - (gnus-updated-mode-lines nil) - (gnus-auto-center-summary nil) - (sum (current-buffer)) - (gnus-display-mime-function nil) - (found nil) - point) - (gnus-save-hidden-threads - (gnus-summary-select-article) - (set-buffer gnus-article-buffer) - (goto-char (window-point (get-buffer-window (current-buffer)))) - (when backward - (forward-line -1)) - (while (not found) - (gnus-message 7 "Searching article: %d..." (cdr gnus-article-current)) - (if (if backward - (re-search-backward regexp nil t) - (re-search-forward regexp nil t)) - ;; We found the regexp. - (progn - (setq found 'found) - (beginning-of-line) - (set-window-start - (get-buffer-window (current-buffer)) - (point)) - (forward-line 1) - (set-window-point - (get-buffer-window (current-buffer)) - (point)) - (set-buffer sum) - (setq point (point))) - ;; We didn't find it, so we go to the next article. - (set-buffer sum) - (setq found 'not) - (while (eq found 'not) - (if (not (if backward (gnus-summary-find-prev) - (gnus-summary-find-next))) - ;; No more articles. - (setq found t) - ;; Select the next article and adjust point. - (unless (gnus-summary-article-sparse-p - (gnus-summary-article-number)) - (setq found nil) - (gnus-summary-select-article) - (set-buffer gnus-article-buffer) - (widen) - (goto-char (if backward (point-max) (point-min)))))))) - (gnus-message 7 "")) - ;; Return whether we found the regexp. - (when (eq found 'found) - (goto-char point) - (gnus-summary-show-thread) - (gnus-summary-goto-subject gnus-current-article) - (gnus-summary-position-point) - t))) - -(defun gnus-find-matching-articles (header regexp) - "Return a list of all articles that match REGEXP on HEADER. -This search includes all articles in the current group that Gnus has -fetched headers for, whether they are displayed or not." - (let ((articles nil) - (func `(lambda (h) (,(intern (concat "mail-header-" header)) h))) - (case-fold-search t)) - (dolist (header gnus-newsgroup-headers) - (when (string-match regexp (funcall func header)) - (push (mail-header-number header) articles))) - (nreverse articles))) - -(defun gnus-summary-find-matching (header regexp &optional backward unread - not-case-fold not-matching) - "Return a list of all articles that match REGEXP on HEADER. -The search stars on the current article and goes forwards unless -BACKWARD is non-nil. If BACKWARD is `all', do all articles. -If UNREAD is non-nil, only unread articles will -be taken into consideration. If NOT-CASE-FOLD, case won't be folded -in the comparisons. If NOT-MATCHING, return a list of all articles that -not match REGEXP on HEADER." - (let ((case-fold-search (not not-case-fold)) - articles d func) - (if (consp header) - (if (eq (car header) 'extra) - (setq func - `(lambda (h) - (or (cdr (assq ',(cdr header) (mail-header-extra h))) - ""))) - (error "%s is an invalid header" header)) - (unless (fboundp (intern (concat "mail-header-" header))) - (error "%s is not a valid header" header)) - (setq func `(lambda (h) (,(intern (concat "mail-header-" header)) h)))) - (dolist (d (if (eq backward 'all) - gnus-newsgroup-data - (gnus-data-find-list - (gnus-summary-article-number) - (gnus-data-list backward)))) - (when (and (or (not unread) ; We want all articles... - (gnus-data-unread-p d)) ; Or just unreads. - (vectorp (gnus-data-header d)) ; It's not a pseudo. - (if not-matching - (not (string-match - regexp - (funcall func (gnus-data-header d)))) - (string-match regexp - (funcall func (gnus-data-header d))))) - (push (gnus-data-number d) articles))) ; Success! - (nreverse articles))) - -(defun gnus-summary-execute-command (header regexp command &optional backward) - "Search forward for an article whose HEADER matches REGEXP and execute COMMAND. -If HEADER is an empty string (or nil), the match is done on the entire -article. If BACKWARD (the prefix) is non-nil, search backward instead." - (interactive - (list (let ((completion-ignore-case t)) - (completing-read - "Header name: " - (mapcar (lambda (header) (list (format "%s" header))) - (append - '("Number" "Subject" "From" "Lines" "Date" - "Message-ID" "Xref" "References" "Body") - gnus-extra-headers)) - nil 'require-match)) - (read-string "Regexp: ") - (read-key-sequence "Command: ") - current-prefix-arg)) - (when (equal header "Body") - (setq header "")) - ;; Hidden thread subtrees must be searched as well. - (gnus-summary-show-all-threads) - ;; We don't want to change current point nor window configuration. - (save-excursion - (save-window-excursion - (let (gnus-visual - gnus-treat-strip-trailing-blank-lines - gnus-treat-strip-leading-blank-lines - gnus-treat-strip-multiple-blank-lines - gnus-treat-hide-boring-headers - gnus-treat-fold-newsgroups - gnus-article-prepare-hook) - (gnus-message 6 "Executing %s..." (key-description command)) - ;; We'd like to execute COMMAND interactively so as to give arguments. - (gnus-execute header regexp - `(call-interactively ',(key-binding command)) - backward) - (gnus-message 6 "Executing %s...done" (key-description command)))))) - -(defun gnus-summary-beginning-of-article () - "Scroll the article back to the beginning." - (interactive) - (gnus-summary-select-article) - (gnus-configure-windows 'article) - (gnus-eval-in-buffer-window gnus-article-buffer - (widen) - (goto-char (point-min)) - (when gnus-break-pages - (gnus-narrow-to-page)))) - -(defun gnus-summary-end-of-article () - "Scroll to the end of the article." - (interactive) - (gnus-summary-select-article) - (gnus-configure-windows 'article) - (gnus-eval-in-buffer-window gnus-article-buffer - (widen) - (goto-char (point-max)) - (recenter -3) - (when gnus-break-pages - (gnus-narrow-to-page)))) - -(defun gnus-summary-print-truncate-and-quote (string &optional len) - "Truncate to LEN and quote all \"(\"'s in STRING." - (gnus-replace-in-string (if (and len (> (length string) len)) - (substring string 0 len) - string) - "[()]" "\\\\\\&")) - -(defun gnus-summary-print-article (&optional filename n) - "Generate and print a PostScript image of the process-marked (mail) articles. - -If used interactively, print the current article if none are -process-marked. With prefix arg, prompt the user for the name of the -file to save in. - -When used from Lisp, accept two optional args FILENAME and N. N means -to print the next N articles. If N is negative, print the N previous -articles. If N is nil and articles have been marked with the process -mark, print these instead. - -If the optional first argument FILENAME is nil, send the image to the -printer. If FILENAME is a string, save the PostScript image in a file with -that name. If FILENAME is a number, prompt the user for the name of the file -to save in." - (interactive (list (ps-print-preprint current-prefix-arg))) - (dolist (article (gnus-summary-work-articles n)) - (gnus-summary-select-article nil nil 'pseudo article) - (gnus-eval-in-buffer-window gnus-article-buffer - (gnus-print-buffer)) - (gnus-summary-remove-process-mark article)) - (ps-despool filename)) - -(defun gnus-print-buffer () - (let ((buffer (generate-new-buffer " *print*"))) - (unwind-protect - (progn - (copy-to-buffer buffer (point-min) (point-max)) - (set-buffer buffer) - (gnus-remove-text-with-property 'gnus-decoration) - (when (gnus-visual-p 'article-highlight 'highlight) - ;; Copy-to-buffer doesn't copy overlay. So redo - ;; highlight. - (let ((gnus-article-buffer buffer)) - (gnus-article-highlight-citation t) - (gnus-article-highlight-signature) - (gnus-article-emphasize) - (gnus-article-delete-invisible-text))) - (let ((ps-left-header - (list - (concat "(" - (gnus-summary-print-truncate-and-quote - (mail-header-subject gnus-current-headers) - 66) ")") - (concat "(" - (gnus-summary-print-truncate-and-quote - (mail-header-from gnus-current-headers) - 45) ")"))) - (ps-right-header - (list - "/pagenumberstring load" - (concat "(" - (mail-header-date gnus-current-headers) ")")))) - (gnus-run-hooks 'gnus-ps-print-hook) - (save-excursion - (if ps-print-color-p - (ps-spool-buffer-with-faces) - (ps-spool-buffer))))) - (kill-buffer buffer)))) - -(defun gnus-summary-show-article (&optional arg) - "Force redisplaying of the current article. -If ARG (the prefix) is a number, show the article with the charset -defined in `gnus-summary-show-article-charset-alist', or the charset -input. -If ARG (the prefix) is non-nil and not a number, show the raw article -without any article massaging functions being run. Normally, the key -strokes are `C-u g'." - (interactive "P") - (cond - ((numberp arg) - (gnus-summary-show-article t) - (let ((gnus-newsgroup-charset - (or (cdr (assq arg gnus-summary-show-article-charset-alist)) - (mm-read-coding-system - "View as charset: " ;; actually it is coding system. - (save-excursion - (set-buffer gnus-article-buffer) - (mm-detect-coding-region (point) (point-max)))))) - (gnus-newsgroup-ignored-charsets 'gnus-all)) - (gnus-summary-select-article nil 'force) - (let ((deps gnus-newsgroup-dependencies) - head header lines) - (save-excursion - (set-buffer gnus-original-article-buffer) - (save-restriction - (message-narrow-to-head) - (setq head (buffer-string)) - (goto-char (point-min)) - (unless (re-search-forward "^lines:[ \t]\\([0-9]+\\)" nil t) - (goto-char (point-max)) - (widen) - (setq lines (1- (count-lines (point) (point-max)))))) - (with-temp-buffer - (insert (format "211 %d Article retrieved.\n" - (cdr gnus-article-current))) - (insert head) - (if lines (insert (format "Lines: %d\n" lines))) - (insert ".\n") - (let ((nntp-server-buffer (current-buffer))) - (setq header (car (gnus-get-newsgroup-headers deps t)))))) - (gnus-data-set-header - (gnus-data-find (cdr gnus-article-current)) - header) - (gnus-summary-update-article-line - (cdr gnus-article-current) header) - (when (gnus-summary-goto-subject (cdr gnus-article-current) nil t) - (gnus-summary-update-secondary-mark (cdr gnus-article-current)))))) - ((not arg) - ;; Select the article the normal way. - (gnus-summary-select-article nil 'force)) - (t - ;; We have to require this here to make sure that the following - ;; dynamic binding isn't shadowed by autoloading. - (require 'gnus-async) - (require 'gnus-art) - ;; Bind the article treatment functions to nil. - (let ((gnus-have-all-headers t) - gnus-article-prepare-hook - gnus-article-decode-hook - gnus-display-mime-function - gnus-break-pages) - ;; Destroy any MIME parts. - (when (gnus-buffer-live-p gnus-article-buffer) - (save-excursion - (set-buffer gnus-article-buffer) - (mm-destroy-parts gnus-article-mime-handles) - ;; Set it to nil for safety reason. - (setq gnus-article-mime-handle-alist nil) - (setq gnus-article-mime-handles nil))) - (gnus-summary-select-article nil 'force)))) - (gnus-summary-goto-subject gnus-current-article) - (gnus-summary-position-point)) - -(defun gnus-summary-show-raw-article () - "Show the raw article without any article massaging functions being run." - (interactive) - (gnus-summary-show-article t)) - -(defun gnus-summary-verbose-headers (&optional arg) - "Toggle permanent full header display. -If ARG is a positive number, turn header display on. -If ARG is a negative number, turn header display off." - (interactive "P") - (setq gnus-show-all-headers - (cond ((or (not (numberp arg)) - (zerop arg)) - (not gnus-show-all-headers)) - ((natnump arg) - t))) - (gnus-summary-show-article)) - -(defun gnus-summary-toggle-header (&optional arg) - "Show the headers if they are hidden, or hide them if they are shown. -If ARG is a positive number, show the entire header. -If ARG is a negative number, hide the unwanted header lines." - (interactive "P") - (let ((window (and (gnus-buffer-live-p gnus-article-buffer) - (get-buffer-window gnus-article-buffer t)))) - (with-current-buffer gnus-article-buffer - (widen) - (article-narrow-to-head) - (let* ((buffer-read-only nil) - (inhibit-point-motion-hooks t) - (hidden (if (numberp arg) - (>= arg 0) - (or (not (looking-at "[^ \t\n]+:")) - (gnus-article-hidden-text-p 'headers)))) - s e) - (delete-region (point-min) (point-max)) - (with-current-buffer gnus-original-article-buffer - (goto-char (setq s (point-min))) - (setq e (if (search-forward "\n\n" nil t) - (1- (point)) - (point-max)))) - (insert-buffer-substring gnus-original-article-buffer s e) - (run-hooks 'gnus-article-decode-hook) - (if hidden - (let ((gnus-treat-hide-headers nil) - (gnus-treat-hide-boring-headers nil)) - (gnus-delete-wash-type 'headers) - (gnus-treat-article 'head)) - (gnus-treat-article 'head)) - (widen) - (if window - (set-window-start window (goto-char (point-min)))) - (if gnus-break-pages - (gnus-narrow-to-page) - (when (gnus-visual-p 'page-marker) - (let ((buffer-read-only nil)) - (gnus-remove-text-with-property 'gnus-prev) - (gnus-remove-text-with-property 'gnus-next)))) - (gnus-set-mode-line 'article))))) - -(defun gnus-summary-show-all-headers () - "Make all header lines visible." - (interactive) - (gnus-summary-toggle-header 1)) - -(defun gnus-summary-caesar-message (&optional arg) - "Caesar rotate the current article by 13. -The numerical prefix specifies how many places to rotate each letter -forward." - (interactive "P") - (gnus-summary-select-article) - (let ((mail-header-separator "")) - (gnus-eval-in-buffer-window gnus-article-buffer - (save-restriction - (widen) - (let ((start (window-start)) - buffer-read-only) - (message-caesar-buffer-body arg) - (set-window-start (get-buffer-window (current-buffer)) start))))) - ;; Create buttons and stuff... - (gnus-treat-article nil)) - -(autoload 'unmorse-region "morse" - "Convert morse coded text in region to ordinary ASCII text." - t) - -(defun gnus-summary-morse-message (&optional arg) - "Morse decode the current article." - (interactive "P") - (gnus-summary-select-article) - (let ((mail-header-separator "")) - (gnus-eval-in-buffer-window gnus-article-buffer - (save-excursion - (save-restriction - (widen) - (let ((pos (window-start)) - buffer-read-only) - (goto-char (point-min)) - (when (message-goto-body) - (gnus-narrow-to-body)) - (goto-char (point-min)) - (while (re-search-forward "·" (point-max) t) - (replace-match ".")) - (unmorse-region (point-min) (point-max)) - (widen) - (set-window-start (get-buffer-window (current-buffer)) pos))))))) - -(defun gnus-summary-stop-page-breaking () - "Stop page breaking in the current article." - (interactive) - (gnus-summary-select-article) - (gnus-eval-in-buffer-window gnus-article-buffer - (widen) - (when (gnus-visual-p 'page-marker) - (let ((buffer-read-only nil)) - (gnus-remove-text-with-property 'gnus-prev) - (gnus-remove-text-with-property 'gnus-next)) - (setq gnus-page-broken nil)))) - -(defun gnus-summary-move-article (&optional n to-newsgroup - select-method action) - "Move the current article to a different newsgroup. -If N is a positive number, move the N next articles. -If N is a negative number, move the N previous articles. -If N is nil and any articles have been marked with the process mark, -move those articles instead. -If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. -If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but -re-spool using this method. - -When called interactively with TO-NEWSGROUP being nil, the value of -the variable `gnus-move-split-methods' is used for finding a default -for the target newsgroup. - -For this function to work, both the current newsgroup and the -newsgroup that you want to move to have to support the `request-move' -and `request-accept' functions. - -ACTION can be either `move' (the default), `crosspost' or `copy'." - (interactive "P") - (unless action - (setq action 'move)) - ;; Check whether the source group supports the required functions. - (cond ((and (eq action 'move) - (not (gnus-check-backend-function - 'request-move-article gnus-newsgroup-name))) - (error "The current group does not support article moving")) - ((and (eq action 'crosspost) - (not (gnus-check-backend-function - 'request-replace-article gnus-newsgroup-name))) - (error "The current group does not support article editing"))) - (let ((articles (gnus-summary-work-articles n)) - (prefix (if (gnus-check-backend-function - 'request-move-article gnus-newsgroup-name) - (gnus-group-real-prefix gnus-newsgroup-name) - "")) - (names '((move "Move" "Moving") - (copy "Copy" "Copying") - (crosspost "Crosspost" "Crossposting"))) - (copy-buf (save-excursion - (nnheader-set-temp-buffer " *copy article*"))) - art-group to-method new-xref article to-groups) - (unless (assq action names) - (error "Unknown action %s" action)) - ;; Read the newsgroup name. - (when (and (not to-newsgroup) - (not select-method)) - (if (and gnus-move-split-methods - (not - (and (memq gnus-current-article articles) - (gnus-buffer-live-p gnus-original-article-buffer)))) - ;; When `gnus-move-split-methods' is non-nil, we have to - ;; select an article to give `gnus-read-move-group-name' an - ;; opportunity to suggest an appropriate default. However, - ;; we needn't render or mark the article. - (let ((gnus-display-mime-function nil) - (gnus-article-prepare-hook nil) - (gnus-mark-article-hook nil)) - (gnus-summary-select-article nil nil nil (car articles)))) - (setq to-newsgroup - (gnus-read-move-group-name - (cadr (assq action names)) - (symbol-value (intern (format "gnus-current-%s-group" action))) - articles prefix)) - (set (intern (format "gnus-current-%s-group" action)) to-newsgroup)) - (setq to-method (or select-method - (gnus-server-to-method - (gnus-group-method to-newsgroup)))) - ;; Check the method we are to move this article to... - (unless (gnus-check-backend-function - 'request-accept-article (car to-method)) - (error "%s does not support article copying" (car to-method))) - (unless (gnus-check-server to-method) - (error "Can't open server %s" (car to-method))) - (gnus-message 6 "%s to %s: %s..." - (caddr (assq action names)) - (or (car select-method) to-newsgroup) articles) - (while articles - (setq article (pop articles)) - (setq - art-group - (cond - ;; Move the article. - ((eq action 'move) - ;; Remove this article from future suppression. - (gnus-dup-unsuppress-article article) - (gnus-request-move-article - article ; Article to move - gnus-newsgroup-name ; From newsgroup - (nth 1 (gnus-find-method-for-group - gnus-newsgroup-name)) ; Server - (list 'gnus-request-accept-article - to-newsgroup (list 'quote select-method) - (not articles) t) ; Accept form - (not articles))) ; Only save nov last time - ;; Copy the article. - ((eq action 'copy) - (save-excursion - (set-buffer copy-buf) - (when (gnus-request-article-this-buffer article gnus-newsgroup-name) - (gnus-request-accept-article - to-newsgroup select-method (not articles) t)))) - ;; Crosspost the article. - ((eq action 'crosspost) - (let ((xref (message-tokenize-header - (mail-header-xref (gnus-summary-article-header article)) - " "))) - (setq new-xref (concat (gnus-group-real-name gnus-newsgroup-name) - ":" (number-to-string article))) - (unless xref - (setq xref (list (system-name)))) - (setq new-xref - (concat - (mapconcat 'identity - (delete "Xref:" (delete new-xref xref)) - " ") - " " new-xref)) - (save-excursion - (set-buffer copy-buf) - ;; First put the article in the destination group. - (gnus-request-article-this-buffer article gnus-newsgroup-name) - (when (consp (setq art-group - (gnus-request-accept-article - to-newsgroup select-method (not articles) t))) - (setq new-xref (concat new-xref " " (car art-group) - ":" - (number-to-string (cdr art-group)))) - ;; Now we have the new Xrefs header, so we insert - ;; it and replace the new article. - (nnheader-replace-header "Xref" new-xref) - (gnus-request-replace-article - (cdr art-group) to-newsgroup (current-buffer) t) - art-group)))))) - (cond - ((not art-group) - (gnus-message 1 "Couldn't %s article %s: %s" - (cadr (assq action names)) article - (nnheader-get-report (car to-method)))) - ((eq art-group 'junk) - (when (eq action 'move) - (gnus-summary-mark-article article gnus-canceled-mark) - (gnus-message 4 "Deleted article %s" article) - ;; run the delete hook - (run-hook-with-args 'gnus-summary-article-delete-hook - action - (gnus-data-header - (assoc article (gnus-data-list nil))) - gnus-newsgroup-name nil - select-method))) - (t - (let* ((pto-group (gnus-group-prefixed-name - (car art-group) to-method)) - (entry - (gnus-gethash pto-group gnus-newsrc-hashtb)) - (info (nth 2 entry)) - (to-group (gnus-info-group info)) - to-marks) - ;; Update the group that has been moved to. - (when (and info - (memq action '(move copy))) - (unless (member to-group to-groups) - (push to-group to-groups)) - - (unless (memq article gnus-newsgroup-unreads) - (push 'read to-marks) - (gnus-info-set-read - info (gnus-add-to-range (gnus-info-read info) - (list (cdr art-group))))) - - ;; See whether the article is to be put in the cache. - (let ((marks (if (gnus-group-auto-expirable-p to-group) - gnus-article-mark-lists - (delete '(expirable . expire) - (copy-sequence gnus-article-mark-lists)))) - (to-article (cdr art-group))) - - ;; Enter the article into the cache in the new group, - ;; if that is required. - (when gnus-use-cache - (gnus-cache-possibly-enter-article - to-group to-article - (memq article gnus-newsgroup-marked) - (memq article gnus-newsgroup-dormant) - (memq article gnus-newsgroup-unreads))) - - (when gnus-preserve-marks - ;; Copy any marks over to the new group. - (when (and (equal to-group gnus-newsgroup-name) - (not (memq article gnus-newsgroup-unreads))) - ;; Mark this article as read in this group. - (push (cons to-article gnus-read-mark) gnus-newsgroup-reads) - (setcdr (gnus-active to-group) to-article) - (setcdr gnus-newsgroup-active to-article)) - - (while marks - (when (eq (gnus-article-mark-to-type (cdar marks)) 'list) - (when (memq article (symbol-value - (intern (format "gnus-newsgroup-%s" - (caar marks))))) - (push (cdar marks) to-marks) - ;; If the other group is the same as this group, - ;; then we have to add the mark to the list. - (when (equal to-group gnus-newsgroup-name) - (set (intern (format "gnus-newsgroup-%s" (caar marks))) - (cons to-article - (symbol-value - (intern (format "gnus-newsgroup-%s" - (caar marks))))))) - ;; Copy the marks to other group. - (gnus-add-marked-articles - to-group (cdar marks) (list to-article) info))) - (setq marks (cdr marks))) - - (gnus-request-set-mark - to-group (list (list (list to-article) 'add to-marks)))) - - (gnus-dribble-enter - (concat "(gnus-group-set-info '" - (gnus-prin1-to-string (gnus-get-info to-group)) - ")")))) - - ;; Update the Xref header in this article to point to - ;; the new crossposted article we have just created. - (when (eq action 'crosspost) - (save-excursion - (set-buffer copy-buf) - (gnus-request-article-this-buffer article gnus-newsgroup-name) - (nnheader-replace-header "Xref" new-xref) - (gnus-request-replace-article - article gnus-newsgroup-name (current-buffer) t))) - - ;; run the move/copy/crosspost/respool hook - (run-hook-with-args 'gnus-summary-article-move-hook - action - (gnus-data-header - (assoc article (gnus-data-list nil))) - gnus-newsgroup-name - to-newsgroup - select-method)) - - ;;;!!!Why is this necessary? - (set-buffer gnus-summary-buffer) - - (gnus-summary-goto-subject article) - (when (eq action 'move) - (gnus-summary-mark-article article gnus-canceled-mark)))) - (gnus-summary-remove-process-mark article)) - ;; Re-activate all groups that have been moved to. - (save-excursion - (set-buffer gnus-group-buffer) - (let ((gnus-group-marked to-groups)) - (gnus-group-get-new-news-this-group nil t))) - - (gnus-kill-buffer copy-buf) - (gnus-summary-position-point) - (gnus-set-mode-line 'summary))) - -(defun gnus-summary-copy-article (&optional n to-newsgroup select-method) - "Copy the current article to some other group. -If TO-NEWSGROUP is string, do not prompt for a newsgroup to copy to. -When called interactively, if TO-NEWSGROUP is nil, use the value of -the variable `gnus-move-split-methods' for finding a default target -newsgroup. -If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but -re-spool using this method." - (interactive "P") - (gnus-summary-move-article n to-newsgroup select-method 'copy)) - -(defun gnus-summary-crosspost-article (&optional n) - "Crosspost the current article to some other group." - (interactive "P") - (gnus-summary-move-article n nil nil 'crosspost)) - -(defcustom gnus-summary-respool-default-method nil - "Default method type for respooling an article. -If nil, use to the current newsgroup method." - :type 'symbol - :group 'gnus-summary-mail) - -(defcustom gnus-summary-display-while-building nil - "If non-nil, show and update the summary buffer as it's being built. -If the value is t, update the buffer after every line is inserted. If -the value is an integer (N), update the display every N lines." - :version "22.1" - :group 'gnus-thread - :type '(choice (const :tag "off" nil) - number - (const :tag "frequently" t))) - -(defun gnus-summary-respool-article (&optional n method) - "Respool the current article. -The article will be squeezed through the mail spooling process again, -which means that it will be put in some mail newsgroup or other -depending on `nnmail-split-methods'. -If N is a positive number, respool the N next articles. -If N is a negative number, respool the N previous articles. -If N is nil and any articles have been marked with the process mark, -respool those articles instead. - -Respooling can be done both from mail groups and \"real\" newsgroups. -In the former case, the articles in question will be moved from the -current group into whatever groups they are destined to. In the -latter case, they will be copied into the relevant groups." - (interactive - (list current-prefix-arg - (let* ((methods (gnus-methods-using 'respool)) - (methname - (symbol-name (or gnus-summary-respool-default-method - (car (gnus-find-method-for-group - gnus-newsgroup-name))))) - (method - (gnus-completing-read-with-default - methname "Backend to use when respooling" - methods nil t nil 'gnus-mail-method-history)) - ms) - (cond - ((zerop (length (setq ms (gnus-servers-using-backend - (intern method))))) - (list (intern method) "")) - ((= 1 (length ms)) - (car ms)) - (t - (let ((ms-alist (mapcar (lambda (m) (cons (cadr m) m)) ms))) - (cdr (assoc (completing-read "Server name: " ms-alist nil t) - ms-alist)))))))) - (unless method - (error "No method given for respooling")) - (if (assoc (symbol-name - (car (gnus-find-method-for-group gnus-newsgroup-name))) - (gnus-methods-using 'respool)) - (gnus-summary-move-article n nil method) - (gnus-summary-copy-article n nil method))) - -(defun gnus-summary-import-article (file &optional edit) - "Import an arbitrary file into a mail newsgroup." - (interactive "fImport file: \nP") - (let ((group gnus-newsgroup-name) - (now (current-time)) - atts lines group-art) - (unless (gnus-check-backend-function 'request-accept-article group) - (error "%s does not support article importing" group)) - (or (file-readable-p file) - (not (file-regular-p file)) - (error "Can't read %s" file)) - (save-excursion - (set-buffer (gnus-get-buffer-create " *import file*")) - (erase-buffer) - (nnheader-insert-file-contents file) - (goto-char (point-min)) - (if (nnheader-article-p) - (save-restriction - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (narrow-to-region (point-min) (1- (point))) - (goto-char (point-min)) - (unless (re-search-forward "^date:" nil t) - (goto-char (point-max)) - (insert "Date: " (message-make-date (nth 5 atts)) "\n"))) - ;; This doesn't look like an article, so we fudge some headers. - (setq atts (file-attributes file) - lines (count-lines (point-min) (point-max))) - (insert "From: " (read-string "From: ") "\n" - "Subject: " (read-string "Subject: ") "\n" - "Date: " (message-make-date (nth 5 atts)) "\n" - "Message-ID: " (message-make-message-id) "\n" - "Lines: " (int-to-string lines) "\n" - "Chars: " (int-to-string (nth 7 atts)) "\n\n")) - (setq group-art (gnus-request-accept-article group nil t)) - (kill-buffer (current-buffer))) - (setq gnus-newsgroup-active (gnus-activate-group group)) - (forward-line 1) - (gnus-summary-goto-article (cdr group-art) nil t) - (when edit - (gnus-summary-edit-article)))) - -(defun gnus-summary-create-article () - "Create an article in a mail newsgroup." - (interactive) - (let ((group gnus-newsgroup-name) - (now (current-time)) - group-art) - (unless (gnus-check-backend-function 'request-accept-article group) - (error "%s does not support article importing" group)) - (save-excursion - (set-buffer (gnus-get-buffer-create " *import file*")) - (erase-buffer) - (goto-char (point-min)) - ;; This doesn't look like an article, so we fudge some headers. - (insert "From: " (read-string "From: ") "\n" - "Subject: " (read-string "Subject: ") "\n" - "Date: " (message-make-date now) "\n" - "Message-ID: " (message-make-message-id) "\n") - (setq group-art (gnus-request-accept-article group nil t)) - (kill-buffer (current-buffer))) - (setq gnus-newsgroup-active (gnus-activate-group group)) - (forward-line 1) - (gnus-summary-goto-article (cdr group-art) nil t) - (gnus-summary-edit-article))) - -(defun gnus-summary-article-posted-p () - "Say whether the current (mail) article is available from news as well. -This will be the case if the article has both been mailed and posted." - (interactive) - (let ((id (mail-header-references (gnus-summary-article-header))) - (gnus-override-method (car (gnus-refer-article-methods)))) - (if (gnus-request-head id "") - (gnus-message 2 "The current message was found on %s" - gnus-override-method) - (gnus-message 2 "The current message couldn't be found on %s" - gnus-override-method) - nil))) - -(defun gnus-summary-expire-articles (&optional now) - "Expire all articles that are marked as expirable in the current group." - (interactive) - (when (and (not gnus-group-is-exiting-without-update-p) - (gnus-check-backend-function - 'request-expire-articles gnus-newsgroup-name)) - ;; This backend supports expiry. - (let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name)) - (expirable (if total - (progn - ;; We need to update the info for - ;; this group for `gnus-list-of-read-articles' - ;; to give us the right answer. - (gnus-run-hooks 'gnus-exit-group-hook) - (gnus-summary-update-info) - (gnus-list-of-read-articles gnus-newsgroup-name)) - (setq gnus-newsgroup-expirable - (sort gnus-newsgroup-expirable '<)))) - (expiry-wait (if now 'immediate - (gnus-group-find-parameter - gnus-newsgroup-name 'expiry-wait))) - (nnmail-expiry-target - (or (gnus-group-find-parameter gnus-newsgroup-name 'expiry-target) - nnmail-expiry-target)) - es) - (when expirable - ;; There are expirable articles in this group, so we run them - ;; through the expiry process. - (gnus-message 6 "Expiring articles...") - (unless (gnus-check-group gnus-newsgroup-name) - (error "Can't open server for %s" gnus-newsgroup-name)) - ;; The list of articles that weren't expired is returned. - (save-excursion - (if expiry-wait - (let ((nnmail-expiry-wait-function nil) - (nnmail-expiry-wait expiry-wait)) - (setq es (gnus-request-expire-articles - expirable gnus-newsgroup-name))) - (setq es (gnus-request-expire-articles - expirable gnus-newsgroup-name))) - (unless total - (setq gnus-newsgroup-expirable es)) - ;; We go through the old list of expirable, and mark all - ;; really expired articles as nonexistent. - (unless (eq es expirable) ;If nothing was expired, we don't mark. - (let ((gnus-use-cache nil)) - (dolist (article expirable) - (when (and (not (memq article es)) - (gnus-data-find article)) - (gnus-summary-mark-article article gnus-canceled-mark) - (run-hook-with-args 'gnus-summary-article-expire-hook - 'delete - (gnus-data-header - (assoc article (gnus-data-list nil))) - gnus-newsgroup-name - nil - nil)))))) - (gnus-message 6 "Expiring articles...done"))))) - -(defun gnus-summary-expire-articles-now () - "Expunge all expirable articles in the current group. -This means that *all* articles that are marked as expirable will be -deleted forever, right now." - (interactive) - (or gnus-expert-user - (gnus-yes-or-no-p - "Are you really, really sure you want to delete all expirable messages? ") - (error "Phew!")) - (gnus-summary-expire-articles t)) - -;; Suggested by Jack Vinson . -(defun gnus-summary-delete-article (&optional n) - "Delete the N next (mail) articles. -This command actually deletes articles. This is not a marking -command. The article will disappear forever from your life, never to -return. - -If N is negative, delete backwards. -If N is nil and articles have been marked with the process mark, -delete these instead. - -If `gnus-novice-user' is non-nil you will be asked for -confirmation before the articles are deleted." - (interactive "P") - (unless (gnus-check-backend-function 'request-expire-articles - gnus-newsgroup-name) - (error "The current newsgroup does not support article deletion")) - (unless (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name)) - (error "Couldn't open server")) - ;; Compute the list of articles to delete. - (let ((articles (sort (copy-sequence (gnus-summary-work-articles n)) '<)) - (nnmail-expiry-target 'delete) - not-deleted) - (if (and gnus-novice-user - (not (gnus-yes-or-no-p - (format "Do you really want to delete %s forever? " - (if (> (length articles) 1) - (format "these %s articles" (length articles)) - "this article"))))) - () - ;; Delete the articles. - (setq not-deleted (gnus-request-expire-articles - articles gnus-newsgroup-name 'force)) - (while articles - (gnus-summary-remove-process-mark (car articles)) - ;; The backend might not have been able to delete the article - ;; after all. - (unless (memq (car articles) not-deleted) - (gnus-summary-mark-article (car articles) gnus-canceled-mark)) - (let* ((article (car articles)) - (id (mail-header-id (gnus-data-header - (assoc article (gnus-data-list nil)))))) - (run-hook-with-args 'gnus-summary-article-delete-hook - 'delete id gnus-newsgroup-name nil - nil)) - (setq articles (cdr articles))) - (when not-deleted - (gnus-message 4 "Couldn't delete articles %s" not-deleted))) - (gnus-summary-position-point) - (gnus-set-mode-line 'summary) - not-deleted)) - -(defun gnus-summary-edit-article (&optional arg) - "Edit the current article. -This will have permanent effect only in mail groups. -If ARG is nil, edit the decoded articles. -If ARG is 1, edit the raw articles. -If ARG is 2, edit the raw articles even in read-only groups. -If ARG is 3, edit the articles with the current handles. -Otherwise, allow editing of articles even in read-only -groups." - (interactive "P") - (let (force raw current-handles) - (cond - ((null arg)) - ((eq arg 1) - (setq raw t)) - ((eq arg 2) - (setq raw t - force t)) - ((eq arg 3) - (setq current-handles - (and (gnus-buffer-live-p gnus-article-buffer) - (with-current-buffer gnus-article-buffer - (prog1 - gnus-article-mime-handles - (setq gnus-article-mime-handles nil)))))) - (t - (setq force t))) - (when (and raw (not force) - (member gnus-newsgroup-name '("nndraft:delayed" - "nndraft:drafts" - "nndraft:queue"))) - (error "Can't edit the raw article in group %s" - gnus-newsgroup-name)) - (save-excursion - (set-buffer gnus-summary-buffer) - (let ((mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)) - (gnus-set-global-variables) - (when (and (not force) - (gnus-group-read-only-p)) - (error "The current newsgroup does not support article editing")) - (gnus-summary-show-article t) - (when (and (not raw) (gnus-buffer-live-p gnus-article-buffer)) - (with-current-buffer gnus-article-buffer - (mm-enable-multibyte))) - (if (member gnus-newsgroup-name '("nndraft:delayed" "nndraft:drafts")) - (setq raw t)) - (gnus-article-edit-article - (if raw 'ignore - `(lambda () - (let ((mbl mml-buffer-list)) - (setq mml-buffer-list nil) - (let ((rfc2047-quote-decoded-words-containing-tspecials t)) - (mime-to-mml ,'current-handles)) - (let ((mbl1 mml-buffer-list)) - (setq mml-buffer-list mbl) - (set (make-local-variable 'mml-buffer-list) mbl1)) - (gnus-make-local-hook 'kill-buffer-hook) - (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)))) - `(lambda (no-highlight) - (let ((mail-parse-charset ',gnus-newsgroup-charset) - (message-options message-options) - (message-options-set-recipient) - (mail-parse-ignored-charsets - ',gnus-newsgroup-ignored-charsets)) - ,(if (not raw) '(progn - (mml-to-mime) - (mml-destroy-buffers) - (remove-hook 'kill-buffer-hook - 'mml-destroy-buffers t) - (kill-local-variable 'mml-buffer-list))) - (gnus-summary-edit-article-done - ,(or (mail-header-references gnus-current-headers) "") - ,(gnus-group-read-only-p) - ,gnus-summary-buffer no-highlight)))))))) - -(defalias 'gnus-summary-edit-article-postpone 'gnus-article-edit-exit) - -(defun gnus-summary-edit-article-done (&optional references read-only buffer - no-highlight) - "Make edits to the current article permanent." - (interactive) - (save-excursion - ;; The buffer restriction contains the entire article if it exists. - (when (article-goto-body) - (let ((lines (count-lines (point) (point-max))) - (length (- (point-max) (point))) - (case-fold-search t) - (body (copy-marker (point)))) - (goto-char (point-min)) - (when (re-search-forward "^content-length:[ \t]\\([0-9]+\\)" body t) - (delete-region (match-beginning 1) (match-end 1)) - (insert (number-to-string length))) - (goto-char (point-min)) - (when (re-search-forward - "^x-content-length:[ \t]\\([0-9]+\\)" body t) - (delete-region (match-beginning 1) (match-end 1)) - (insert (number-to-string length))) - (goto-char (point-min)) - (when (re-search-forward "^lines:[ \t]\\([0-9]+\\)" body t) - (delete-region (match-beginning 1) (match-end 1)) - (insert (number-to-string lines)))))) - ;; Replace the article. - (let ((buf (current-buffer))) - (with-temp-buffer - (insert-buffer-substring buf) - - (if (and (not read-only) - (not (gnus-request-replace-article - (cdr gnus-article-current) (car gnus-article-current) - (current-buffer) t))) - (error "Couldn't replace article") - ;; Update the summary buffer. - (if (and references - (equal (message-tokenize-header references " ") - (message-tokenize-header - (or (message-fetch-field "references") "") " "))) - ;; We only have to update this line. - (save-excursion - (save-restriction - (message-narrow-to-head) - (let ((head (buffer-substring-no-properties - (point-min) (point-max))) - header) - (with-temp-buffer - (insert (format "211 %d Article retrieved.\n" - (cdr gnus-article-current))) - (insert head) - (insert ".\n") - (let ((nntp-server-buffer (current-buffer))) - (setq header (car (gnus-get-newsgroup-headers - nil t)))) - (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-data-set-header - (gnus-data-find (cdr gnus-article-current)) - header) - (gnus-summary-update-article-line - (cdr gnus-article-current) header) - (if (gnus-summary-goto-subject - (cdr gnus-article-current) nil t) - (gnus-summary-update-secondary-mark - (cdr gnus-article-current)))))))) - ;; Update threads. - (set-buffer (or buffer gnus-summary-buffer)) - (gnus-summary-update-article (cdr gnus-article-current)) - (if (gnus-summary-goto-subject (cdr gnus-article-current) nil t) - (gnus-summary-update-secondary-mark - (cdr gnus-article-current)))) - ;; Prettify the article buffer again. - (unless no-highlight - (save-excursion - (set-buffer gnus-article-buffer) - ;;;!!! Fix this -- article should be rehighlighted. - ;;;(gnus-run-hooks 'gnus-article-display-hook) - (set-buffer gnus-original-article-buffer) - (gnus-request-article - (cdr gnus-article-current) - (car gnus-article-current) (current-buffer)))) - ;; Prettify the summary buffer line. - (when (gnus-visual-p 'summary-highlight 'highlight) - (gnus-run-hooks 'gnus-visual-mark-article-hook)))))) - -(defun gnus-summary-edit-wash (key) - "Perform editing command KEY in the article buffer." - (interactive - (list - (progn - (message "%s" (concat (this-command-keys) "- ")) - (read-char)))) - (message "") - (gnus-summary-edit-article) - (execute-kbd-macro (concat (this-command-keys) key)) - (gnus-article-edit-done)) - -;;; Respooling - -(defun gnus-summary-respool-query (&optional silent trace) - "Query where the respool algorithm would put this article." - (interactive) - (let (gnus-mark-article-hook) - (gnus-summary-select-article) - (save-excursion - (set-buffer gnus-original-article-buffer) - (let ((groups (nnmail-article-group 'identity trace))) - (unless silent - (if groups - (message "This message would go to %s" - (mapconcat 'car groups ", ")) - (message "This message would go to no groups")) - groups))))) - -(defun gnus-summary-respool-trace () - "Trace where the respool algorithm would put this article. -Display a buffer showing all fancy splitting patterns which matched." - (interactive) - (gnus-summary-respool-query nil t)) - -;; Summary marking commands. - -(defun gnus-summary-kill-same-subject-and-select (&optional unmark) - "Mark articles which has the same subject as read, and then select the next. -If UNMARK is positive, remove any kind of mark. -If UNMARK is negative, tick articles." - (interactive "P") - (when unmark - (setq unmark (prefix-numeric-value unmark))) - (let ((count - (gnus-summary-mark-same-subject - (gnus-summary-article-subject) unmark))) - ;; Select next unread article. If auto-select-same mode, should - ;; select the first unread article. - (gnus-summary-next-article t (and gnus-auto-select-same - (gnus-summary-article-subject))) - (gnus-message 7 "%d article%s marked as %s" - count (if (= count 1) " is" "s are") - (if unmark "unread" "read")))) - -(defun gnus-summary-kill-same-subject (&optional unmark) - "Mark articles which has the same subject as read. -If UNMARK is positive, remove any kind of mark. -If UNMARK is negative, tick articles." - (interactive "P") - (when unmark - (setq unmark (prefix-numeric-value unmark))) - (let ((count - (gnus-summary-mark-same-subject - (gnus-summary-article-subject) unmark))) - ;; If marked as read, go to next unread subject. - (when (null unmark) - ;; Go to next unread subject. - (gnus-summary-next-subject 1 t)) - (gnus-message 7 "%d articles are marked as %s" - count (if unmark "unread" "read")))) - -(defun gnus-summary-mark-same-subject (subject &optional unmark) - "Mark articles with same SUBJECT as read, and return marked number. -If optional argument UNMARK is positive, remove any kinds of marks. -If optional argument UNMARK is negative, mark articles as unread instead." - (let ((count 1)) - (save-excursion - (cond - ((null unmark) ; Mark as read. - (while (and - (progn - (gnus-summary-mark-article-as-read gnus-killed-mark) - (gnus-summary-show-thread) t) - (gnus-summary-find-subject subject)) - (setq count (1+ count)))) - ((> unmark 0) ; Tick. - (while (and - (progn - (gnus-summary-mark-article-as-unread gnus-ticked-mark) - (gnus-summary-show-thread) t) - (gnus-summary-find-subject subject)) - (setq count (1+ count)))) - (t ; Mark as unread. - (while (and - (progn - (gnus-summary-mark-article-as-unread gnus-unread-mark) - (gnus-summary-show-thread) t) - (gnus-summary-find-subject subject)) - (setq count (1+ count))))) - (gnus-set-mode-line 'summary) - ;; Return the number of marked articles. - count))) - -(defun gnus-summary-mark-as-processable (n &optional unmark) - "Set the process mark on the next N articles. -If N is negative, mark backward instead. If UNMARK is non-nil, remove -the process mark instead. The difference between N and the actual -number of articles marked is returned." - (interactive "P") - (if (and (null n) (gnus-region-active-p)) - (gnus-uu-mark-region (region-beginning) (region-end) unmark) - (setq n (prefix-numeric-value n)) - (let ((backward (< n 0)) - (n (abs n))) - (while (and - (> n 0) - (if unmark - (gnus-summary-remove-process-mark - (gnus-summary-article-number)) - (gnus-summary-set-process-mark (gnus-summary-article-number))) - (zerop (gnus-summary-next-subject (if backward -1 1) nil t))) - (setq n (1- n))) - (when (/= 0 n) - (gnus-message 7 "No more articles")) - (gnus-summary-recenter) - (gnus-summary-position-point) - n))) - -(defun gnus-summary-unmark-as-processable (n) - "Remove the process mark from the next N articles. -If N is negative, unmark backward instead. The difference between N and -the actual number of articles unmarked is returned." - (interactive "P") - (gnus-summary-mark-as-processable n t)) - -(defun gnus-summary-unmark-all-processable () - "Remove the process mark from all articles." - (interactive) - (save-excursion - (while gnus-newsgroup-processable - (gnus-summary-remove-process-mark (car gnus-newsgroup-processable)))) - (gnus-summary-position-point)) - -(defun gnus-summary-add-mark (article type) - "Mark ARTICLE with a mark of TYPE." - (let ((vtype (car (assq type gnus-article-mark-lists))) - var) - (if (not vtype) - (error "No such mark type: %s" type) - (setq var (intern (format "gnus-newsgroup-%s" type))) - (set var (cons article (symbol-value var))) - (if (memq type '(processable cached replied forwarded recent saved)) - (gnus-summary-update-secondary-mark article) - ;;; !!! This is bogus. We should find out what primary - ;;; !!! mark we want to set. - (gnus-summary-update-mark gnus-del-mark 'unread))))) - -(defun gnus-summary-mark-as-expirable (n) - "Mark N articles forward as expirable. -If N is negative, mark backward instead. The difference between N and -the actual number of articles marked is returned." - (interactive "p") - (gnus-summary-mark-forward n gnus-expirable-mark)) - -(defun gnus-summary-mark-as-spam (n) - "Mark N articles forward as spam. -If N is negative, mark backward instead. The difference between N and -the actual number of articles marked is returned." - (interactive "p") - (gnus-summary-mark-forward n gnus-spam-mark)) - -(defun gnus-summary-mark-article-as-replied (article) - "Mark ARTICLE as replied to and update the summary line. -ARTICLE can also be a list of articles." - (interactive (list (gnus-summary-article-number))) - (let ((articles (if (listp article) article (list article)))) - (dolist (article articles) - (unless (numberp article) - (error "%s is not a number" article)) - (push article gnus-newsgroup-replied) - (let ((buffer-read-only nil)) - (when (gnus-summary-goto-subject article nil t) - (gnus-summary-update-secondary-mark article)))))) - -(defun gnus-summary-mark-article-as-forwarded (article) - "Mark ARTICLE as forwarded and update the summary line. -ARTICLE can also be a list of articles." - (let ((articles (if (listp article) article (list article)))) - (dolist (article articles) - (push article gnus-newsgroup-forwarded) - (let ((buffer-read-only nil)) - (when (gnus-summary-goto-subject article nil t) - (gnus-summary-update-secondary-mark article)))))) - -(defun gnus-summary-set-bookmark (article) - "Set a bookmark in current article." - (interactive (list (gnus-summary-article-number))) - (when (or (not (get-buffer gnus-article-buffer)) - (not gnus-current-article) - (not gnus-article-current) - (not (equal gnus-newsgroup-name (car gnus-article-current)))) - (error "No current article selected")) - ;; Remove old bookmark, if one exists. - (gnus-pull article gnus-newsgroup-bookmarks) - ;; Set the new bookmark, which is on the form - ;; (article-number . line-number-in-body). - (push - (cons article - (save-excursion - (set-buffer gnus-article-buffer) - (count-lines - (min (point) - (save-excursion - (article-goto-body) - (point))) - (point)))) - gnus-newsgroup-bookmarks) - (gnus-message 6 "A bookmark has been added to the current article.")) - -(defun gnus-summary-remove-bookmark (article) - "Remove the bookmark from the current article." - (interactive (list (gnus-summary-article-number))) - ;; Remove old bookmark, if one exists. - (if (not (assq article gnus-newsgroup-bookmarks)) - (gnus-message 6 "No bookmark in current article.") - (gnus-pull article gnus-newsgroup-bookmarks) - (gnus-message 6 "Removed bookmark."))) - -;; Suggested by Daniel Quinlan . -(defun gnus-summary-mark-as-dormant (n) - "Mark N articles forward as dormant. -If N is negative, mark backward instead. The difference between N and -the actual number of articles marked is returned." - (interactive "p") - (gnus-summary-mark-forward n gnus-dormant-mark)) - -(defun gnus-summary-set-process-mark (article) - "Set the process mark on ARTICLE and update the summary line." - (setq gnus-newsgroup-processable - (cons article - (delq article gnus-newsgroup-processable))) - (when (gnus-summary-goto-subject article) - (gnus-summary-show-thread) - (gnus-summary-goto-subject article) - (gnus-summary-update-secondary-mark article))) - -(defun gnus-summary-remove-process-mark (article) - "Remove the process mark from ARTICLE and update the summary line." - (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable)) - (when (gnus-summary-goto-subject article) - (gnus-summary-show-thread) - (gnus-summary-goto-subject article) - (gnus-summary-update-secondary-mark article))) - -(defun gnus-summary-set-saved-mark (article) - "Set the process mark on ARTICLE and update the summary line." - (push article gnus-newsgroup-saved) - (when (gnus-summary-goto-subject article) - (gnus-summary-update-secondary-mark article))) - -(defun gnus-summary-mark-forward (n &optional mark no-expire) - "Mark N articles as read forwards. -If N is negative, mark backwards instead. Mark with MARK, ?r by default. -The difference between N and the actual number of articles marked is -returned. -If NO-EXPIRE, auto-expiry will be inhibited." - (interactive "p") - (gnus-summary-show-thread) - (let ((backward (< n 0)) - (gnus-summary-goto-unread - (and gnus-summary-goto-unread - (not (eq gnus-summary-goto-unread 'never)) - (not (memq mark (list gnus-unread-mark gnus-spam-mark - gnus-ticked-mark gnus-dormant-mark))))) - (n (abs n)) - (mark (or mark gnus-del-mark))) - (while (and (> n 0) - (gnus-summary-mark-article nil mark no-expire) - (zerop (gnus-summary-next-subject - (if backward -1 1) - (and gnus-summary-goto-unread - (not (eq gnus-summary-goto-unread 'never))) - t))) - (setq n (1- n))) - (when (/= 0 n) - (gnus-message 7 "No more %sarticles" (if mark "" "unread "))) - (gnus-summary-recenter) - (gnus-summary-position-point) - (gnus-set-mode-line 'summary) - n)) - -(defun gnus-summary-mark-article-as-read (mark) - "Mark the current article quickly as read with MARK." - (let ((article (gnus-summary-article-number))) - (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) - (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) - (setq gnus-newsgroup-spam-marked (delq article gnus-newsgroup-spam-marked)) - (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) - (push (cons article mark) gnus-newsgroup-reads) - ;; Possibly remove from cache, if that is used. - (when gnus-use-cache - (gnus-cache-enter-remove-article article)) - ;; Allow the backend to change the mark. - (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark)) - ;; Check for auto-expiry. - (when (and gnus-newsgroup-auto-expire - (memq mark gnus-auto-expirable-marks)) - (setq mark gnus-expirable-mark) - ;; Let the backend know about the mark change. - (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark)) - (push article gnus-newsgroup-expirable)) - ;; Set the mark in the buffer. - (gnus-summary-update-mark mark 'unread) - t)) - -(defun gnus-summary-mark-article-as-unread (mark) - "Mark the current article quickly as unread with MARK." - (let* ((article (gnus-summary-article-number)) - (old-mark (gnus-summary-article-mark article))) - ;; Allow the backend to change the mark. - (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark)) - (if (eq mark old-mark) - t - (if (<= article 0) - (progn - (gnus-error 1 "Can't mark negative article numbers") - nil) - (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) - (setq gnus-newsgroup-spam-marked - (delq article gnus-newsgroup-spam-marked)) - (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) - (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)) - (setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads)) - (cond ((= mark gnus-ticked-mark) - (setq gnus-newsgroup-marked - (gnus-add-to-sorted-list gnus-newsgroup-marked - article))) - ((= mark gnus-spam-mark) - (setq gnus-newsgroup-spam-marked - (gnus-add-to-sorted-list gnus-newsgroup-spam-marked - article))) - ((= mark gnus-dormant-mark) - (setq gnus-newsgroup-dormant - (gnus-add-to-sorted-list gnus-newsgroup-dormant - article))) - (t - (setq gnus-newsgroup-unreads - (gnus-add-to-sorted-list gnus-newsgroup-unreads - article)))) - (gnus-pull article gnus-newsgroup-reads) - - ;; See whether the article is to be put in the cache. - (and gnus-use-cache - (vectorp (gnus-summary-article-header article)) - (save-excursion - (gnus-cache-possibly-enter-article - gnus-newsgroup-name article - (= mark gnus-ticked-mark) - (= mark gnus-dormant-mark) (= mark gnus-unread-mark)))) - - ;; Fix the mark. - (gnus-summary-update-mark mark 'unread) - t)))) - -(defun gnus-summary-mark-article (&optional article mark no-expire) - "Mark ARTICLE with MARK. MARK can be any character. -Four MARK strings are reserved: `? ' (unread), `?!' (ticked), -`??' (dormant) and `?E' (expirable). -If MARK is nil, then the default character `?r' is used. -If ARTICLE is nil, then the article on the current line will be -marked. -If NO-EXPIRE, auto-expiry will be inhibited." - ;; The mark might be a string. - (when (stringp mark) - (setq mark (aref mark 0))) - ;; If no mark is given, then we check auto-expiring. - (when (null mark) - (setq mark gnus-del-mark)) - (when (and (not no-expire) - gnus-newsgroup-auto-expire - (memq mark gnus-auto-expirable-marks)) - (setq mark gnus-expirable-mark)) - (let ((article (or article (gnus-summary-article-number))) - (old-mark (gnus-summary-article-mark article))) - ;; Allow the backend to change the mark. - (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark)) - (if (eq mark old-mark) - t - (unless article - (error "No article on current line")) - (if (not (if (or (= mark gnus-unread-mark) - (= mark gnus-ticked-mark) - (= mark gnus-spam-mark) - (= mark gnus-dormant-mark)) - (gnus-mark-article-as-unread article mark) - (gnus-mark-article-as-read article mark))) - t - ;; See whether the article is to be put in the cache. - (and gnus-use-cache - (not (= mark gnus-canceled-mark)) - (vectorp (gnus-summary-article-header article)) - (save-excursion - (gnus-cache-possibly-enter-article - gnus-newsgroup-name article - (= mark gnus-ticked-mark) - (= mark gnus-dormant-mark) (= mark gnus-unread-mark)))) - - (when (gnus-summary-goto-subject article nil t) - (let ((buffer-read-only nil)) - (gnus-summary-show-thread) - ;; Fix the mark. - (gnus-summary-update-mark mark 'unread) - t)))))) - -(defun gnus-summary-update-secondary-mark (article) - "Update the secondary (read, process, cache) mark." - (gnus-summary-update-mark - (cond ((memq article gnus-newsgroup-processable) - gnus-process-mark) - ((memq article gnus-newsgroup-cached) - gnus-cached-mark) - ((memq article gnus-newsgroup-replied) - gnus-replied-mark) - ((memq article gnus-newsgroup-forwarded) - gnus-forwarded-mark) - ((memq article gnus-newsgroup-saved) - gnus-saved-mark) - ((memq article gnus-newsgroup-recent) - gnus-recent-mark) - ((memq article gnus-newsgroup-unseen) - gnus-unseen-mark) - (t gnus-no-mark)) - 'replied) - (when (gnus-visual-p 'summary-highlight 'highlight) - (gnus-run-hooks 'gnus-summary-update-hook)) - t) - -(defun gnus-summary-update-download-mark (article) - "Update the download mark." - (gnus-summary-update-mark - (cond ((memq article gnus-newsgroup-undownloaded) - gnus-undownloaded-mark) - (gnus-newsgroup-agentized - gnus-downloaded-mark) - (t - gnus-no-mark)) - 'download) - (gnus-summary-update-line t) - t) - -(defun gnus-summary-update-mark (mark type) - (let ((forward (cdr (assq type gnus-summary-mark-positions))) - (buffer-read-only nil)) - (re-search-backward "[\n\r]" (gnus-point-at-bol) 'move-to-limit) - (when forward - (when (looking-at "\r") - (incf forward)) - (when (<= (+ forward (point)) (point-max)) - ;; Go to the right position on the line. - (goto-char (+ forward (point))) - ;; Replace the old mark with the new mark. - (subst-char-in-region (point) (1+ (point)) (char-after) mark) - ;; Optionally update the marks by some user rule. - (when (eq type 'unread) - (gnus-data-set-mark - (gnus-data-find (gnus-summary-article-number)) mark) - (gnus-summary-update-line (eq mark gnus-unread-mark))))))) - -(defun gnus-mark-article-as-read (article &optional mark) - "Enter ARTICLE in the pertinent lists and remove it from others." - ;; Make the article expirable. - (let ((mark (or mark gnus-del-mark))) - (setq gnus-newsgroup-expirable - (if (= mark gnus-expirable-mark) - (gnus-add-to-sorted-list gnus-newsgroup-expirable article) - (delq article gnus-newsgroup-expirable))) - ;; Remove from unread and marked lists. - (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) - (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) - (setq gnus-newsgroup-spam-marked (delq article gnus-newsgroup-spam-marked)) - (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) - (push (cons article mark) gnus-newsgroup-reads) - ;; Possibly remove from cache, if that is used. - (when gnus-use-cache - (gnus-cache-enter-remove-article article)) - t)) - -(defun gnus-mark-article-as-unread (article &optional mark) - "Enter ARTICLE in the pertinent lists and remove it from others." - (let ((mark (or mark gnus-ticked-mark))) - (if (<= article 0) - (progn - (gnus-error 1 "Can't mark negative article numbers") - nil) - (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked) - gnus-newsgroup-spam-marked (delq article gnus-newsgroup-spam-marked) - gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant) - gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable) - gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) - - ;; Unsuppress duplicates? - (when gnus-suppress-duplicates - (gnus-dup-unsuppress-article article)) - - (cond ((= mark gnus-ticked-mark) - (setq gnus-newsgroup-marked - (gnus-add-to-sorted-list gnus-newsgroup-marked article))) - ((= mark gnus-spam-mark) - (setq gnus-newsgroup-spam-marked - (gnus-add-to-sorted-list gnus-newsgroup-spam-marked - article))) - ((= mark gnus-dormant-mark) - (setq gnus-newsgroup-dormant - (gnus-add-to-sorted-list gnus-newsgroup-dormant article))) - (t - (setq gnus-newsgroup-unreads - (gnus-add-to-sorted-list gnus-newsgroup-unreads article)))) - (gnus-pull article gnus-newsgroup-reads) - t))) - -(defalias 'gnus-summary-mark-as-unread-forward - 'gnus-summary-tick-article-forward) -(make-obsolete 'gnus-summary-mark-as-unread-forward - 'gnus-summary-tick-article-forward) -(defun gnus-summary-tick-article-forward (n) - "Tick N articles forwards. -If N is negative, tick backwards instead. -The difference between N and the number of articles ticked is returned." - (interactive "p") - (gnus-summary-mark-forward n gnus-ticked-mark)) - -(defalias 'gnus-summary-mark-as-unread-backward - 'gnus-summary-tick-article-backward) -(make-obsolete 'gnus-summary-mark-as-unread-backward - 'gnus-summary-tick-article-backward) -(defun gnus-summary-tick-article-backward (n) - "Tick N articles backwards. -The difference between N and the number of articles ticked is returned." - (interactive "p") - (gnus-summary-mark-forward (- n) gnus-ticked-mark)) - -(defalias 'gnus-summary-mark-as-unread 'gnus-summary-tick-article) -(make-obsolete 'gnus-summary-mark-as-unread 'gnus-summary-tick-article) -(defun gnus-summary-tick-article (&optional article clear-mark) - "Mark current article as unread. -Optional 1st argument ARTICLE specifies article number to be marked as unread. -Optional 2nd argument CLEAR-MARK remove any kinds of mark." - (interactive) - (gnus-summary-mark-article article (if clear-mark gnus-unread-mark - gnus-ticked-mark))) - -(defun gnus-summary-mark-as-read-forward (n) - "Mark N articles as read forwards. -If N is negative, mark backwards instead. -The difference between N and the actual number of articles marked is -returned." - (interactive "p") - (gnus-summary-mark-forward n gnus-del-mark gnus-inhibit-user-auto-expire)) - -(defun gnus-summary-mark-as-read-backward (n) - "Mark the N articles as read backwards. -The difference between N and the actual number of articles marked is -returned." - (interactive "p") - (gnus-summary-mark-forward - (- n) gnus-del-mark gnus-inhibit-user-auto-expire)) - -(defun gnus-summary-mark-as-read (&optional article mark) - "Mark current article as read. -ARTICLE specifies the article to be marked as read. -MARK specifies a string to be inserted at the beginning of the line." - (gnus-summary-mark-article article mark)) - -(defun gnus-summary-clear-mark-forward (n) - "Clear marks from N articles forward. -If N is negative, clear backward instead. -The difference between N and the number of marks cleared is returned." - (interactive "p") - (gnus-summary-mark-forward n gnus-unread-mark)) - -(defun gnus-summary-clear-mark-backward (n) - "Clear marks from N articles backward. -The difference between N and the number of marks cleared is returned." - (interactive "p") - (gnus-summary-mark-forward (- n) gnus-unread-mark)) - -(defun gnus-summary-mark-unread-as-read () - "Intended to be used by `gnus-mark-article-hook'." - (when (memq gnus-current-article gnus-newsgroup-unreads) - (gnus-summary-mark-article gnus-current-article gnus-read-mark))) - -(defun gnus-summary-mark-read-and-unread-as-read (&optional new-mark) - "Intended to be used by `gnus-mark-article-hook'." - (let ((mark (gnus-summary-article-mark))) - (when (or (gnus-unread-mark-p mark) - (gnus-read-mark-p mark)) - (gnus-summary-mark-article gnus-current-article - (or new-mark gnus-read-mark))))) - -(defun gnus-summary-mark-current-read-and-unread-as-read (&optional new-mark) - "Intended to be used by `gnus-mark-article-hook'." - (let ((mark (gnus-summary-article-mark))) - (when (or (gnus-unread-mark-p mark) - (gnus-read-mark-p mark)) - (gnus-summary-mark-article (gnus-summary-article-number) - (or new-mark gnus-read-mark))))) - -(defun gnus-summary-mark-unread-as-ticked () - "Intended to be used by `gnus-mark-article-hook'." - (when (memq gnus-current-article gnus-newsgroup-unreads) - (gnus-summary-mark-article gnus-current-article gnus-ticked-mark))) - -(defun gnus-summary-mark-region-as-read (point mark all) - "Mark all unread articles between point and mark as read. -If given a prefix, mark all articles between point and mark as read, -even ticked and dormant ones." - (interactive "r\nP") - (save-excursion - (let (article) - (goto-char point) - (beginning-of-line) - (while (and - (< (point) mark) - (progn - (when (or all - (memq (setq article (gnus-summary-article-number)) - gnus-newsgroup-unreads)) - (gnus-summary-mark-article article gnus-del-mark)) - t) - (gnus-summary-find-next)))))) - -(defun gnus-summary-mark-below (score mark) - "Mark articles with score less than SCORE with MARK." - (interactive "P\ncMark: ") - (setq score (if score - (prefix-numeric-value score) - (or gnus-summary-default-score 0))) - (save-excursion - (set-buffer gnus-summary-buffer) - (goto-char (point-min)) - (while - (progn - (and (< (gnus-summary-article-score) score) - (gnus-summary-mark-article nil mark)) - (gnus-summary-find-next))))) - -(defun gnus-summary-kill-below (&optional score) - "Mark articles with score below SCORE as read." - (interactive "P") - (gnus-summary-mark-below score gnus-killed-mark)) - -(defun gnus-summary-clear-above (&optional score) - "Clear all marks from articles with score above SCORE." - (interactive "P") - (gnus-summary-mark-above score gnus-unread-mark)) - -(defun gnus-summary-tick-above (&optional score) - "Tick all articles with score above SCORE." - (interactive "P") - (gnus-summary-mark-above score gnus-ticked-mark)) - -(defun gnus-summary-mark-above (score mark) - "Mark articles with score over SCORE with MARK." - (interactive "P\ncMark: ") - (setq score (if score - (prefix-numeric-value score) - (or gnus-summary-default-score 0))) - (save-excursion - (set-buffer gnus-summary-buffer) - (goto-char (point-min)) - (while (and (progn - (when (> (gnus-summary-article-score) score) - (gnus-summary-mark-article nil mark)) - t) - (gnus-summary-find-next))))) - -;; Suggested by Daniel Quinlan . -(defalias 'gnus-summary-show-all-expunged 'gnus-summary-limit-include-expunged) -(defun gnus-summary-limit-include-expunged (&optional no-error) - "Display all the hidden articles that were expunged for low scores." - (interactive) - (let ((buffer-read-only nil)) - (let ((scored gnus-newsgroup-scored) - headers h) - (while scored - (unless (gnus-summary-article-header (caar scored)) - (and (setq h (gnus-number-to-header (caar scored))) - (< (cdar scored) gnus-summary-expunge-below) - (push h headers))) - (setq scored (cdr scored))) - (if (not headers) - (when (not no-error) - (error "No expunged articles hidden")) - (goto-char (point-min)) - (push gnus-newsgroup-limit gnus-newsgroup-limits) - (setq gnus-newsgroup-limit (copy-sequence gnus-newsgroup-limit)) - (mapcar (lambda (x) (push (mail-header-number x) - gnus-newsgroup-limit)) - headers) - (gnus-summary-prepare-unthreaded (nreverse headers)) - (goto-char (point-min)) - (gnus-summary-position-point) - t)))) - -(defun gnus-summary-catchup (&optional all quietly to-here not-mark reverse) - "Mark all unread articles in this newsgroup as read. -If prefix argument ALL is non-nil, ticked and dormant articles will -also be marked as read. -If QUIETLY is non-nil, no questions will be asked. - -If TO-HERE is non-nil, it should be a point in the buffer. All -articles before (after, if REVERSE is set) this point will be marked -as read. - -Note that this function will only catch up the unread article -in the current summary buffer limitation. - -The number of articles marked as read is returned." - (interactive "P") - (prog1 - (save-excursion - (when (or quietly - (not gnus-interactive-catchup) ;Without confirmation? - gnus-expert-user - (gnus-y-or-n-p - (if all - "Mark absolutely all articles as read? " - "Mark all unread articles as read? "))) - (if (and not-mark - (not gnus-newsgroup-adaptive) - (not gnus-newsgroup-auto-expire) - (not gnus-suppress-duplicates) - (or (not gnus-use-cache) - (eq gnus-use-cache 'passive))) - (progn - (when all - (setq gnus-newsgroup-marked nil - gnus-newsgroup-spam-marked nil - gnus-newsgroup-dormant nil)) - (setq gnus-newsgroup-unreads - (gnus-sorted-nunion - (gnus-sorted-intersection gnus-newsgroup-unreads - gnus-newsgroup-downloadable) - (gnus-sorted-difference gnus-newsgroup-unfetched - gnus-newsgroup-cached)))) - ;; We actually mark all articles as canceled, which we - ;; have to do when using auto-expiry or adaptive scoring. - (gnus-summary-show-all-threads) - (if (and to-here reverse) - (progn - (goto-char to-here) - (gnus-summary-mark-current-read-and-unread-as-read - gnus-catchup-mark) - (while (gnus-summary-find-next (not all)) - (gnus-summary-mark-article-as-read gnus-catchup-mark))) - (when (gnus-summary-first-subject (not all)) - (while (and - (if to-here (< (point) to-here) t) - (gnus-summary-mark-article-as-read gnus-catchup-mark) - (gnus-summary-find-next (not all)))))) - (gnus-set-mode-line 'summary)) - t)) - (gnus-summary-position-point))) - -(defun gnus-summary-catchup-to-here (&optional all) - "Mark all unticked articles before the current one as read. -If ALL is non-nil, also mark ticked and dormant articles as read." - (interactive "P") - (save-excursion - (gnus-save-hidden-threads - (let ((beg (point))) - ;; We check that there are unread articles. - (when (or all (gnus-summary-find-prev)) - (gnus-summary-catchup all t beg))))) - (gnus-summary-position-point)) - -(defun gnus-summary-catchup-from-here (&optional all) - "Mark all unticked articles after (and including) the current one as read. -If ALL is non-nil, also mark ticked and dormant articles as read." - (interactive "P") - (save-excursion - (gnus-save-hidden-threads - (let ((beg (point))) - ;; We check that there are unread articles. - (when (or all (gnus-summary-find-next)) - (gnus-summary-catchup all t beg nil t))))) - (gnus-summary-position-point)) - -(defun gnus-summary-catchup-all (&optional quietly) - "Mark all articles in this newsgroup as read. -This command is dangerous. Normally, you want \\[gnus-summary-catchup] -instead, which marks only unread articles as read." - (interactive "P") - (gnus-summary-catchup t quietly)) - -(defun gnus-summary-catchup-and-exit (&optional all quietly) - "Mark all unread articles in this group as read, then exit. -If prefix argument ALL is non-nil, all articles are marked as read. -If QUIETLY is non-nil, no questions will be asked." - (interactive "P") - (when (gnus-summary-catchup all quietly nil 'fast) - ;; Select next newsgroup or exit. - (if (and (not (gnus-group-quit-config gnus-newsgroup-name)) - (eq gnus-auto-select-next 'quietly)) - (gnus-summary-next-group nil) - (gnus-summary-exit)))) - -(defun gnus-summary-catchup-all-and-exit (&optional quietly) - "Mark all articles in this newsgroup as read, and then exit. -This command is dangerous. Normally, you want \\[gnus-summary-catchup-and-exit] -instead, which marks only unread articles as read." - (interactive "P") - (gnus-summary-catchup-and-exit t quietly)) - -(defun gnus-summary-catchup-and-goto-next-group (&optional all) - "Mark all articles in this group as read and select the next group. -If given a prefix, mark all articles, unread as well as ticked, as -read." - (interactive "P") - (save-excursion - (gnus-summary-catchup all)) - (gnus-summary-next-group)) - -;;; -;;; with article -;;; - -(defmacro gnus-with-article (article &rest forms) - "Select ARTICLE and perform FORMS in the original article buffer. -Then replace the article with the result." - `(progn - ;; We don't want the article to be marked as read. - (let (gnus-mark-article-hook) - (gnus-summary-select-article t t nil ,article)) - (set-buffer gnus-original-article-buffer) - ,@forms - (if (not (gnus-check-backend-function - 'request-replace-article (car gnus-article-current))) - (gnus-message 5 "Read-only group; not replacing") - (unless (gnus-request-replace-article - ,article (car gnus-article-current) - (current-buffer) t) - (error "Couldn't replace article"))) - ;; The cache and backlog have to be flushed somewhat. - (when gnus-keep-backlog - (gnus-backlog-remove-article - (car gnus-article-current) (cdr gnus-article-current))) - (when gnus-use-cache - (gnus-cache-update-article - (car gnus-article-current) (cdr gnus-article-current))))) - -(put 'gnus-with-article 'lisp-indent-function 1) -(put 'gnus-with-article 'edebug-form-spec '(form body)) - -;; Thread-based commands. - -(defun gnus-summary-articles-in-thread (&optional article) - "Return a list of all articles in the current thread. -If ARTICLE is non-nil, return all articles in the thread that starts -with that article." - (let* ((article (or article (gnus-summary-article-number))) - (data (gnus-data-find-list article)) - (top-level (gnus-data-level (car data))) - (top-subject - (cond ((null gnus-thread-operation-ignore-subject) - (gnus-simplify-subject-re - (mail-header-subject (gnus-data-header (car data))))) - ((eq gnus-thread-operation-ignore-subject 'fuzzy) - (gnus-simplify-subject-fuzzy - (mail-header-subject (gnus-data-header (car data))))) - (t nil))) - (end-point (save-excursion - (if (gnus-summary-go-to-next-thread) - (point) (point-max)))) - articles) - (while (and data - (< (gnus-data-pos (car data)) end-point)) - (when (or (not top-subject) - (string= top-subject - (if (eq gnus-thread-operation-ignore-subject 'fuzzy) - (gnus-simplify-subject-fuzzy - (mail-header-subject - (gnus-data-header (car data)))) - (gnus-simplify-subject-re - (mail-header-subject - (gnus-data-header (car data))))))) - (push (gnus-data-number (car data)) articles)) - (unless (and (setq data (cdr data)) - (> (gnus-data-level (car data)) top-level)) - (setq data nil))) - ;; Return the list of articles. - (nreverse articles))) - -(defun gnus-summary-rethread-current () - "Rethread the thread the current article is part of." - (interactive) - (let* ((gnus-show-threads t) - (article (gnus-summary-article-number)) - (id (mail-header-id (gnus-summary-article-header))) - (gnus-newsgroup-threads (list (gnus-id-to-thread (gnus-root-id id))))) - (unless id - (error "No article on the current line")) - (gnus-rebuild-thread id) - (gnus-summary-goto-subject article))) - -(defun gnus-summary-reparent-thread () - "Make the current article child of the marked (or previous) article. - -Note that the re-threading will only work if `gnus-thread-ignore-subject' -is non-nil or the Subject: of both articles are the same." - (interactive) - (unless (not (gnus-group-read-only-p)) - (error "The current newsgroup does not support article editing")) - (unless (<= (length gnus-newsgroup-processable) 1) - (error "No more than one article may be marked")) - (save-window-excursion - (let ((gnus-article-buffer " *reparent*") - (current-article (gnus-summary-article-number)) - ;; First grab the marked article, otherwise one line up. - (parent-article (if (not (null gnus-newsgroup-processable)) - (car gnus-newsgroup-processable) - (save-excursion - (if (eq (forward-line -1) 0) - (gnus-summary-article-number) - (error "Beginning of summary buffer")))))) - (unless (not (eq current-article parent-article)) - (error "An article may not be self-referential")) - (let ((message-id (mail-header-id - (gnus-summary-article-header parent-article)))) - (unless (and message-id (not (equal message-id ""))) - (error "No message-id in desired parent")) - (gnus-with-article current-article - (save-restriction - (goto-char (point-min)) - (message-narrow-to-head) - (if (re-search-forward "^References: " nil t) - (progn - (re-search-forward "^[^ \t]" nil t) - (forward-line -1) - (end-of-line) - (insert " " message-id)) - (insert "References: " message-id "\n")))) - (set-buffer gnus-summary-buffer) - (gnus-summary-unmark-all-processable) - (gnus-summary-update-article current-article) - (if (gnus-summary-goto-subject (cdr gnus-article-current) nil t) - (gnus-summary-update-secondary-mark (cdr gnus-article-current))) - (gnus-summary-rethread-current) - (gnus-message 3 "Article %d is now the child of article %d" - current-article parent-article))))) - -(defun gnus-summary-toggle-threads (&optional arg) - "Toggle showing conversation threads. -If ARG is positive number, turn showing conversation threads on." - (interactive "P") - (let ((current (or (gnus-summary-article-number) gnus-newsgroup-end))) - (setq gnus-show-threads - (if (null arg) (not gnus-show-threads) - (> (prefix-numeric-value arg) 0))) - (gnus-summary-prepare) - (gnus-summary-goto-subject current) - (gnus-message 6 "Threading is now %s" (if gnus-show-threads "on" "off")) - (gnus-summary-position-point))) - -(defun gnus-summary-show-all-threads () - "Show all threads." - (interactive) - (save-excursion - (let ((buffer-read-only nil)) - (subst-char-in-region (point-min) (point-max) ?\^M ?\n t))) - (gnus-summary-position-point)) - -(defun gnus-summary-show-thread () - "Show thread subtrees. -Returns nil if no thread was there to be shown." - (interactive) - (let ((buffer-read-only nil) - (orig (point)) - (end (gnus-point-at-eol)) - ;; Leave point at bol - (beg (progn (beginning-of-line) (point)))) - (prog1 - ;; Any hidden lines here? - (search-forward "\r" end t) - (subst-char-in-region beg end ?\^M ?\n t) - (goto-char orig) - (gnus-summary-position-point)))) - -(defun gnus-summary-maybe-hide-threads () - "If requested, hide the threads that should be hidden." - (when (and gnus-show-threads - gnus-thread-hide-subtree) - (gnus-summary-hide-all-threads - (if (or (consp gnus-thread-hide-subtree) - (functionp gnus-thread-hide-subtree)) - (gnus-make-predicate gnus-thread-hide-subtree) - nil)))) - -;;; Hiding predicates. - -(defun gnus-article-unread-p (header) - (memq (mail-header-number header) gnus-newsgroup-unreads)) - -(defun gnus-article-unseen-p (header) - (memq (mail-header-number header) gnus-newsgroup-unseen)) - -(defun gnus-map-articles (predicate articles) - "Map PREDICATE over ARTICLES and return non-nil if any predicate is non-nil." - (apply 'gnus-or (mapcar predicate - (mapcar (lambda (number) - (gnus-summary-article-header number)) - articles)))) - -(defun gnus-summary-hide-all-threads (&optional predicate) - "Hide all thread subtrees. -If PREDICATE is supplied, threads that satisfy this predicate -will not be hidden." - (interactive) - (save-excursion - (goto-char (point-min)) - (let ((end nil)) - (while (not end) - (when (or (not predicate) - (gnus-map-articles - predicate (gnus-summary-article-children))) - (gnus-summary-hide-thread)) - (setq end (not (zerop (gnus-summary-next-thread 1 t))))))) - (gnus-summary-position-point)) - -(defun gnus-summary-hide-thread () - "Hide thread subtrees. -If PREDICATE is supplied, threads that satisfy this predicate -will not be hidden. -Returns nil if no threads were there to be hidden." - (interactive) - (let ((buffer-read-only nil) - (start (point)) - (article (gnus-summary-article-number))) - (goto-char start) - ;; Go forward until either the buffer ends or the subthread - ;; ends. - (when (and (not (eobp)) - (or (zerop (gnus-summary-next-thread 1 t)) - (goto-char (point-max)))) - (prog1 - (if (and (> (point) start) - (search-backward "\n" start t)) - (progn - (subst-char-in-region start (point) ?\n ?\^M) - (gnus-summary-goto-subject article)) - (goto-char start) - nil))))) - -(defun gnus-summary-go-to-next-thread (&optional previous) - "Go to the same level (or less) next thread. -If PREVIOUS is non-nil, go to previous thread instead. -Return the article number moved to, or nil if moving was impossible." - (let ((level (gnus-summary-thread-level)) - (way (if previous -1 1)) - (beg (point))) - (forward-line way) - (while (and (not (eobp)) - (< level (gnus-summary-thread-level))) - (forward-line way)) - (if (eobp) - (progn - (goto-char beg) - nil) - (setq beg (point)) - (prog1 - (gnus-summary-article-number) - (goto-char beg))))) - -(defun gnus-summary-next-thread (n &optional silent) - "Go to the same level next N'th thread. -If N is negative, search backward instead. -Returns the difference between N and the number of skips actually -done. - -If SILENT, don't output messages." - (interactive "p") - (let ((backward (< n 0)) - (n (abs n))) - (while (and (> n 0) - (gnus-summary-go-to-next-thread backward)) - (decf n)) - (unless silent - (gnus-summary-position-point)) - (when (and (not silent) (/= 0 n)) - (gnus-message 7 "No more threads")) - n)) - -(defun gnus-summary-prev-thread (n) - "Go to the same level previous N'th thread. -Returns the difference between N and the number of skips actually -done." - (interactive "p") - (gnus-summary-next-thread (- n))) - -(defun gnus-summary-go-down-thread () - "Go down one level in the current thread." - (let ((children (gnus-summary-article-children))) - (when children - (gnus-summary-goto-subject (car children))))) - -(defun gnus-summary-go-up-thread () - "Go up one level in the current thread." - (let ((parent (gnus-summary-article-parent))) - (when parent - (gnus-summary-goto-subject parent)))) - -(defun gnus-summary-down-thread (n) - "Go down thread N steps. -If N is negative, go up instead. -Returns the difference between N and how many steps down that were -taken." - (interactive "p") - (let ((up (< n 0)) - (n (abs n))) - (while (and (> n 0) - (if up (gnus-summary-go-up-thread) - (gnus-summary-go-down-thread))) - (setq n (1- n))) - (gnus-summary-position-point) - (when (/= 0 n) - (gnus-message 7 "Can't go further")) - n)) - -(defun gnus-summary-up-thread (n) - "Go up thread N steps. -If N is negative, go down instead. -Returns the difference between N and how many steps down that were -taken." - (interactive "p") - (gnus-summary-down-thread (- n))) - -(defun gnus-summary-top-thread () - "Go to the top of the thread." - (interactive) - (while (gnus-summary-go-up-thread)) - (gnus-summary-article-number)) - -(defun gnus-summary-kill-thread (&optional unmark) - "Mark articles under current thread as read. -If the prefix argument is positive, remove any kinds of marks. -If the prefix argument is negative, tick articles instead." - (interactive "P") - (when unmark - (setq unmark (prefix-numeric-value unmark))) - (let ((articles (gnus-summary-articles-in-thread))) - (save-excursion - ;; Expand the thread. - (gnus-summary-show-thread) - ;; Mark all the articles. - (while articles - (gnus-summary-goto-subject (car articles)) - (cond ((null unmark) - (gnus-summary-mark-article-as-read gnus-killed-mark)) - ((> unmark 0) - (gnus-summary-mark-article-as-unread gnus-unread-mark)) - (t - (gnus-summary-mark-article-as-unread gnus-ticked-mark))) - (setq articles (cdr articles)))) - ;; Hide killed subtrees. - (and (null unmark) - gnus-thread-hide-killed - (gnus-summary-hide-thread)) - ;; If marked as read, go to next unread subject. - (when (null unmark) - ;; Go to next unread subject. - (gnus-summary-next-subject 1 t))) - (gnus-set-mode-line 'summary)) - -;; Summary sorting commands - -(defun gnus-summary-sort-by-number (&optional reverse) - "Sort the summary buffer by article number. -Argument REVERSE means reverse order." - (interactive "P") - (gnus-summary-sort 'number reverse)) - -(defun gnus-summary-sort-by-random (&optional reverse) - "Randomize the order in the summary buffer. -Argument REVERSE means to randomize in reverse order." - (interactive "P") - (gnus-summary-sort 'random reverse)) - -(defun gnus-summary-sort-by-author (&optional reverse) - "Sort the summary buffer by author name alphabetically. -If `case-fold-search' is non-nil, case of letters is ignored. -Argument REVERSE means reverse order." - (interactive "P") - (gnus-summary-sort 'author reverse)) - -(defun gnus-summary-sort-by-subject (&optional reverse) - "Sort the summary buffer by subject alphabetically. `Re:'s are ignored. -If `case-fold-search' is non-nil, case of letters is ignored. -Argument REVERSE means reverse order." - (interactive "P") - (gnus-summary-sort 'subject reverse)) - -(defun gnus-summary-sort-by-date (&optional reverse) - "Sort the summary buffer by date. -Argument REVERSE means reverse order." - (interactive "P") - (gnus-summary-sort 'date reverse)) - -(defun gnus-summary-sort-by-score (&optional reverse) - "Sort the summary buffer by score. -Argument REVERSE means reverse order." - (interactive "P") - (gnus-summary-sort 'score reverse)) - -(defun gnus-summary-sort-by-lines (&optional reverse) - "Sort the summary buffer by the number of lines. -Argument REVERSE means reverse order." - (interactive "P") - (gnus-summary-sort 'lines reverse)) - -(defun gnus-summary-sort-by-chars (&optional reverse) - "Sort the summary buffer by article length. -Argument REVERSE means reverse order." - (interactive "P") - (gnus-summary-sort 'chars reverse)) - -(defun gnus-summary-sort-by-original (&optional reverse) - "Sort the summary buffer using the default sorting method. -Argument REVERSE means reverse order." - (interactive "P") - (let* ((buffer-read-only) - (gnus-summary-prepare-hook nil)) - ;; We do the sorting by regenerating the threads. - (gnus-summary-prepare) - ;; Hide subthreads if needed. - (gnus-summary-maybe-hide-threads))) - -(defun gnus-summary-sort (predicate reverse) - "Sort summary buffer by PREDICATE. REVERSE means reverse order." - (let* ((thread (intern (format "gnus-thread-sort-by-%s" predicate))) - (article (intern (format "gnus-article-sort-by-%s" predicate))) - (gnus-thread-sort-functions - (if (not reverse) - thread - `(lambda (t1 t2) - (,thread t2 t1)))) - (gnus-sort-gathered-threads-function - gnus-thread-sort-functions) - (gnus-article-sort-functions - (if (not reverse) - article - `(lambda (t1 t2) - (,article t2 t1)))) - (buffer-read-only) - (gnus-summary-prepare-hook nil)) - ;; We do the sorting by regenerating the threads. - (gnus-summary-prepare) - ;; Hide subthreads if needed. - (gnus-summary-maybe-hide-threads))) - -;; Summary saving commands. - -(defun gnus-summary-save-article (&optional n not-saved) - "Save the current article using the default saver function. -If N is a positive number, save the N next articles. -If N is a negative number, save the N previous articles. -If N is nil and any articles have been marked with the process mark, -save those articles instead. -The variable `gnus-default-article-saver' specifies the saver function. - -If the optional second argument NOT-SAVED is non-nil, articles saved -will not be marked as saved." - (interactive "P") - (require 'gnus-art) - (let* ((articles (gnus-summary-work-articles n)) - (save-buffer (save-excursion - (nnheader-set-temp-buffer " *Gnus Save*"))) - (num (length articles)) - ;; Whether to save decoded articles or raw articles. - (decode (when gnus-article-save-coding-system - (get gnus-default-article-saver :decode))) - ;; When saving many articles in a single file, use the other - ;; function to save articles other than the first one. - (saver2 (get gnus-default-article-saver :function)) - (gnus-prompt-before-saving (if saver2 - t - gnus-prompt-before-saving)) - (gnus-default-article-saver gnus-default-article-saver) - header file) - (dolist (article articles) - (setq header (gnus-summary-article-header article)) - (if (not (vectorp header)) - ;; This is a pseudo-article. - (if (assq 'name header) - (gnus-copy-file (cdr (assq 'name header))) - (gnus-message 1 "Article %d is unsaveable" article)) - ;; This is a real article. - (save-window-excursion - (let ((gnus-display-mime-function (when decode - gnus-display-mime-function)) - (gnus-article-prepare-hook (when decode - gnus-article-prepare-hook))) - (gnus-summary-select-article t nil nil article) - (gnus-summary-goto-subject article))) - (save-excursion - (set-buffer save-buffer) - (erase-buffer) - (insert-buffer-substring (if decode - gnus-article-buffer - gnus-original-article-buffer))) - (setq file (gnus-article-save save-buffer file num)) - (gnus-summary-remove-process-mark article) - (unless not-saved - (gnus-summary-set-saved-mark article))) - (when saver2 - (setq gnus-default-article-saver saver2 - saver2 nil))) - (gnus-kill-buffer save-buffer) - (gnus-summary-position-point) - (gnus-set-mode-line 'summary) - n)) - -(defun gnus-summary-pipe-output (&optional arg headers) - "Pipe the current article to a subprocess. -If N is a positive number, pipe the N next articles. -If N is a negative number, pipe the N previous articles. -If N is nil and any articles have been marked with the process mark, -pipe those articles instead. -If HEADERS (the symbolic prefix), include the headers, too." - (interactive (gnus-interactive "P\ny")) - (require 'gnus-art) - (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe) - (gnus-save-all-headers (or headers gnus-save-all-headers))) - (gnus-summary-save-article arg t)) - (let ((buffer (get-buffer "*Shell Command Output*"))) - (when (and buffer - (not (zerop (buffer-size buffer)))) - (gnus-configure-windows 'pipe)))) - -(defun gnus-summary-save-article-mail (&optional arg) - "Append the current article to a Unix mail box file. -If N is a positive number, save the N next articles. -If N is a negative number, save the N previous articles. -If N is nil and any articles have been marked with the process mark, -save those articles instead." - (interactive "P") - (require 'gnus-art) - (let ((gnus-default-article-saver 'gnus-summary-save-in-mail)) - (gnus-summary-save-article arg))) - -(defun gnus-summary-save-article-rmail (&optional arg) - "Append the current article to an rmail file. -If N is a positive number, save the N next articles. -If N is a negative number, save the N previous articles. -If N is nil and any articles have been marked with the process mark, -save those articles instead." - (interactive "P") - (require 'gnus-art) - (let ((gnus-default-article-saver 'gnus-summary-save-in-rmail)) - (gnus-summary-save-article arg))) - -(defun gnus-summary-save-article-file (&optional arg) - "Append the current article to a file. -If N is a positive number, save the N next articles. -If N is a negative number, save the N previous articles. -If N is nil and any articles have been marked with the process mark, -save those articles instead." - (interactive "P") - (require 'gnus-art) - (let ((gnus-default-article-saver 'gnus-summary-save-in-file)) - (gnus-summary-save-article arg))) - -(defun gnus-summary-write-article-file (&optional arg) - "Write the current article to a file, deleting the previous file. -If N is a positive number, save the N next articles. -If N is a negative number, save the N previous articles. -If N is nil and any articles have been marked with the process mark, -save those articles instead." - (interactive "P") - (require 'gnus-art) - (let ((gnus-default-article-saver 'gnus-summary-write-to-file)) - (gnus-summary-save-article arg))) - -(defun gnus-summary-save-article-body-file (&optional arg) - "Append the current article body to a file. -If N is a positive number, save the N next articles. -If N is a negative number, save the N previous articles. -If N is nil and any articles have been marked with the process mark, -save those articles instead." - (interactive "P") - (require 'gnus-art) - (let ((gnus-default-article-saver 'gnus-summary-save-body-in-file)) - (gnus-summary-save-article arg))) - -(defun gnus-summary-write-article-body-file (&optional arg) - "Write the current article body to a file, deleting the previous file. -If N is a positive number, save the N next articles. -If N is a negative number, save the N previous articles. -If N is nil and any articles have been marked with the process mark, -save those articles instead." - (interactive "P") - (require 'gnus-art) - (let ((gnus-default-article-saver 'gnus-summary-write-body-to-file)) - (gnus-summary-save-article arg))) - -(defun gnus-summary-muttprint (&optional arg) - "Print the current article using Muttprint. -If N is a positive number, save the N next articles. -If N is a negative number, save the N previous articles. -If N is nil and any articles have been marked with the process mark, -save those articles instead." - (interactive "P") - (require 'gnus-art) - (let ((gnus-default-article-saver 'gnus-summary-pipe-to-muttprint)) - (gnus-summary-save-article arg t))) - -(defun gnus-summary-pipe-message (program) - "Pipe the current article through PROGRAM." - (interactive "sProgram: ") - (gnus-summary-select-article) - (let ((mail-header-separator "")) - (gnus-eval-in-buffer-window gnus-article-buffer - (save-restriction - (widen) - (let ((start (window-start)) - buffer-read-only) - (message-pipe-buffer-body program) - (set-window-start (get-buffer-window (current-buffer)) start)))))) - -(defun gnus-get-split-value (methods) - "Return a value based on the split METHODS." - (let (split-name method result match) - (when methods - (save-excursion - (set-buffer gnus-original-article-buffer) - (save-restriction - (nnheader-narrow-to-headers) - (while (and methods (not split-name)) - (goto-char (point-min)) - (setq method (pop methods)) - (setq match (car method)) - (when (cond - ((stringp match) - ;; Regular expression. - (ignore-errors - (re-search-forward match nil t))) - ((functionp match) - ;; Function. - (save-restriction - (widen) - (setq result (funcall match gnus-newsgroup-name)))) - ((consp match) - ;; Form. - (save-restriction - (widen) - (setq result (eval match))))) - (setq split-name (cdr method)) - (cond ((stringp result) - (push (expand-file-name - result gnus-article-save-directory) - split-name)) - ((consp result) - (setq split-name (append result split-name))))))))) - (nreverse split-name))) - -(defun gnus-valid-move-group-p (group) - (and (boundp group) - (symbol-name group) - (symbol-value group) - (gnus-get-function (gnus-find-method-for-group - (symbol-name group)) 'request-accept-article t))) - -(defun gnus-read-move-group-name (prompt default articles prefix) - "Read a group name." - (let* ((split-name (gnus-get-split-value gnus-move-split-methods)) - (minibuffer-confirm-incomplete nil) ; XEmacs - (prom - (format "%s %s to" - prompt - (if (> (length articles) 1) - (format "these %d articles" (length articles)) - "this article"))) - (to-newsgroup - (cond - ((null split-name) - (gnus-completing-read-with-default - default prom - gnus-active-hashtb - 'gnus-valid-move-group-p - nil prefix - 'gnus-group-history)) - ((= 1 (length split-name)) - (gnus-completing-read-with-default - (car split-name) prom - gnus-active-hashtb - 'gnus-valid-move-group-p - nil nil - 'gnus-group-history)) - (t - (gnus-completing-read-with-default - nil prom - (mapcar (lambda (el) (list el)) - (nreverse split-name)) - nil nil nil - 'gnus-group-history)))) - (to-method (gnus-server-to-method (gnus-group-method to-newsgroup)))) - (when to-newsgroup - (if (or (string= to-newsgroup "") - (string= to-newsgroup prefix)) - (setq to-newsgroup default)) - (unless to-newsgroup - (error "No group name entered")) - (or (gnus-active to-newsgroup) - (gnus-activate-group to-newsgroup nil nil to-method) - (if (gnus-y-or-n-p (format "No such group: %s. Create it? " - to-newsgroup)) - (or (and (gnus-request-create-group to-newsgroup to-method) - (gnus-activate-group - to-newsgroup nil nil to-method) - (gnus-subscribe-group to-newsgroup)) - (error "Couldn't create group %s" to-newsgroup))) - (error "No such group: %s" to-newsgroup))) - to-newsgroup)) - -(defun gnus-summary-save-parts (type dir n &optional reverse) - "Save parts matching TYPE to DIR. -If REVERSE, save parts that do not match TYPE." - (interactive - (list (read-string "Save parts of type: " - (or (car gnus-summary-save-parts-type-history) - gnus-summary-save-parts-default-mime) - 'gnus-summary-save-parts-type-history) - (setq gnus-summary-save-parts-last-directory - (read-file-name "Save to directory: " - gnus-summary-save-parts-last-directory - nil t)) - current-prefix-arg)) - (gnus-summary-iterate n - (let ((gnus-display-mime-function nil) - (gnus-inhibit-treatment t)) - (gnus-summary-select-article)) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((handles (or gnus-article-mime-handles - (mm-dissect-buffer nil gnus-article-loose-mime) - (and gnus-article-emulate-mime - (mm-uu-dissect))))) - (when handles - (gnus-summary-save-parts-1 type dir handles reverse) - (unless gnus-article-mime-handles ;; Don't destroy this case. - (mm-destroy-parts handles))))))) - -(defun gnus-summary-save-parts-1 (type dir handle reverse) - (if (stringp (car handle)) - (mapcar (lambda (h) (gnus-summary-save-parts-1 type dir h reverse)) - (cdr handle)) - (when (if reverse - (not (string-match type (mm-handle-media-type handle))) - (string-match type (mm-handle-media-type handle))) - (let ((file (expand-file-name - (gnus-map-function - mm-file-name-rewrite-functions - (file-name-nondirectory - (or - (mail-content-type-get - (mm-handle-disposition handle) 'filename) - (mail-content-type-get - (mm-handle-type handle) 'name) - (concat gnus-newsgroup-name - "." (number-to-string - (cdr gnus-article-current)))))) - dir))) - (unless (file-exists-p file) - (mm-save-part-to-file handle file)))))) - -;; Summary extract commands - -(defun gnus-summary-insert-pseudos (pslist &optional not-view) - (let ((buffer-read-only nil) - (article (gnus-summary-article-number)) - after-article b e) - (unless (gnus-summary-goto-subject article) - (error "No such article: %d" article)) - (gnus-summary-position-point) - ;; If all commands are to be bunched up on one line, we collect - ;; them here. - (unless gnus-view-pseudos-separately - (let ((ps (setq pslist (sort pslist 'gnus-pseudos<))) - files action) - (while ps - (setq action (cdr (assq 'action (car ps)))) - (setq files (list (cdr (assq 'name (car ps))))) - (while (and ps (cdr ps) - (string= (or action "1") - (or (cdr (assq 'action (cadr ps))) "2"))) - (push (cdr (assq 'name (cadr ps))) files) - (setcdr ps (cddr ps))) - (when files - (when (not (string-match "%s" action)) - (push " " files)) - (push " " files) - (when (assq 'execute (car ps)) - (setcdr (assq 'execute (car ps)) - (funcall (if (string-match "%s" action) - 'format 'concat) - action - (mapconcat - (lambda (f) - (if (equal f " ") - f - (mm-quote-arg f))) - files " "))))) - (setq ps (cdr ps))))) - (if (and gnus-view-pseudos (not not-view)) - (while pslist - (when (assq 'execute (car pslist)) - (gnus-execute-command (cdr (assq 'execute (car pslist))) - (eq gnus-view-pseudos 'not-confirm))) - (setq pslist (cdr pslist))) - (save-excursion - (while pslist - (setq after-article (or (cdr (assq 'article (car pslist))) - (gnus-summary-article-number))) - (gnus-summary-goto-subject after-article) - (forward-line 1) - (setq b (point)) - (insert " " (file-name-nondirectory - (cdr (assq 'name (car pslist)))) - ": " (or (cdr (assq 'execute (car pslist))) "") "\n") - (setq e (point)) - (forward-line -1) ; back to `b' - (gnus-add-text-properties - b (1- e) (list 'gnus-number gnus-reffed-article-number - gnus-mouse-face-prop gnus-mouse-face)) - (gnus-data-enter - after-article gnus-reffed-article-number - gnus-unread-mark b (car pslist) 0 (- e b)) - (setq gnus-newsgroup-unreads - (gnus-add-to-sorted-list gnus-newsgroup-unreads - gnus-reffed-article-number)) - (setq gnus-reffed-article-number (1- gnus-reffed-article-number)) - (setq pslist (cdr pslist))))))) - -(defun gnus-pseudos< (p1 p2) - (let ((c1 (cdr (assq 'action p1))) - (c2 (cdr (assq 'action p2)))) - (and c1 c2 (string< c1 c2)))) - -(defun gnus-request-pseudo-article (props) - (cond ((assq 'execute props) - (gnus-execute-command (cdr (assq 'execute props))))) - (let ((gnus-current-article (gnus-summary-article-number))) - (gnus-run-hooks 'gnus-mark-article-hook))) - -(defun gnus-execute-command (command &optional automatic) - (save-excursion - (gnus-article-setup-buffer) - (set-buffer gnus-article-buffer) - (setq buffer-read-only nil) - (let ((command (if automatic command - (read-string "Command: " (cons command 0))))) - (erase-buffer) - (insert "$ " command "\n\n") - (if gnus-view-pseudo-asynchronously - (start-process "gnus-execute" (current-buffer) shell-file-name - shell-command-switch command) - (call-process shell-file-name nil t nil - shell-command-switch command))))) - -;; Summary kill commands. - -(defun gnus-summary-edit-global-kill (article) - "Edit the \"global\" kill file." - (interactive (list (gnus-summary-article-number))) - (gnus-group-edit-global-kill article)) - -(defun gnus-summary-edit-local-kill () - "Edit a local kill file applied to the current newsgroup." - (interactive) - (setq gnus-current-headers (gnus-summary-article-header)) - (gnus-group-edit-local-kill - (gnus-summary-article-number) gnus-newsgroup-name)) - -;;; Header reading. - -(defun gnus-read-header (id &optional header) - "Read the headers of article ID and enter them into the Gnus system." - (let ((group gnus-newsgroup-name) - (gnus-override-method - (or - gnus-override-method - (and (gnus-news-group-p gnus-newsgroup-name) - (car (gnus-refer-article-methods))))) - where) - ;; First we check to see whether the header in question is already - ;; fetched. - (if (stringp id) - ;; This is a Message-ID. - (setq header (or header (gnus-id-to-header id))) - ;; This is an article number. - (setq header (or header (gnus-summary-article-header id)))) - (if (and header - (not (gnus-summary-article-sparse-p (mail-header-number header)))) - ;; We have found the header. - header - ;; We have to really fetch the header to this article. - (save-excursion - (set-buffer nntp-server-buffer) - (when (setq where (gnus-request-head id group)) - (nnheader-fold-continuation-lines) - (goto-char (point-max)) - (insert ".\n") - (goto-char (point-min)) - (insert "211 ") - (princ (cond - ((numberp id) id) - ((cdr where) (cdr where)) - (header (mail-header-number header)) - (t gnus-reffed-article-number)) - (current-buffer)) - (insert " Article retrieved.\n")) - (if (or (not where) - (not (setq header (car (gnus-get-newsgroup-headers nil t))))) - () ; Malformed head. - (unless (gnus-summary-article-sparse-p (mail-header-number header)) - (when (and (stringp id) - (not (string= (gnus-group-real-name group) - (car where)))) - ;; If we fetched by Message-ID and the article came - ;; from a different group, we fudge some bogus article - ;; numbers for this article. - (mail-header-set-number header gnus-reffed-article-number)) - (save-excursion - (set-buffer gnus-summary-buffer) - (decf gnus-reffed-article-number) - (gnus-remove-header (mail-header-number header)) - (push header gnus-newsgroup-headers) - (setq gnus-current-headers header) - (push (mail-header-number header) gnus-newsgroup-limit))) - header))))) - -(defun gnus-remove-header (number) - "Remove header NUMBER from `gnus-newsgroup-headers'." - (if (and gnus-newsgroup-headers - (= number (mail-header-number (car gnus-newsgroup-headers)))) - (pop gnus-newsgroup-headers) - (let ((headers gnus-newsgroup-headers)) - (while (and (cdr headers) - (not (= number (mail-header-number (cadr headers))))) - (pop headers)) - (when (cdr headers) - (setcdr headers (cddr headers)))))) - -;;; -;;; summary highlights -;;; - -(defun gnus-highlight-selected-summary () - "Highlight selected article in summary buffer." - ;; Added by Per Abrahamsen . - (when gnus-summary-selected-face - (save-excursion - (let* ((beg (gnus-point-at-bol)) - (end (gnus-point-at-eol)) - ;; Fix by Mike Dugan . - (from (if (get-text-property beg gnus-mouse-face-prop) - beg - (or (next-single-property-change - beg gnus-mouse-face-prop nil end) - beg))) - (to - (if (= from end) - (- from 2) - (or (next-single-property-change - from gnus-mouse-face-prop nil end) - end)))) - ;; If no mouse-face prop on line we will have to = from = end, - ;; so we highlight the entire line instead. - (when (= (+ to 2) from) - (setq from beg) - (setq to end)) - (if gnus-newsgroup-selected-overlay - ;; Move old overlay. - (gnus-move-overlay - gnus-newsgroup-selected-overlay from to (current-buffer)) - ;; Create new overlay. - (gnus-overlay-put - (setq gnus-newsgroup-selected-overlay (gnus-make-overlay from to)) - 'face gnus-summary-selected-face)))))) - -(defvar gnus-summary-highlight-line-cached nil) -(defvar gnus-summary-highlight-line-trigger nil) - -(defun gnus-summary-highlight-line-0 () - (if (and (eq gnus-summary-highlight-line-trigger - gnus-summary-highlight) - gnus-summary-highlight-line-cached) - gnus-summary-highlight-line-cached - (setq gnus-summary-highlight-line-trigger gnus-summary-highlight - gnus-summary-highlight-line-cached - (let* ((cond (list 'cond)) - (c cond) - (list gnus-summary-highlight)) - (while list - (setcdr c (cons (list (caar list) (list 'quote (cdar list))) - nil)) - (setq c (cdr c) - list (cdr list))) - (gnus-byte-compile (list 'lambda nil cond)))))) - -(defun gnus-summary-highlight-line () - "Highlight current line according to `gnus-summary-highlight'." - (let* ((beg (gnus-point-at-bol)) - (article (or (gnus-summary-article-number) gnus-current-article)) - (score (or (cdr (assq article - gnus-newsgroup-scored)) - gnus-summary-default-score 0)) - (mark (or (gnus-summary-article-mark) gnus-unread-mark)) - (inhibit-read-only t) - (default gnus-summary-default-score) - (default-high gnus-summary-default-high-score) - (default-low gnus-summary-default-low-score) - (uncached (and gnus-summary-use-undownloaded-faces - (memq article gnus-newsgroup-undownloaded) - (not (memq article gnus-newsgroup-cached))))) - (let ((face (funcall (gnus-summary-highlight-line-0)))) - (unless (eq face (get-text-property beg 'face)) - (gnus-put-text-property-excluding-characters-with-faces - beg (gnus-point-at-eol) 'face - (setq face (if (boundp face) (symbol-value face) face))) - (when gnus-summary-highlight-line-function - (funcall gnus-summary-highlight-line-function article face)))))) - -(defun gnus-update-read-articles (group unread &optional compute) - "Update the list of read articles in GROUP. -UNREAD is a sorted list." - (let* ((active (or gnus-newsgroup-active (gnus-active group))) - (entry (gnus-gethash group gnus-newsrc-hashtb)) - (info (nth 2 entry)) - (prev 1) - read) - (if (or (not info) (not active)) - ;; There is no info on this group if it was, in fact, - ;; killed. Gnus stores no information on killed groups, so - ;; there's nothing to be done. - ;; One could store the information somewhere temporarily, - ;; perhaps... Hmmm... - () - ;; Remove any negative articles numbers. - (while (and unread (< (car unread) 0)) - (setq unread (cdr unread))) - ;; Remove any expired article numbers - (while (and unread (< (car unread) (car active))) - (setq unread (cdr unread))) - ;; Compute the ranges of read articles by looking at the list of - ;; unread articles. - (while unread - (when (/= (car unread) prev) - (push (if (= prev (1- (car unread))) prev - (cons prev (1- (car unread)))) - read)) - (setq prev (1+ (car unread))) - (setq unread (cdr unread))) - (when (<= prev (cdr active)) - (push (cons prev (cdr active)) read)) - (setq read (if (> (length read) 1) (nreverse read) read)) - (if compute - read - (save-excursion - (let (setmarkundo) - ;; Propagate the read marks to the backend. - (when (gnus-check-backend-function 'request-set-mark group) - (let ((del (gnus-remove-from-range (gnus-info-read info) read)) - (add (gnus-remove-from-range read (gnus-info-read info)))) - (when (or add del) - (unless (gnus-check-group group) - (error "Can't open server for %s" group)) - (gnus-request-set-mark - group (delq nil (list (if add (list add 'add '(read))) - (if del (list del 'del '(read)))))) - (setq setmarkundo - `(gnus-request-set-mark - ,group - ',(delq nil (list - (if del (list del 'add '(read))) - (if add (list add 'del '(read)))))))))) - (set-buffer gnus-group-buffer) - (gnus-undo-register - `(progn - (gnus-info-set-marks ',info ',(gnus-info-marks info) t) - (gnus-info-set-read ',info ',(gnus-info-read info)) - (gnus-get-unread-articles-in-group ',info - (gnus-active ,group)) - (gnus-group-update-group ,group t) - ,setmarkundo)))) - ;; Enter this list into the group info. - (gnus-info-set-read info read) - ;; Set the number of unread articles in gnus-newsrc-hashtb. - (gnus-get-unread-articles-in-group info (gnus-active group)) - t)))) - -(defun gnus-offer-save-summaries () - "Offer to save all active summary buffers." - (let (buffers) - ;; Go through all buffers and find all summaries. - (dolist (buffer (buffer-list)) - (when (and (setq buffer (buffer-name buffer)) - (string-match "Summary" buffer) - (save-excursion - (set-buffer buffer) - ;; We check that this is, indeed, a summary buffer. - (and (eq major-mode 'gnus-summary-mode) - ;; Also make sure this isn't bogus. - gnus-newsgroup-prepared - ;; Also make sure that this isn't a - ;; dead summary buffer. - (not gnus-dead-summary-mode)))) - (push buffer buffers))) - ;; Go through all these summary buffers and offer to save them. - (when buffers - (save-excursion - (map-y-or-n-p - "Update summary buffer %s? " - (lambda (buf) - (switch-to-buffer buf) - (gnus-summary-exit)) - buffers))))) - -(defun gnus-summary-setup-default-charset () - "Setup newsgroup default charset." - (if (member gnus-newsgroup-name '("nndraft:delayed" "nndraft:drafts")) - (setq gnus-newsgroup-charset nil) - (let* ((ignored-charsets - (or gnus-newsgroup-ephemeral-ignored-charsets - (append - (and gnus-newsgroup-name - (gnus-parameter-ignored-charsets gnus-newsgroup-name)) - gnus-newsgroup-ignored-charsets)))) - (setq gnus-newsgroup-charset - (or gnus-newsgroup-ephemeral-charset - (and gnus-newsgroup-name - (gnus-parameter-charset gnus-newsgroup-name)) - gnus-default-charset)) - (set (make-local-variable 'gnus-newsgroup-ignored-charsets) - ignored-charsets)))) - -;;; -;;; Mime Commands -;;; - -(defun gnus-summary-display-buttonized (&optional show-all-parts) - "Display the current article buffer fully MIME-buttonized. -If SHOW-ALL-PARTS (the prefix) is non-nil, all multipart/* parts are -treated as multipart/mixed." - (interactive "P") - (require 'gnus-art) - (let ((gnus-unbuttonized-mime-types nil) - (gnus-mime-display-multipart-as-mixed show-all-parts)) - (gnus-summary-show-article))) - -(defun gnus-summary-repair-multipart (article) - "Add a Content-Type header to a multipart article without one." - (interactive (list (gnus-summary-article-number))) - (gnus-with-article article - (message-narrow-to-head) - (message-remove-header "Mime-Version") - (goto-char (point-max)) - (insert "Mime-Version: 1.0\n") - (widen) - (when (search-forward "\n--" nil t) - (let ((separator (buffer-substring (point) (gnus-point-at-eol)))) - (message-narrow-to-head) - (message-remove-header "Content-Type") - (goto-char (point-max)) - (insert (format "Content-Type: multipart/mixed; boundary=\"%s\"\n" - separator)) - (widen)))) - (let (gnus-mark-article-hook) - (gnus-summary-select-article t t nil article))) - -(defun gnus-summary-toggle-display-buttonized () - "Toggle the buttonizing of the article buffer." - (interactive) - (require 'gnus-art) - (if (setq gnus-inhibit-mime-unbuttonizing - (not gnus-inhibit-mime-unbuttonizing)) - (let ((gnus-unbuttonized-mime-types nil)) - (gnus-summary-show-article)) - (gnus-summary-show-article))) - -;;; -;;; Generic summary marking commands -;;; - -(defvar gnus-summary-marking-alist - '((read gnus-del-mark "d") - (unread gnus-unread-mark "u") - (ticked gnus-ticked-mark "!") - (dormant gnus-dormant-mark "?") - (expirable gnus-expirable-mark "e")) - "An alist of names/marks/keystrokes.") - -(defvar gnus-summary-generic-mark-map (make-sparse-keymap)) -(defvar gnus-summary-mark-map) - -(defun gnus-summary-make-all-marking-commands () - (define-key gnus-summary-mark-map "M" gnus-summary-generic-mark-map) - (dolist (elem gnus-summary-marking-alist) - (apply 'gnus-summary-make-marking-command elem))) - -(defun gnus-summary-make-marking-command (name mark keystroke) - (let ((map (make-sparse-keymap))) - (define-key gnus-summary-generic-mark-map keystroke map) - (dolist (lway `((next "next" next nil "n") - (next-unread "next unread" next t "N") - (prev "previous" prev nil "p") - (prev-unread "previous unread" prev t "P") - (nomove "" nil nil ,keystroke))) - (let ((func (gnus-summary-make-marking-command-1 - mark (car lway) lway name))) - (setq func (eval func)) - (define-key map (nth 4 lway) func))))) - -(defun gnus-summary-make-marking-command-1 (mark way lway name) - `(defun ,(intern - (format "gnus-summary-put-mark-as-%s%s" - name (if (eq way 'nomove) - "" - (concat "-" (symbol-name way))))) - (n) - ,(format - "Mark the current article as %s%s. -If N, the prefix, then repeat N times. -If N is negative, move in reverse order. -The difference between N and the actual number of articles marked is -returned." - name (cadr lway)) - (interactive "p") - (gnus-summary-generic-mark n ,mark ',(nth 2 lway) ,(nth 3 lway)))) - -(defun gnus-summary-generic-mark (n mark move unread) - "Mark N articles with MARK." - (unless (eq major-mode 'gnus-summary-mode) - (error "This command can only be used in the summary buffer")) - (gnus-summary-show-thread) - (let ((nummove - (cond - ((eq move 'next) 1) - ((eq move 'prev) -1) - (t 0)))) - (if (zerop nummove) - (setq n 1) - (when (< n 0) - (setq n (abs n) - nummove (* -1 nummove)))) - (while (and (> n 0) - (gnus-summary-mark-article nil mark) - (zerop (gnus-summary-next-subject nummove unread t))) - (setq n (1- n))) - (when (/= 0 n) - (gnus-message 7 "No more %sarticles" (if mark "" "unread "))) - (gnus-summary-recenter) - (gnus-summary-position-point) - (gnus-set-mode-line 'summary) - n)) - -(defun gnus-summary-insert-articles (articles) - (when (setq articles - (gnus-sorted-difference articles - (mapcar (lambda (h) - (mail-header-number h)) - gnus-newsgroup-headers))) - (setq gnus-newsgroup-headers - (gnus-merge 'list - gnus-newsgroup-headers - (gnus-fetch-headers articles) - 'gnus-article-sort-by-number)) - ;; Suppress duplicates? - (when gnus-suppress-duplicates - (gnus-dup-suppress-articles)) - - ;; We might want to build some more threads first. - (when (and gnus-fetch-old-headers - (eq gnus-headers-retrieved-by 'nov)) - (if (eq gnus-fetch-old-headers 'invisible) - (gnus-build-all-threads) - (gnus-build-old-threads))) - ;; Let the Gnus agent mark articles as read. - (when gnus-agent - (gnus-agent-get-undownloaded-list)) - ;; Remove list identifiers from subject - (when gnus-list-identifiers - (gnus-summary-remove-list-identifiers)) - ;; First and last article in this newsgroup. - (when gnus-newsgroup-headers - (setq gnus-newsgroup-begin - (mail-header-number (car gnus-newsgroup-headers)) - gnus-newsgroup-end - (mail-header-number - (gnus-last-element gnus-newsgroup-headers)))) - (when gnus-use-scoring - (gnus-possibly-score-headers)))) - -(defun gnus-summary-insert-old-articles (&optional all) - "Insert all old articles in this group. -If ALL is non-nil, already read articles become readable. -If ALL is a number, fetch this number of articles." - (interactive "P") - (prog1 - (let ((old (sort (mapcar 'car gnus-newsgroup-data) '<)) - older len) - (setq older - ;; Some nntp servers lie about their active range. When - ;; this happens, the active range can be in the millions. - ;; Use a compressed range to avoid creating a huge list. - (gnus-range-difference (list gnus-newsgroup-active) old)) - (setq len (gnus-range-length older)) - (cond - ((null older) nil) - ((numberp all) - (if (< all len) - (let ((older-range (nreverse older))) - (setq older nil) - - (while (> all 0) - (let* ((r (pop older-range)) - (min (if (numberp r) r (car r))) - (max (if (numberp r) r (cdr r)))) - (while (and (<= min max) - (> all 0)) - (push max older) - (setq all (1- all) - max (1- max)))))) - (setq older (gnus-uncompress-range older)))) - (all - (setq older (gnus-uncompress-range older))) - (t - (when (and (numberp gnus-large-newsgroup) - (> len gnus-large-newsgroup)) - (let* ((cursor-in-echo-area nil) - (initial (gnus-parameter-large-newsgroup-initial - gnus-newsgroup-name)) - (input - (read-string - (format - "How many articles from %s (%s %d): " - (gnus-limit-string - (gnus-group-decoded-name gnus-newsgroup-name) 35) - (if initial "max" "default") - len) - (if initial - (cons (number-to-string initial) - 0))))) - (unless (string-match "^[ \t]*$" input) - (setq all (string-to-number input)) - (if (< all len) - (let ((older-range (nreverse older))) - (setq older nil) - - (while (> all 0) - (let* ((r (pop older-range)) - (min (if (numberp r) r (car r))) - (max (if (numberp r) r (cdr r)))) - (while (and (<= min max) - (> all 0)) - (push max older) - (setq all (1- all) - max (1- max)))))))))) - (setq older (gnus-uncompress-range older)))) - (if (not older) - (message "No old news.") - (gnus-summary-insert-articles older) - (gnus-summary-limit (gnus-sorted-nunion old older)))) - (gnus-summary-position-point))) - -(defun gnus-summary-insert-new-articles () - "Insert all new articles in this group." - (interactive) - (prog1 - (let ((old (sort (mapcar 'car gnus-newsgroup-data) '<)) - (old-active gnus-newsgroup-active) - (nnmail-fetched-sources (list t)) - i new) - (setq gnus-newsgroup-active - (gnus-activate-group gnus-newsgroup-name 'scan)) - (setq i (cdr gnus-newsgroup-active)) - (while (> i (cdr old-active)) - (push i new) - (decf i)) - (if (not new) - (message "No gnus is bad news.") - (gnus-summary-insert-articles new) - (setq gnus-newsgroup-unreads - (gnus-sorted-nunion gnus-newsgroup-unreads new)) - (gnus-summary-limit (gnus-sorted-nunion old new)))) - (gnus-summary-position-point))) - -(gnus-summary-make-all-marking-commands) - -(gnus-ems-redefine) - -(provide 'gnus-sum) - -(run-hooks 'gnus-sum-load-hook) - -;; Local Variables: -;; coding: iso-8859-1 -;; End: - -;; arch-tag: 17c6748f-6d00-4d36-bf01-835c42f31235 -;;; gnus-sum.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-topic.el b/xemacs-packages/gnus/lisp/gnus-topic.el deleted file mode 100644 index e2f85622..00000000 --- a/xemacs-packages/gnus/lisp/gnus-topic.el +++ /dev/null @@ -1,1776 +0,0 @@ -;;; gnus-topic.el --- a folding minor mode for Gnus group buffers - -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Ilja Weis -;; Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) -(require 'gnus-group) -(require 'gnus-start) -(require 'gnus-util) - -(defgroup gnus-topic nil - "Group topics." - :group 'gnus-group) - -(defvar gnus-topic-mode nil - "Minor mode for Gnus group buffers.") - -(defcustom gnus-topic-mode-hook nil - "Hook run in topic mode buffers." - :type 'hook - :group 'gnus-topic) - -(when (featurep 'xemacs) - (add-hook 'gnus-topic-mode-hook 'gnus-xmas-topic-menu-add)) - -(defcustom gnus-topic-line-format "%i[ %(%{%n%}%) -- %A ]%v\n" - "Format of topic lines. -It works along the same lines as a normal formatting string, -with some simple extensions. - -%i Indentation based on topic level. -%n Topic name. -%v Nothing if the topic is visible, \"...\" otherwise. -%g Number of groups in the topic. -%a Number of unread articles in the groups in the topic. -%A Number of unread articles in the groups in the topic and its subtopics. - -General format specifiers can also be used. -See Info node `(gnus)Formatting Variables'." - :link '(custom-manual "(gnus)Formatting Variables") - :type 'string - :group 'gnus-topic) - -(defcustom gnus-topic-indent-level 2 - "*How much each subtopic should be indented." - :type 'integer - :group 'gnus-topic) - -(defcustom gnus-topic-display-empty-topics t - "*If non-nil, display the topic lines even of topics that have no unread articles." - :type 'boolean - :group 'gnus-topic) - -;; Internal variables. - -(defvar gnus-topic-active-topology nil) -(defvar gnus-topic-active-alist nil) -(defvar gnus-topic-unreads nil) - -(defvar gnus-topology-checked-p nil - "Whether the topology has been checked in this session.") - -(defvar gnus-topic-killed-topics nil) -(defvar gnus-topic-inhibit-change-level nil) - -(defconst gnus-topic-line-format-alist - `((?n name ?s) - (?v visible ?s) - (?i indentation ?s) - (?g number-of-groups ?d) - (?a (gnus-topic-articles-in-topic entries) ?d) - (?A total-number-of-articles ?d) - (?l level ?d))) - -(defvar gnus-topic-line-format-spec nil) - -;;; Utility functions - -(defun gnus-group-topic-name () - "The name of the topic on the current line." - (let ((topic (get-text-property (gnus-point-at-bol) 'gnus-topic))) - (and topic (symbol-name topic)))) - -(defun gnus-group-topic-level () - "The level of the topic on the current line." - (get-text-property (gnus-point-at-bol) 'gnus-topic-level)) - -(defun gnus-group-topic-unread () - "The number of unread articles in topic on the current line." - (get-text-property (gnus-point-at-bol) 'gnus-topic-unread)) - -(defun gnus-topic-unread (topic) - "Return the number of unread articles in TOPIC." - (or (cdr (assoc topic gnus-topic-unreads)) - 0)) - -(defun gnus-group-topic-p () - "Return non-nil if the current line is a topic." - (gnus-group-topic-name)) - -(defun gnus-topic-visible-p () - "Return non-nil if the current topic is visible." - (get-text-property (gnus-point-at-bol) 'gnus-topic-visible)) - -(defun gnus-topic-articles-in-topic (entries) - (let ((total 0) - number) - (while entries - (when (numberp (setq number (car (pop entries)))) - (incf total number))) - total)) - -(defun gnus-group-topic (group) - "Return the topic GROUP is a member of." - (let ((alist gnus-topic-alist) - out) - (while alist - (when (member group (cdar alist)) - (setq out (caar alist) - alist nil)) - (setq alist (cdr alist))) - out)) - -(defun gnus-group-parent-topic (group) - "Return the topic GROUP is member of by looking at the group buffer." - (save-excursion - (set-buffer gnus-group-buffer) - (if (gnus-group-goto-group group) - (gnus-current-topic) - (gnus-group-topic group)))) - -(defun gnus-topic-goto-topic (topic) - (when topic - (gnus-goto-char (text-property-any (point-min) (point-max) - 'gnus-topic (intern topic))))) - -(defun gnus-topic-jump-to-topic (topic) - "Go to TOPIC." - (interactive - (list (completing-read "Go to topic: " - (mapcar 'list (gnus-topic-list)) - nil t))) - (dolist (topic (gnus-current-topics topic)) - (gnus-topic-goto-topic topic) - (gnus-topic-fold t)) - (gnus-topic-goto-topic topic)) - -(defun gnus-current-topic () - "Return the name of the current topic." - (let ((result - (or (get-text-property (point) 'gnus-topic) - (save-excursion - (and (gnus-goto-char (previous-single-property-change - (point) 'gnus-topic)) - (get-text-property (max (1- (point)) (point-min)) - 'gnus-topic)))))) - (when result - (symbol-name result)))) - -(defun gnus-current-topics (&optional topic) - "Return a list of all current topics, lowest in hierarchy first. -If TOPIC, start with that topic." - (let ((topic (or topic (gnus-current-topic))) - topics) - (while topic - (push topic topics) - (setq topic (gnus-topic-parent-topic topic))) - (nreverse topics))) - -(defun gnus-group-active-topic-p () - "Say whether the current topic comes from the active topics." - (save-excursion - (beginning-of-line) - (get-text-property (point) 'gnus-active))) - -(defun gnus-topic-find-groups (topic &optional level all lowest recursive) - "Return entries for all visible groups in TOPIC. -If RECURSIVE is t, return groups in its subtopics too." - (let ((groups (cdr (assoc topic gnus-topic-alist))) - info clevel unread group params visible-groups entry active) - (setq lowest (or lowest 1)) - (setq level (or level gnus-level-unsubscribed)) - ;; We go through the newsrc to look for matches. - (while groups - (when (setq group (pop groups)) - (setq entry (gnus-gethash group gnus-newsrc-hashtb) - info (nth 2 entry) - params (gnus-info-params info) - active (gnus-active group) - unread (or (car entry) - (and (not (equal group "dummy.group")) - active - (- (1+ (cdr active)) (car active)))) - clevel (or (gnus-info-level info) - (if (member group gnus-zombie-list) - gnus-level-zombie gnus-level-killed)))) - (and - info ; nil means that the group is dead. - (<= clevel level) - (>= clevel lowest) ; Is inside the level we want. - (or all - (if (or (eq unread t) - (eq unread nil)) - gnus-group-list-inactive-groups - (> unread 0)) - (and gnus-list-groups-with-ticked-articles - (cdr (assq 'tick (gnus-info-marks info)))) - ;; Has right readedness. - ;; Check for permanent visibility. - (and gnus-permanently-visible-groups - (string-match gnus-permanently-visible-groups group)) - (memq 'visible params) - (cdr (assq 'visible params))) - ;; Add this group to the list of visible groups. - (push (or entry group) visible-groups))) - (setq visible-groups (nreverse visible-groups)) - (when recursive - (if (eq recursive t) - (setq recursive (cdr (gnus-topic-find-topology topic)))) - (mapcar (lambda (topic-topology) - (setq visible-groups - (nconc visible-groups - (gnus-topic-find-groups - (caar topic-topology) - level all lowest topic-topology)))) - (cdr recursive))) - visible-groups)) - -(defun gnus-topic-goto-previous-topic (n) - "Go to the N'th previous topic." - (interactive "p") - (gnus-topic-goto-next-topic (- n))) - -(defun gnus-topic-goto-next-topic (n) - "Go to the N'th next topic." - (interactive "p") - (let ((backward (< n 0)) - (n (abs n)) - (topic (gnus-current-topic))) - (while (and (> n 0) - (setq topic - (if backward - (gnus-topic-previous-topic topic) - (gnus-topic-next-topic topic)))) - (gnus-topic-goto-topic topic) - (setq n (1- n))) - (when (/= 0 n) - (gnus-message 7 "No more topics")) - n)) - -(defun gnus-topic-previous-topic (topic) - "Return the previous topic on the same level as TOPIC." - (let ((top (cddr (gnus-topic-find-topology - (gnus-topic-parent-topic topic))))) - (unless (equal topic (caaar top)) - (while (and top (not (equal (caaadr top) topic))) - (setq top (cdr top))) - (caaar top)))) - -(defun gnus-topic-parent-topic (topic &optional topology) - "Return the parent of TOPIC." - (unless topology - (setq topology gnus-topic-topology)) - (let ((parent (car (pop topology))) - result found) - (while (and topology - (not (setq found (equal (caaar topology) topic))) - (not (setq result (gnus-topic-parent-topic - topic (car topology))))) - (setq topology (cdr topology))) - (or result (and found parent)))) - -(defun gnus-topic-next-topic (topic &optional previous) - "Return the next sibling of TOPIC." - (let ((parentt (cddr (gnus-topic-find-topology - (gnus-topic-parent-topic topic)))) - prev) - (while (and parentt - (not (equal (caaar parentt) topic))) - (setq prev (caaar parentt) - parentt (cdr parentt))) - (if previous - prev - (caaadr parentt)))) - -(defun gnus-topic-forward-topic (num) - "Go to the next topic on the same level as the current one." - (let* ((topic (gnus-current-topic)) - (way (if (< num 0) 'gnus-topic-previous-topic - 'gnus-topic-next-topic)) - (num (abs num))) - (while (and (not (zerop num)) - (setq topic (funcall way topic))) - (when (gnus-topic-goto-topic topic) - (decf num))) - (unless (zerop num) - (goto-char (point-max))) - num)) - -(defun gnus-topic-find-topology (topic &optional topology level remove) - "Return the topology of TOPIC." - (unless topology - (setq topology gnus-topic-topology) - (setq level 0)) - (let ((top topology) - result) - (if (equal (caar topology) topic) - (progn - (when remove - (delq topology remove)) - (cons level topology)) - (setq topology (cdr topology)) - (while (and topology - (not (setq result (gnus-topic-find-topology - topic (car topology) (1+ level) - (and remove top))))) - (setq topology (cdr topology))) - result))) - -(defvar gnus-tmp-topics nil) -(defun gnus-topic-list (&optional topology) - "Return a list of all topics in the topology." - (unless topology - (setq topology gnus-topic-topology - gnus-tmp-topics nil)) - (push (caar topology) gnus-tmp-topics) - (mapcar 'gnus-topic-list (cdr topology)) - gnus-tmp-topics) - -;;; Topic parameter jazz - -(defun gnus-topic-parameters (topic) - "Return the parameters for TOPIC." - (let ((top (gnus-topic-find-topology topic))) - (when top - (nth 3 (cadr top))))) - -(defun gnus-topic-set-parameters (topic parameters) - "Set the topic parameters of TOPIC to PARAMETERS." - (let ((top (gnus-topic-find-topology topic))) - (unless top - (error "No such topic: %s" topic)) - ;; We may have to extend if there is no parameters here - ;; to begin with. - (unless (nthcdr 2 (cadr top)) - (nconc (cadr top) (list nil))) - (unless (nthcdr 3 (cadr top)) - (nconc (cadr top) (list nil))) - (setcar (nthcdr 3 (cadr top)) parameters) - (gnus-dribble-enter - (format "(gnus-topic-set-parameters %S '%S)" topic parameters)))) - -(defun gnus-group-topic-parameters (group) - "Compute the group parameters for GROUP taking into account inheritance from topics." - (let ((params-list (copy-sequence (gnus-group-get-parameter group)))) - (save-excursion - (nconc params-list - (gnus-topic-hierarchical-parameters - ;; First we try to go to the group within the group - ;; buffer and find the topic for the group that way. - ;; This hopefully copes well with groups that are in - ;; more than one topic. Failing that (i.e. when the - ;; group isn't visible in the group buffer) we find a - ;; topic for the group via gnus-group-topic. - (or (and (gnus-group-goto-group group) - (gnus-current-topic)) - (gnus-group-topic group))))))) - -(defun gnus-topic-hierarchical-parameters (topic) - "Return a topic list computed for TOPIC." - (let ((topics (gnus-current-topics topic)) - params-list param out params) - (while topics - (push (gnus-topic-parameters (pop topics)) params-list)) - ;; We probably have lots of nil elements here, so - ;; we remove them. Probably faster than doing this "properly". - (setq params-list (delq nil params-list)) - ;; Now we have all the parameters, so we go through them - ;; and do inheritance in the obvious way. - (while (setq params (pop params-list)) - (while (setq param (pop params)) - (when (atom param) - (setq param (cons param t))) - ;; Override any old versions of this param. - (gnus-pull (car param) out) - (push param out))) - ;; Return the resulting parameter list. - out)) - -;;; General utility functions - -(defun gnus-topic-enter-dribble () - (gnus-dribble-enter - (format "(setq gnus-topic-topology '%S)" gnus-topic-topology))) - -;;; Generating group buffers - -(defun gnus-group-prepare-topics (level &optional predicate lowest - regexp list-topic topic-level) - "List all newsgroups with unread articles of level LEVEL or lower. -Use the `gnus-group-topics' to sort the groups. -If PREDICTE is a function, list groups that the function returns non-nil; -if it is t, list groups that have no unread articles. -If LOWEST is non-nil, list all newsgroups of level LOWEST or higher." - (set-buffer gnus-group-buffer) - (let ((buffer-read-only nil) - (lowest (or lowest 1)) - (not-in-list - (and gnus-group-listed-groups - (copy-sequence gnus-group-listed-groups)))) - - (gnus-update-format-specifications nil 'topic) - - (when (or (not gnus-topic-alist) - (not gnus-topology-checked-p)) - (gnus-topic-check-topology)) - - (unless list-topic - (erase-buffer)) - - ;; List dead groups? - (when (or gnus-group-listed-groups - (and (>= level gnus-level-zombie) - (<= lowest gnus-level-zombie))) - (gnus-group-prepare-flat-list-dead - (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) - gnus-level-zombie ?Z - regexp)) - - (when (or gnus-group-listed-groups - (and (>= level gnus-level-killed) - (<= lowest gnus-level-killed))) - (gnus-group-prepare-flat-list-dead - (setq gnus-killed-list (sort gnus-killed-list 'string<)) - gnus-level-killed ?K regexp) - (when not-in-list - (unless gnus-killed-hashtb - (gnus-make-hashtable-from-killed)) - (gnus-group-prepare-flat-list-dead - (gnus-remove-if (lambda (group) - (or (gnus-gethash group gnus-newsrc-hashtb) - (gnus-gethash group gnus-killed-hashtb))) - not-in-list) - gnus-level-killed ?K regexp))) - - ;; Use topics. - (prog1 - (when (or (< lowest gnus-level-zombie) - gnus-group-listed-groups) - (if list-topic - (let ((top (gnus-topic-find-topology list-topic))) - (gnus-topic-prepare-topic (cdr top) (car top) - (or topic-level level) predicate - nil lowest regexp)) - (gnus-topic-prepare-topic gnus-topic-topology 0 - (or topic-level level) predicate - nil lowest regexp))) - (gnus-group-set-mode-line) - (setq gnus-group-list-mode (cons level predicate)) - (gnus-run-hooks 'gnus-group-prepare-hook)))) - -(defun gnus-topic-prepare-topic (topicl level &optional list-level - predicate silent - lowest regexp) - "Insert TOPIC into the group buffer. -If SILENT, don't insert anything. Return the number of unread -articles in the topic and its subtopics." - (let* ((type (pop topicl)) - (entries (gnus-topic-find-groups - (car type) - (if gnus-group-listed-groups - gnus-level-killed - list-level) - (or predicate gnus-group-listed-groups - (cdr (assq 'visible - (gnus-topic-hierarchical-parameters - (car type))))) - (if gnus-group-listed-groups 0 lowest))) - (visiblep (and (eq (nth 1 type) 'visible) (not silent))) - (gnus-group-indentation - (make-string (* gnus-topic-indent-level level) ? )) - (beg (progn (beginning-of-line) (point))) - (topicl (reverse topicl)) - (all-entries entries) - (point-max (point-max)) - (unread 0) - (topic (car type)) - info entry end active tick) - ;; Insert any sub-topics. - (while topicl - (incf unread - (gnus-topic-prepare-topic - (pop topicl) (1+ level) list-level predicate - (not visiblep) lowest regexp))) - (setq end (point)) - (goto-char beg) - ;; Insert all the groups that belong in this topic. - (while (setq entry (pop entries)) - (when (if (stringp entry) - (gnus-group-prepare-logic - entry - (and - (or (not gnus-group-listed-groups) - (if (< list-level gnus-level-zombie) nil - (let ((entry-level - (if (member entry gnus-zombie-list) - gnus-level-zombie gnus-level-killed))) - (and (<= entry-level list-level) - (>= entry-level lowest))))) - (cond - ((stringp regexp) - (string-match regexp entry)) - ((functionp regexp) - (funcall regexp entry)) - ((null regexp) t) - (t nil)))) - (setq info (nth 2 entry)) - (gnus-group-prepare-logic - (gnus-info-group info) - (and (or (not gnus-group-listed-groups) - (let ((entry-level (gnus-info-level info))) - (and (<= entry-level list-level) - (>= entry-level lowest)))) - (or (not (functionp predicate)) - (funcall predicate info)) - (or (not (stringp regexp)) - (string-match regexp (gnus-info-group info)))))) - (when visiblep - (if (stringp entry) - ;; Dead groups. - (gnus-group-insert-group-line - entry (if (member entry gnus-zombie-list) - gnus-level-zombie gnus-level-killed) - nil (- (1+ (cdr (setq active (gnus-active entry)))) - (car active)) - nil) - ;; Living groups. - (when (setq info (nth 2 entry)) - (gnus-group-insert-group-line - (gnus-info-group info) - (gnus-info-level info) (gnus-info-marks info) - (car entry) (gnus-info-method info))))) - (when (and (listp entry) - (numberp (car entry))) - (incf unread (car entry))) - (when (listp entry) - (setq tick t)))) - (goto-char beg) - ;; Insert the topic line. - (when (and (not silent) - (or gnus-topic-display-empty-topics ;We want empty topics - (not (zerop unread)) ;Non-empty - tick ;Ticked articles - (/= point-max (point-max)))) ;Unactivated groups - (gnus-extent-start-open (point)) - (gnus-topic-insert-topic-line - (car type) visiblep - (not (eq (nth 2 type) 'hidden)) - level all-entries unread)) - (gnus-topic-update-unreads (car type) unread) - (when gnus-group-update-tool-bar - (gnus-put-text-property beg end 'point-entered - 'gnus-tool-bar-update) - (gnus-put-text-property beg end 'point-left - 'gnus-tool-bar-update)) - (goto-char end) - unread)) - -(defun gnus-topic-remove-topic (&optional insert total-remove hide in-level) - "Remove the current topic." - (let ((topic (gnus-group-topic-name)) - (level (gnus-group-topic-level)) - (beg (progn (beginning-of-line) (point))) - buffer-read-only) - (when topic - (while (and (zerop (forward-line 1)) - (> (or (gnus-group-topic-level) (1+ level)) level))) - (delete-region beg (point)) - ;; Do the change in this rather odd manner because it has been - ;; reported that some topics share parts of some lists, for some - ;; reason. I have been unable to determine why this is the - ;; case, but this hack seems to take care of things. - (let ((data (cadr (gnus-topic-find-topology topic)))) - (setcdr data - (list (if insert 'visible 'invisible) - (caddr data) - (cadddr data)))) - (if total-remove - (setq gnus-topic-alist - (delq (assoc topic gnus-topic-alist) gnus-topic-alist)) - (gnus-topic-insert-topic topic in-level))))) - -(defun gnus-topic-insert-topic (topic &optional level) - "Insert TOPIC." - (gnus-group-prepare-topics - (car gnus-group-list-mode) (cdr gnus-group-list-mode) - nil nil topic level)) - -(defun gnus-topic-fold (&optional insert topic) - "Remove/insert the current topic." - (let ((topic (or topic (gnus-group-topic-name)))) - (when topic - (save-excursion - (if (not (gnus-group-active-topic-p)) - (gnus-topic-remove-topic - (or insert (not (gnus-topic-visible-p)))) - (let ((gnus-topic-topology gnus-topic-active-topology) - (gnus-topic-alist gnus-topic-active-alist) - (gnus-group-list-mode (cons 5 t))) - (gnus-topic-remove-topic - (or insert (not (gnus-topic-visible-p))) nil nil 9) - (gnus-topic-enter-dribble))))))) - -(defun gnus-topic-insert-topic-line (name visiblep shownp level entries - &optional unread) - (let* ((visible (if visiblep "" "...")) - (indentation (make-string (* gnus-topic-indent-level level) ? )) - (total-number-of-articles unread) - (number-of-groups (length entries)) - (active-topic (eq gnus-topic-alist gnus-topic-active-alist)) - gnus-tmp-header) - (gnus-topic-update-unreads name unread) - (beginning-of-line) - ;; Insert the text. - (if shownp - (gnus-add-text-properties - (point) - (prog1 (1+ (point)) - (eval gnus-topic-line-format-spec)) - (list 'gnus-topic (intern name) - 'gnus-topic-level level - 'gnus-topic-unread unread - 'gnus-active active-topic - 'gnus-topic-visible visiblep))))) - -(defun gnus-topic-update-unreads (topic unreads) - (setq gnus-topic-unreads (delq (assoc topic gnus-topic-unreads) - gnus-topic-unreads)) - (push (cons topic unreads) gnus-topic-unreads)) - -(defun gnus-topic-update-topics-containing-group (group) - "Update all topics that have GROUP as a member." - (when (and (eq major-mode 'gnus-group-mode) - gnus-topic-mode) - (save-excursion - (let ((alist gnus-topic-alist)) - ;; This is probably not entirely correct. If a topic - ;; isn't shown, then it's not updated. But the updating - ;; should be performed in any case, since the topic's - ;; parent should be updated. Pfft. - (while alist - (when (and (member group (cdar alist)) - (gnus-topic-goto-topic (caar alist))) - (gnus-topic-update-topic-line (caar alist))) - (pop alist)))))) - -(defun gnus-topic-update-topic () - "Update all parent topics to the current group." - (when (and (eq major-mode 'gnus-group-mode) - gnus-topic-mode) - (let ((group (gnus-group-group-name)) - (m (point-marker)) - (buffer-read-only nil)) - (when (and group - (gnus-get-info group) - (gnus-topic-goto-topic (gnus-current-topic))) - (gnus-topic-update-topic-line (gnus-group-topic-name)) - (goto-char m) - (set-marker m nil) - (gnus-group-position-point))))) - -(defun gnus-topic-goto-missing-group (group) - "Place point where GROUP is supposed to be inserted." - (let* ((topic (gnus-group-topic group)) - (groups (cdr (assoc topic gnus-topic-alist))) - (g (cdr (member group groups))) - (unfound t) - entry) - ;; Try to jump to a visible group. - (while (and g - (not (gnus-group-goto-group (car g) t))) - (pop g)) - ;; It wasn't visible, so we try to see where to insert it. - (when (not g) - (setq g (cdr (member group (reverse groups)))) - (while (and g unfound) - (when (gnus-group-goto-group (pop g) t) - (forward-line 1) - (setq unfound nil))) - (when (and unfound - topic - (not (gnus-topic-goto-missing-topic topic))) - (gnus-topic-display-missing-topic topic))))) - -(defun gnus-topic-display-missing-topic (topic) - "Insert topic lines recursively for missing topics." - (let ((parent (gnus-topic-find-topology - (gnus-topic-parent-topic topic)))) - (when (and parent - (not (gnus-topic-goto-missing-topic (caadr parent)))) - (gnus-topic-display-missing-topic (caadr parent)))) - (gnus-topic-goto-missing-topic topic) - (let* ((top (gnus-topic-find-topology topic)) - (children (cddr top)) - (type (cadr top)) - (unread 0) - (entries (gnus-topic-find-groups - (car type) (car gnus-group-list-mode) - (cdr gnus-group-list-mode))) - entry) - (while children - (incf unread (gnus-topic-unread (caar (pop children))))) - (while (setq entry (pop entries)) - (when (numberp (car entry)) - (incf unread (car entry)))) - (gnus-topic-insert-topic-line - topic t t (car (gnus-topic-find-topology topic)) nil unread))) - -(defun gnus-topic-goto-missing-topic (topic) - (if (gnus-topic-goto-topic topic) - (forward-line 1) - ;; Topic not displayed. - (let* ((top (gnus-topic-find-topology - (gnus-topic-parent-topic topic))) - (tp (reverse (cddr top)))) - (if (not top) - (gnus-topic-insert-topic-line - topic t t (car (gnus-topic-find-topology topic)) nil 0) - (while (not (equal (caaar tp) topic)) - (setq tp (cdr tp))) - (pop tp) - (while (and tp - (not (gnus-topic-goto-topic (caaar tp)))) - (pop tp)) - (if tp - (gnus-topic-forward-topic 1) - (gnus-topic-goto-missing-topic (caadr top))))) - nil)) - -(defun gnus-topic-update-topic-line (topic-name &optional reads) - (let* ((top (gnus-topic-find-topology topic-name)) - (type (cadr top)) - (children (cddr top)) - (entries (gnus-topic-find-groups - (car type) (car gnus-group-list-mode) - (cdr gnus-group-list-mode))) - (parent (gnus-topic-parent-topic topic-name)) - (all-entries entries) - (unread 0) - old-unread entry new-unread) - (when (gnus-topic-goto-topic (car type)) - ;; Tally all the groups that belong in this topic. - (if reads - (setq unread (- (gnus-group-topic-unread) reads)) - (while children - (incf unread (gnus-topic-unread (caar (pop children))))) - (while (setq entry (pop entries)) - (when (numberp (car entry)) - (incf unread (car entry))))) - (setq old-unread (gnus-group-topic-unread)) - ;; Insert the topic line. - (gnus-topic-insert-topic-line - (car type) (gnus-topic-visible-p) - (not (eq (nth 2 type) 'hidden)) - (gnus-group-topic-level) all-entries unread) - (gnus-delete-line) - (forward-line -1) - (setq new-unread (gnus-group-topic-unread))) - (when parent - (forward-line -1) - (gnus-topic-update-topic-line - parent - (- (or old-unread 0) (or new-unread 0)))) - unread)) - -(defun gnus-topic-group-indentation () - (make-string - (* gnus-topic-indent-level - (or (save-excursion - (forward-line -1) - (gnus-topic-goto-topic (gnus-current-topic)) - (gnus-group-topic-level)) - 0)) - ? )) - -;;; Initialization - -(gnus-add-shutdown 'gnus-topic-close 'gnus) - -(defun gnus-topic-close () - (setq gnus-topic-active-topology nil - gnus-topic-active-alist nil - gnus-topic-killed-topics nil - gnus-topology-checked-p nil)) - -(defun gnus-topic-check-topology () - ;; The first time we set the topology to whatever we have - ;; gotten here, which can be rather random. - (unless gnus-topic-alist - (gnus-topic-init-alist)) - - (setq gnus-topology-checked-p t) - ;; Go through the topic alist and make sure that all topics - ;; are in the topic topology. - (let ((topics (gnus-topic-list)) - (alist gnus-topic-alist) - changed) - (while alist - (unless (member (caar alist) topics) - (nconc gnus-topic-topology - (list (list (list (caar alist) 'visible)))) - (setq changed t)) - (setq alist (cdr alist))) - (when changed - (gnus-topic-enter-dribble)) - ;; Conversely, go through the topology and make sure that all - ;; topologies have alists. - (while topics - (unless (assoc (car topics) gnus-topic-alist) - (push (list (car topics)) gnus-topic-alist)) - (pop topics))) - ;; Go through all living groups and make sure that - ;; they belong to some topic. - (let* ((tgroups (apply 'append (mapcar (lambda (entry) (cdr entry)) - gnus-topic-alist))) - (entry (last (assoc (caar gnus-topic-topology) gnus-topic-alist))) - (newsrc (cdr gnus-newsrc-alist)) - group) - (while newsrc - (unless (member (setq group (gnus-info-group (pop newsrc))) tgroups) - (setcdr entry (list group)) - (setq entry (cdr entry))))) - ;; Go through all topics and make sure they contain only living groups. - (let ((alist gnus-topic-alist) - topic) - (while (setq topic (pop alist)) - (while (cdr topic) - (if (and (cadr topic) - (gnus-gethash (cadr topic) gnus-newsrc-hashtb)) - (setq topic (cdr topic)) - (setcdr topic (cddr topic))))))) - -(defun gnus-topic-init-alist () - "Initialize the topic structures." - (setq gnus-topic-topology - (cons (list "Gnus" 'visible) - (mapcar (lambda (topic) - (list (list (car topic) 'visible))) - '(("misc"))))) - (setq gnus-topic-alist - (list (cons "misc" - (mapcar (lambda (info) (gnus-info-group info)) - (cdr gnus-newsrc-alist))) - (list "Gnus"))) - (gnus-topic-enter-dribble)) - -;;; Maintenance - -(defun gnus-topic-clean-alist () - "Remove bogus groups from the topic alist." - (let ((topic-alist gnus-topic-alist) - result topic) - (unless gnus-killed-hashtb - (gnus-make-hashtable-from-killed)) - (while (setq topic (pop topic-alist)) - (let ((topic-name (pop topic)) - group filtered-topic) - (while (setq group (pop topic)) - (when (and (or (gnus-gethash group gnus-active-hashtb) - (gnus-info-method (gnus-get-info group))) - (not (gnus-gethash group gnus-killed-hashtb))) - (push group filtered-topic))) - (push (cons topic-name (nreverse filtered-topic)) result))) - (setq gnus-topic-alist (nreverse result)))) - -(defun gnus-topic-change-level (group level oldlevel &optional previous) - "Run when changing levels to enter/remove groups from topics." - (save-excursion - (set-buffer gnus-group-buffer) - (let ((buffer-read-only nil)) - (unless gnus-topic-inhibit-change-level - (gnus-group-goto-group (or (car (nth 2 previous)) group)) - (when (and gnus-topic-mode - gnus-topic-alist - (not gnus-topic-inhibit-change-level)) - ;; Remove the group from the topics. - (if (and (< oldlevel gnus-level-zombie) - (>= level gnus-level-zombie)) - (let ((alist gnus-topic-alist)) - (while (gnus-group-goto-group group) - (gnus-delete-line)) - (while alist - (when (member group (car alist)) - (setcdr (car alist) (delete group (cdar alist)))) - (pop alist))) - ;; If the group is subscribed we enter it into the topics. - (when (and (< level gnus-level-zombie) - (>= oldlevel gnus-level-zombie)) - (let* ((prev (gnus-group-group-name)) - (gnus-topic-inhibit-change-level t) - (gnus-group-indentation - (make-string - (* gnus-topic-indent-level - (or (save-excursion - (gnus-topic-goto-topic (gnus-current-topic)) - (gnus-group-topic-level)) - 0)) - ? )) - (yanked (list group)) - alist talist end) - ;; Then we enter the yanked groups into the topics - ;; they belong to. - (when (setq alist (assoc (save-excursion - (forward-line -1) - (or - (gnus-current-topic) - (caar gnus-topic-topology))) - gnus-topic-alist)) - (setq talist alist) - (when (stringp yanked) - (setq yanked (list yanked))) - (if (not prev) - (nconc alist yanked) - (if (not (cdr alist)) - (setcdr alist (nconc yanked (cdr alist))) - (while (and (not end) (cdr alist)) - (when (equal (cadr alist) prev) - (setcdr alist (nconc yanked (cdr alist))) - (setq end t)) - (setq alist (cdr alist))) - (unless end - (nconc talist yanked)))))) - (gnus-topic-update-topic)))))))) - -(defun gnus-topic-goto-next-group (group props) - "Go to group or the next group after group." - (if (not group) - (if (not (memq 'gnus-topic props)) - (goto-char (point-max)) - (gnus-topic-goto-topic (symbol-name (cadr (memq 'gnus-topic props))))) - (if (gnus-group-goto-group group) - t - ;; The group is no longer visible. - (let* ((list (assoc (gnus-group-topic group) gnus-topic-alist)) - (after (cdr (member group (cdr list))))) - ;; First try to put point on a group after the current one. - (while (and after - (not (gnus-group-goto-group (car after)))) - (setq after (cdr after))) - ;; Then try to put point on a group before point. - (unless after - (setq after (cdr (member group (reverse (cdr list))))) - (while (and after - (not (gnus-group-goto-group (car after)))) - (setq after (cdr after)))) - ;; Finally, just put point on the topic. - (if (not (car list)) - (goto-char (point-min)) - (unless after - (gnus-topic-goto-topic (car list)) - (setq after nil))) - t)))) - -;;; Topic-active functions - -(defun gnus-topic-grok-active (&optional force) - "Parse all active groups and create topic structures for them." - ;; First we make sure that we have really read the active file. - (when (or force - (not gnus-topic-active-alist)) - (let (groups) - ;; Get a list of all groups available. - (mapatoms (lambda (g) (when (symbol-value g) - (push (symbol-name g) groups))) - gnus-active-hashtb) - (setq groups (sort groups 'string<)) - ;; Init the variables. - (setq gnus-topic-active-topology (list (list "" 'visible))) - (setq gnus-topic-active-alist nil) - ;; Descend the top-level hierarchy. - (gnus-topic-grok-active-1 gnus-topic-active-topology groups) - ;; Set the top-level topic names to something nice. - (setcar (car gnus-topic-active-topology) "Gnus active") - (setcar (car gnus-topic-active-alist) "Gnus active")))) - -(defun gnus-topic-grok-active-1 (topology groups) - (let* ((name (caar topology)) - (prefix (concat "^" (regexp-quote name))) - tgroups ntopology group) - (while (and groups - (string-match prefix (setq group (car groups)))) - (if (not (string-match "\\." group (match-end 0))) - ;; There are no further hierarchies here, so we just - ;; enter this group into the list belonging to this - ;; topic. - (push (pop groups) tgroups) - ;; New sub-hierarchy, so we add it to the topology. - (nconc topology (list (setq ntopology - (list (list (substring - group 0 (match-end 0)) - 'invisible))))) - ;; Descend the hierarchy. - (setq groups (gnus-topic-grok-active-1 ntopology groups)))) - ;; We remove the trailing "." from the topic name. - (setq name - (if (string-match "\\.$" name) - (substring name 0 (match-beginning 0)) - name)) - ;; Add this topic and its groups to the topic alist. - (push (cons name (nreverse tgroups)) gnus-topic-active-alist) - (setcar (car topology) name) - ;; We return the rest of the groups that didn't belong - ;; to this topic. - groups)) - -;;; Topic mode, commands and keymap. - -(defvar gnus-topic-mode-map nil) -(defvar gnus-group-topic-map nil) - -(unless gnus-topic-mode-map - (setq gnus-topic-mode-map (make-sparse-keymap)) - - ;; Override certain group mode keys. - (gnus-define-keys gnus-topic-mode-map - "=" gnus-topic-select-group - "\r" gnus-topic-select-group - " " gnus-topic-read-group - "\C-c\C-x" gnus-topic-expire-articles - "c" gnus-topic-catchup-articles - "\C-k" gnus-topic-kill-group - "\C-y" gnus-topic-yank-group - "\M-g" gnus-topic-get-new-news-this-topic - "AT" gnus-topic-list-active - "Gp" gnus-topic-edit-parameters - "#" gnus-topic-mark-topic - "\M-#" gnus-topic-unmark-topic - [tab] gnus-topic-indent - [(meta tab)] gnus-topic-unindent - "\C-i" gnus-topic-indent - "\M-\C-i" gnus-topic-unindent - gnus-mouse-2 gnus-mouse-pick-topic) - - ;; Define a new submap. - (gnus-define-keys (gnus-group-topic-map "T" gnus-group-mode-map) - "#" gnus-topic-mark-topic - "\M-#" gnus-topic-unmark-topic - "n" gnus-topic-create-topic - "m" gnus-topic-move-group - "D" gnus-topic-remove-group - "c" gnus-topic-copy-group - "h" gnus-topic-hide-topic - "s" gnus-topic-show-topic - "j" gnus-topic-jump-to-topic - "M" gnus-topic-move-matching - "C" gnus-topic-copy-matching - "\M-p" gnus-topic-goto-previous-topic - "\M-n" gnus-topic-goto-next-topic - "\C-i" gnus-topic-indent - [tab] gnus-topic-indent - "r" gnus-topic-rename - "\177" gnus-topic-delete - [delete] gnus-topic-delete - "H" gnus-topic-toggle-display-empty-topics) - - (gnus-define-keys (gnus-topic-sort-map "S" gnus-group-topic-map) - "s" gnus-topic-sort-groups - "a" gnus-topic-sort-groups-by-alphabet - "u" gnus-topic-sort-groups-by-unread - "l" gnus-topic-sort-groups-by-level - "e" gnus-topic-sort-groups-by-server - "v" gnus-topic-sort-groups-by-score - "r" gnus-topic-sort-groups-by-rank - "m" gnus-topic-sort-groups-by-method)) - -(defun gnus-topic-make-menu-bar () - (unless (boundp 'gnus-topic-menu) - (easy-menu-define - gnus-topic-menu gnus-topic-mode-map "" - '("Topics" - ["Toggle topics" gnus-topic-mode t] - ("Groups" - ["Copy..." gnus-topic-copy-group t] - ["Move..." gnus-topic-move-group t] - ["Remove" gnus-topic-remove-group t] - ["Copy matching..." gnus-topic-copy-matching t] - ["Move matching..." gnus-topic-move-matching t]) - ("Topics" - ["Goto..." gnus-topic-jump-to-topic t] - ["Show" gnus-topic-show-topic t] - ["Hide" gnus-topic-hide-topic t] - ["Delete" gnus-topic-delete t] - ["Rename..." gnus-topic-rename t] - ["Create..." gnus-topic-create-topic t] - ["Mark" gnus-topic-mark-topic t] - ["Indent" gnus-topic-indent t] - ["Sort" gnus-topic-sort-topics t] - ["Previous topic" gnus-topic-goto-previous-topic t] - ["Next topic" gnus-topic-goto-next-topic t] - ["Toggle hide empty" gnus-topic-toggle-display-empty-topics t] - ["Edit parameters" gnus-topic-edit-parameters t]) - ["List active" gnus-topic-list-active t])))) - -(defun gnus-topic-mode (&optional arg redisplay) - "Minor mode for topicsifying Gnus group buffers." - (interactive (list current-prefix-arg t)) - (when (eq major-mode 'gnus-group-mode) - (make-local-variable 'gnus-topic-mode) - (setq gnus-topic-mode - (if (null arg) (not gnus-topic-mode) - (> (prefix-numeric-value arg) 0))) - ;; Infest Gnus with topics. - (if (not gnus-topic-mode) - (setq gnus-goto-missing-group-function nil) - (when (gnus-visual-p 'topic-menu 'menu) - (gnus-topic-make-menu-bar)) - (gnus-set-format 'topic t) - (gnus-add-minor-mode 'gnus-topic-mode " Topic" gnus-topic-mode-map) - (add-hook 'gnus-group-catchup-group-hook 'gnus-topic-update-topic) - (set (make-local-variable 'gnus-group-prepare-function) - 'gnus-group-prepare-topics) - (set (make-local-variable 'gnus-group-get-parameter-function) - 'gnus-group-topic-parameters) - (set (make-local-variable 'gnus-group-goto-next-group-function) - 'gnus-topic-goto-next-group) - (set (make-local-variable 'gnus-group-indentation-function) - 'gnus-topic-group-indentation) - (set (make-local-variable 'gnus-group-update-group-function) - 'gnus-topic-update-topics-containing-group) - (set (make-local-variable 'gnus-group-sort-alist-function) - 'gnus-group-sort-topic) - (setq gnus-group-change-level-function 'gnus-topic-change-level) - (setq gnus-goto-missing-group-function 'gnus-topic-goto-missing-group) - (gnus-make-local-hook 'gnus-check-bogus-groups-hook) - (add-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist - nil 'local) - (setq gnus-topology-checked-p nil) - ;; We check the topology. - (when gnus-newsrc-alist - (gnus-topic-check-topology)) - (gnus-run-hooks 'gnus-topic-mode-hook)) - ;; Remove topic infestation. - (unless gnus-topic-mode - (remove-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic) - (setq gnus-group-change-level-function nil) - (remove-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist) - (setq gnus-group-prepare-function 'gnus-group-prepare-flat) - (setq gnus-group-sort-alist-function 'gnus-group-sort-flat)) - (when redisplay - (gnus-group-list-groups)))) - -(defun gnus-topic-select-group (&optional all) - "Select this newsgroup. -No article is selected automatically. -If the group is opened, just switch the summary buffer. -If ALL is non-nil, already read articles become readable. - -If ALL is a positive number, fetch this number of the latest -articles in the group. If ALL is a negative number, fetch this -number of the earliest articles in the group. - -If performed over a topic line, toggle folding the topic." - (interactive "P") - (when (and (eobp) (not (gnus-group-group-name))) - (forward-line -1)) - (if (gnus-group-topic-p) - (let ((gnus-group-list-mode - (if all (cons (if (numberp all) all 7) t) gnus-group-list-mode))) - (gnus-topic-fold all) - (gnus-dribble-touch)) - (gnus-group-select-group all))) - -(defun gnus-mouse-pick-topic (e) - "Select the group or topic under the mouse pointer." - (interactive "e") - (mouse-set-point e) - (gnus-topic-read-group nil)) - -(defun gnus-topic-expire-articles (topic) - "Expire articles in this topic or group." - (interactive (list (gnus-group-topic-name))) - (if (not topic) - (call-interactively 'gnus-group-expire-articles) - (save-excursion - (gnus-message 5 "Expiring groups in %s..." topic) - (let ((gnus-group-marked - (mapcar (lambda (entry) (car (nth 2 entry))) - (gnus-topic-find-groups topic gnus-level-killed t - nil t)))) - (gnus-group-expire-articles nil)) - (gnus-message 5 "Expiring groups in %s...done" topic)))) - -(defun gnus-topic-catchup-articles (topic) - "Catchup this topic or group. -Also see `gnus-group-catchup'." - (interactive (list (gnus-group-topic-name))) - (if (not topic) - (call-interactively 'gnus-group-catchup-current) - (save-excursion - (let* ((groups - (mapcar (lambda (entry) (car (nth 2 entry))) - (gnus-topic-find-groups topic gnus-level-killed t - nil t))) - (buffer-read-only nil) - (gnus-group-marked groups)) - (gnus-group-catchup-current) - (mapcar 'gnus-topic-update-topics-containing-group groups))))) - -(defun gnus-topic-read-group (&optional all no-article group) - "Read news in this newsgroup. -If the prefix argument ALL is non-nil, already read articles become -readable. - -If ALL is a positive number, fetch this number of the latest -articles in the group. If ALL is a negative number, fetch this -number of the earliest articles in the group. - -If the optional argument NO-ARTICLE is non-nil, no article will -be auto-selected upon group entry. If GROUP is non-nil, fetch -that group. - -If performed over a topic line, toggle folding the topic." - (interactive "P") - (if (gnus-group-topic-p) - (let ((gnus-group-list-mode - (if all (cons (if (numberp all) all 7) t) gnus-group-list-mode))) - (gnus-topic-fold all)) - (gnus-group-read-group all no-article group))) - -(defun gnus-topic-create-topic (topic parent &optional previous full-topic) - "Create a new TOPIC under PARENT. -When used interactively, PARENT will be the topic under point." - (interactive - (list - (read-string "New topic: ") - (gnus-current-topic))) - ;; Check whether this topic already exists. - (when (gnus-topic-find-topology topic) - (error "Topic already exists")) - (unless parent - (setq parent (caar gnus-topic-topology))) - (let ((top (cdr (gnus-topic-find-topology parent))) - (full-topic (or full-topic (list (list topic 'visible nil nil))))) - (unless top - (error "No such parent topic: %s" parent)) - (if previous - (progn - (while (and (cdr top) - (not (equal (caaadr top) previous))) - (setq top (cdr top))) - (setcdr top (cons full-topic (cdr top)))) - (nconc top (list full-topic))) - (unless (assoc topic gnus-topic-alist) - (push (list topic) gnus-topic-alist))) - (gnus-topic-enter-dribble) - (gnus-group-list-groups) - (gnus-topic-goto-topic topic)) - -;; FIXME: -;; 1. When the marked groups are overlapped with the process -;; region, the behavior of move or remove is not right. -;; 2. Can't process on several marked groups with a same name, -;; because gnus-group-marked only keeps one copy. - -(defun gnus-topic-move-group (n topic &optional copyp) - "Move the next N groups to TOPIC. -If COPYP, copy the groups instead." - (interactive - (list current-prefix-arg - (gnus-completing-read "Move to topic" gnus-topic-alist nil t - 'gnus-topic-history))) - (let ((use-marked (and (not n) (not (gnus-region-active-p)) - gnus-group-marked t)) - (groups (gnus-group-process-prefix n)) - (topicl (assoc topic gnus-topic-alist)) - (start-topic (gnus-group-topic-name)) - (start-group (progn (forward-line 1) (gnus-group-group-name))) - entry) - (if (and (not groups) (not copyp) start-topic) - (gnus-topic-move start-topic topic) - (mapcar - (lambda (g) - (gnus-group-remove-mark g use-marked) - (when (and - (setq entry (assoc (gnus-current-topic) gnus-topic-alist)) - (not copyp)) - (setcdr entry (gnus-delete-first g (cdr entry)))) - (nconc topicl (list g))) - groups) - (gnus-topic-enter-dribble) - (if start-group - (gnus-group-goto-group start-group) - (gnus-topic-goto-topic start-topic)) - (gnus-group-list-groups)))) - -(defun gnus-topic-remove-group (&optional n) - "Remove the current group from the topic." - (interactive "P") - (let ((use-marked (and (not n) (not (gnus-region-active-p)) - gnus-group-marked t)) - (groups (gnus-group-process-prefix n))) - (mapcar - (lambda (group) - (gnus-group-remove-mark group use-marked) - (let ((topicl (assoc (gnus-current-topic) gnus-topic-alist)) - (buffer-read-only nil)) - (when (and topicl group) - (gnus-delete-line) - (gnus-delete-first group topicl)) - (gnus-topic-update-topic))) - groups) - (gnus-topic-enter-dribble) - (gnus-group-position-point))) - -(defun gnus-topic-copy-group (n topic) - "Copy the current group to a topic." - (interactive - (list current-prefix-arg - (completing-read "Copy to topic: " gnus-topic-alist nil t))) - (gnus-topic-move-group n topic t)) - -(defun gnus-topic-kill-group (&optional n discard) - "Kill the next N groups." - (interactive "P") - (if (gnus-group-topic-p) - (let ((topic (gnus-group-topic-name))) - (push (cons - (gnus-topic-find-topology topic) - (assoc topic gnus-topic-alist)) - gnus-topic-killed-topics) - (gnus-topic-remove-topic nil t) - (gnus-topic-find-topology topic nil nil gnus-topic-topology) - (gnus-topic-enter-dribble)) - (gnus-group-kill-group n discard) - (if (not (gnus-group-topic-p)) - (gnus-topic-update-topic) - ;; Move up one line so that we update the right topic. - (forward-line -1) - (gnus-topic-update-topic) - (forward-line 1)))) - -(defun gnus-topic-yank-group (&optional arg) - "Yank the last topic." - (interactive "p") - (if gnus-topic-killed-topics - (let* ((previous - (or (gnus-group-topic-name) - (gnus-topic-next-topic (gnus-current-topic)))) - (data (pop gnus-topic-killed-topics)) - (alist (cdr data)) - (item (cdar data))) - (push alist gnus-topic-alist) - (gnus-topic-create-topic - (caar item) (gnus-topic-parent-topic previous) previous - item) - (gnus-topic-enter-dribble) - (gnus-topic-goto-topic (caar item))) - (let* ((prev (gnus-group-group-name)) - (gnus-topic-inhibit-change-level t) - (gnus-group-indentation - (make-string - (* gnus-topic-indent-level - (or (save-excursion - (gnus-topic-goto-topic (gnus-current-topic)) - (gnus-group-topic-level)) - 0)) - ? )) - yanked alist) - ;; We first yank the groups the normal way... - (setq yanked (gnus-group-yank-group arg)) - ;; Then we enter the yanked groups into the topics they belong - ;; to. - (setq alist (assoc (save-excursion - (forward-line -1) - (gnus-current-topic)) - gnus-topic-alist)) - (when (stringp yanked) - (setq yanked (list yanked))) - (if (not prev) - (nconc alist yanked) - (if (not (cdr alist)) - (setcdr alist (nconc yanked (cdr alist))) - (while (cdr alist) - (when (equal (cadr alist) prev) - (setcdr alist (nconc yanked (cdr alist))) - (setq alist nil)) - (setq alist (cdr alist)))))) - (gnus-topic-update-topic))) - -(defun gnus-topic-hide-topic (&optional permanent) - "Hide the current topic. -If PERMANENT, make it stay hidden in subsequent sessions as well." - (interactive "P") - (when (gnus-current-topic) - (gnus-topic-goto-topic (gnus-current-topic)) - (if permanent - (setcar (cddr - (cadr - (gnus-topic-find-topology (gnus-current-topic)))) - 'hidden)) - (gnus-topic-remove-topic nil nil))) - -(defun gnus-topic-show-topic (&optional permanent) - "Show the hidden topic. -If PERMANENT, make it stay shown in subsequent sessions as well." - (interactive "P") - (when (gnus-group-topic-p) - (if (not permanent) - (gnus-topic-remove-topic t nil) - (let ((topic - (gnus-topic-find-topology - (completing-read "Show topic: " gnus-topic-alist nil t)))) - (setcar (cddr (cadr topic)) nil) - (setcar (cdr (cadr topic)) 'visible) - (gnus-group-list-groups))))) - -(defun gnus-topic-mark-topic (topic &optional unmark non-recursive) - "Mark all groups in the TOPIC with the process mark. -If NON-RECURSIVE (which is the prefix) is t, don't mark its subtopics." - (interactive (list (gnus-group-topic-name) - nil - (and current-prefix-arg t))) - (if (not topic) - (call-interactively 'gnus-group-mark-group) - (save-excursion - (let ((groups (gnus-topic-find-groups topic gnus-level-killed t nil - (not non-recursive)))) - (while groups - (funcall (if unmark 'gnus-group-remove-mark 'gnus-group-set-mark) - (gnus-info-group (nth 2 (pop groups))))))))) - -(defun gnus-topic-unmark-topic (topic &optional dummy non-recursive) - "Remove the process mark from all groups in the TOPIC. -If NON-RECURSIVE (which is the prefix) is t, don't unmark its subtopics." - (interactive (list (gnus-group-topic-name) - nil - (and current-prefix-arg t))) - (if (not topic) - (call-interactively 'gnus-group-unmark-group) - (gnus-topic-mark-topic topic t non-recursive))) - -(defun gnus-topic-get-new-news-this-topic (&optional n) - "Check for new news in the current topic." - (interactive "P") - (if (not (gnus-group-topic-p)) - (gnus-group-get-new-news-this-group n) - (let* ((topic (gnus-group-topic-name)) - (data (cadr (gnus-topic-find-topology topic)))) - (save-excursion - (gnus-topic-mark-topic topic nil (and n t)) - (gnus-group-get-new-news-this-group)) - (gnus-topic-remove-topic (eq 'visible (cadr data)))))) - -(defun gnus-topic-move-matching (regexp topic &optional copyp) - "Move all groups that match REGEXP to some topic." - (interactive - (let (topic) - (nreverse - (list - (setq topic (completing-read "Move to topic: " gnus-topic-alist nil t)) - (read-string (format "Move to %s (regexp): " topic)))))) - (gnus-group-mark-regexp regexp) - (gnus-topic-move-group nil topic copyp)) - -(defun gnus-topic-copy-matching (regexp topic &optional copyp) - "Copy all groups that match REGEXP to some topic." - (interactive - (let (topic) - (nreverse - (list - (setq topic (completing-read "Copy to topic: " gnus-topic-alist nil t)) - (read-string (format "Copy to %s (regexp): " topic)))))) - (gnus-topic-move-matching regexp topic t)) - -(defun gnus-topic-delete (topic) - "Delete a topic." - (interactive (list (gnus-group-topic-name))) - (unless topic - (error "No topic to be deleted")) - (let ((entry (assoc topic gnus-topic-alist)) - (buffer-read-only nil)) - (when (cdr entry) - (error "Topic not empty")) - ;; Delete if visible. - (when (gnus-topic-goto-topic topic) - (gnus-delete-line)) - ;; Remove from alist. - (setq gnus-topic-alist (delq entry gnus-topic-alist)) - ;; Remove from topology. - (gnus-topic-find-topology topic nil nil 'delete) - (gnus-dribble-touch))) - -(defun gnus-topic-rename (old-name new-name) - "Rename a topic." - (interactive - (let ((topic (gnus-current-topic))) - (list topic - (read-string (format "Rename %s to: " topic) topic)))) - ;; Check whether the new name exists. - (when (gnus-topic-find-topology new-name) - (error "Topic '%s' already exists" new-name)) - ;; "nil" is an invalid name, for reasons I'd rather not go - ;; into here. Trust me. - (when (equal new-name "nil") - (error "Invalid name: %s" nil)) - ;; Do the renaming. - (let ((top (gnus-topic-find-topology old-name)) - (entry (assoc old-name gnus-topic-alist))) - (when top - (setcar (cadr top) new-name)) - (when entry - (setcar entry new-name)) - (forward-line -1) - (gnus-dribble-touch) - (gnus-group-list-groups) - (forward-line 1))) - -(defun gnus-topic-indent (&optional unindent) - "Indent a topic -- make it a sub-topic of the previous topic. -If UNINDENT, remove an indentation." - (interactive "P") - (if unindent - (gnus-topic-unindent) - (let* ((topic (gnus-current-topic)) - (parent (gnus-topic-previous-topic topic)) - (buffer-read-only nil)) - (unless parent - (error "Nothing to indent %s into" topic)) - (when topic - (gnus-topic-goto-topic topic) - (gnus-topic-kill-group) - (push (cdar gnus-topic-killed-topics) gnus-topic-alist) - (gnus-topic-create-topic - topic parent nil (cdar (car gnus-topic-killed-topics))) - (pop gnus-topic-killed-topics) - (or (gnus-topic-goto-topic topic) - (gnus-topic-goto-topic parent)))))) - -(defun gnus-topic-unindent () - "Unindent a topic." - (interactive) - (let* ((topic (gnus-current-topic)) - (parent (gnus-topic-parent-topic topic)) - (grandparent (gnus-topic-parent-topic parent))) - (unless grandparent - (error "Nothing to indent %s into" topic)) - (when topic - (gnus-topic-goto-topic topic) - (gnus-topic-kill-group) - (push (cdar gnus-topic-killed-topics) gnus-topic-alist) - (gnus-topic-create-topic - topic grandparent (gnus-topic-next-topic parent) - (cdar (car gnus-topic-killed-topics))) - (pop gnus-topic-killed-topics) - (gnus-topic-goto-topic topic)))) - -(defun gnus-topic-list-active (&optional force) - "List all groups that Gnus knows about in a topicsified fashion. -If FORCE, always re-read the active file." - (interactive "P") - (when force - (gnus-get-killed-groups)) - (gnus-topic-grok-active force) - (let ((gnus-topic-topology gnus-topic-active-topology) - (gnus-topic-alist gnus-topic-active-alist) - gnus-killed-list gnus-zombie-list) - (gnus-group-list-groups gnus-level-killed nil 1))) - -(defun gnus-topic-toggle-display-empty-topics () - "Show/hide topics that have no unread articles." - (interactive) - (setq gnus-topic-display-empty-topics - (not gnus-topic-display-empty-topics)) - (gnus-group-list-groups) - (message "%s empty topics" - (if gnus-topic-display-empty-topics - "Showing" "Hiding"))) - -;;; Topic sorting functions - -(defun gnus-topic-edit-parameters (group) - "Edit the group parameters of GROUP. -If performed on a topic, edit the topic parameters instead." - (interactive (list (gnus-group-group-name))) - (if group - (gnus-group-edit-group-parameters group) - (if (not (gnus-group-topic-p)) - (error "Nothing to edit on the current line") - (let ((topic (gnus-group-topic-name))) - (gnus-edit-form - (gnus-topic-parameters topic) - (format "Editing the topic parameters for `%s'." - (or group topic)) - `(lambda (form) - (gnus-topic-set-parameters ,topic form))))))) - -(defun gnus-group-sort-topic (func reverse) - "Sort groups in the topics according to FUNC and REVERSE." - (let ((alist gnus-topic-alist)) - (while alist - ;; !!!Sometimes nil elements sneak into the alist, - ;; for some reason or other. - (setcar alist (delq nil (car alist))) - (setcar alist (delete "dummy.group" (car alist))) - (gnus-topic-sort-topic (pop alist) func reverse)))) - -(defun gnus-topic-sort-topic (topic func reverse) - ;; Each topic only lists the name of the group, while - ;; the sort predicates expect group infos as inputs. - ;; So we first transform the group names into infos, - ;; then sort, and then transform back into group names. - (setcdr - topic - (mapcar - (lambda (info) (gnus-info-group info)) - (sort - (mapcar - (lambda (group) (gnus-get-info group)) - (cdr topic)) - func))) - ;; Do the reversal, if necessary. - (when reverse - (setcdr topic (nreverse (cdr topic))))) - -(defun gnus-topic-sort-groups (func &optional reverse) - "Sort the current topic according to FUNC. -If REVERSE, reverse the sorting order." - (interactive (list gnus-group-sort-function current-prefix-arg)) - (let ((topic (assoc (gnus-current-topic) gnus-topic-alist))) - (gnus-topic-sort-topic - topic (gnus-make-sort-function func) reverse) - (gnus-group-list-groups))) - -(defun gnus-topic-sort-groups-by-alphabet (&optional reverse) - "Sort the current topic alphabetically by group name. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-topic-sort-groups 'gnus-group-sort-by-alphabet reverse)) - -(defun gnus-topic-sort-groups-by-unread (&optional reverse) - "Sort the current topic by number of unread articles. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-topic-sort-groups 'gnus-group-sort-by-unread reverse)) - -(defun gnus-topic-sort-groups-by-level (&optional reverse) - "Sort the current topic by group level. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-topic-sort-groups 'gnus-group-sort-by-level reverse)) - -(defun gnus-topic-sort-groups-by-score (&optional reverse) - "Sort the current topic by group score. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-topic-sort-groups 'gnus-group-sort-by-score reverse)) - -(defun gnus-topic-sort-groups-by-rank (&optional reverse) - "Sort the current topic by group rank. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-topic-sort-groups 'gnus-group-sort-by-rank reverse)) - -(defun gnus-topic-sort-groups-by-method (&optional reverse) - "Sort the current topic alphabetically by backend name. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-topic-sort-groups 'gnus-group-sort-by-method reverse)) - -(defun gnus-topic-sort-groups-by-server (&optional reverse) - "Sort the current topic alphabetically by server name. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-topic-sort-groups 'gnus-group-sort-by-server reverse)) - -(defun gnus-topic-sort-topics-1 (top reverse) - (if (cdr top) - (let ((subtop - (mapcar (gnus-byte-compile - `(lambda (top) - (gnus-topic-sort-topics-1 top ,reverse))) - (sort (cdr top) - (lambda (t1 t2) - (string-lessp (caar t1) (caar t2))))))) - (setcdr top (if reverse (reverse subtop) subtop)))) - top) - -(defun gnus-topic-sort-topics (&optional topic reverse) - "Sort topics in TOPIC alphabetically by topic name. -If REVERSE, reverse the sorting order." - (interactive - (list (completing-read "Sort topics in : " gnus-topic-alist nil t - (gnus-current-topic)) - current-prefix-arg)) - (let ((topic-topology (or (and topic (cdr (gnus-topic-find-topology topic))) - gnus-topic-topology))) - (gnus-topic-sort-topics-1 topic-topology reverse) - (gnus-topic-enter-dribble) - (gnus-group-list-groups) - (gnus-topic-goto-topic topic))) - -(defun gnus-topic-move (current to) - "Move the CURRENT topic to TO." - (interactive - (list - (gnus-group-topic-name) - (completing-read "Move to topic: " gnus-topic-alist nil t))) - (unless (and current to) - (error "Can't find topic")) - (let ((current-top (cdr (gnus-topic-find-topology current))) - (to-top (cdr (gnus-topic-find-topology to)))) - (unless current-top - (error "Can't find topic `%s'" current)) - (unless to-top - (error "Can't find topic `%s'" to)) - (if (gnus-topic-find-topology to current-top 0);; Don't care the level - (error "Can't move `%s' to its sub-level" current)) - (gnus-topic-find-topology current nil nil 'delete) - (while (cdr to-top) - (setq to-top (cdr to-top))) - (setcdr to-top (list current-top)) - (gnus-topic-enter-dribble) - (gnus-group-list-groups) - (gnus-topic-goto-topic current))) - -(defun gnus-subscribe-topics (newsgroup) - (catch 'end - (let (match gnus-group-change-level-function) - (dolist (topic (gnus-topic-list)) - (when (and (setq match (cdr (assq 'subscribe - (gnus-topic-parameters topic)))) - (string-match match newsgroup)) - ;; Just subscribe the group. - (gnus-subscribe-alphabetically newsgroup) - ;; Add the group to the topic. - (nconc (assoc topic gnus-topic-alist) (list newsgroup)) - ;; if this topic specifies a default level, use it - (let ((subscribe-level (cdr (assq 'subscribe-level - (gnus-topic-parameters topic))))) - (when subscribe-level - (gnus-group-change-level newsgroup subscribe-level - gnus-level-default-subscribed))) - (throw 'end t))) - nil))) - -(provide 'gnus-topic) - -;;; arch-tag: bf176856-f30c-40f0-ae77-e41529a1134c -;;; gnus-topic.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-undo.el b/xemacs-packages/gnus/lisp/gnus-undo.el deleted file mode 100644 index 308eae71..00000000 --- a/xemacs-packages/gnus/lisp/gnus-undo.el +++ /dev/null @@ -1,196 +0,0 @@ -;;; gnus-undo.el --- minor mode for undoing in Gnus - -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; This package allows arbitrary undoing in Gnus buffers. As all the -;; Gnus buffers aren't very text-oriented (what is in the buffers is -;; just some arbitrary representation of the actual data), normal Emacs -;; undoing doesn't work at all for Gnus. -;; -;; This package works by letting Gnus register functions for reversing -;; actions, and then calling these functions when the user pushes the -;; `undo' key. As with normal `undo', there it is possible to set -;; undo boundaries and so on. -;; -;; Internally, the undo sequence is represented by the -;; `gnus-undo-actions' list, where each element is a list of functions -;; to be called, in sequence, to undo some action. (An "action" is a -;; collection of functions.) -;; -;; For instance, a function for killing a group will call -;; `gnus-undo-register' with a function that un-kills the group. This -;; package will put that function into an action. - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus-util) -(require 'gnus) -(require 'custom) - -(defgroup gnus-undo nil - "Undoing in Gnus buffers." - :group 'gnus) - -(defcustom gnus-undo-limit 2000 - "The number of undoable actions recorded." - :type 'integer - :group 'gnus-undo) - -(defcustom gnus-undo-mode nil - "Minor mode for undoing in Gnus buffers." - :type 'boolean - :group 'gnus-undo) - -(defcustom gnus-undo-mode-hook nil - "Hook called in all `gnus-undo-mode' buffers." - :type 'hook - :group 'gnus-undo) - -;;; Internal variables. - -(defvar gnus-undo-actions nil) -(defvar gnus-undo-boundary t) -(defvar gnus-undo-last nil) -(defvar gnus-undo-boundary-inhibit nil) - -;;; Minor mode definition. - -(defvar gnus-undo-mode-map nil) - -(unless gnus-undo-mode-map - (setq gnus-undo-mode-map (make-sparse-keymap)) - - (gnus-define-keys gnus-undo-mode-map - "\M-\C-_" gnus-undo - "\C-_" gnus-undo - "\C-xu" gnus-undo - ;; many people are used to type `C-/' on X terminals and get `C-_'. - [(control /)] gnus-undo)) - -(defun gnus-undo-make-menu-bar () - ;; This is disabled for the time being. - (when nil - (define-key-after (current-local-map) [menu-bar file gnus-undo] - (cons "Undo" 'gnus-undo-actions) - [menu-bar file whatever]))) - -(defun gnus-undo-mode (&optional arg) - "Minor mode for providing `undo' in Gnus buffers. - -\\{gnus-undo-mode-map}" - (interactive "P") - (set (make-local-variable 'gnus-undo-mode) - (if (null arg) (not gnus-undo-mode) - (> (prefix-numeric-value arg) 0))) - (set (make-local-variable 'gnus-undo-actions) nil) - (set (make-local-variable 'gnus-undo-boundary) t) - (when gnus-undo-mode - ;; Set up the menu. - (when (gnus-visual-p 'undo-menu 'menu) - (gnus-undo-make-menu-bar)) - (gnus-add-minor-mode 'gnus-undo-mode "" gnus-undo-mode-map) - (gnus-make-local-hook 'post-command-hook) - (add-hook 'post-command-hook 'gnus-undo-boundary nil t) - (gnus-run-hooks 'gnus-undo-mode-hook))) - -;;; Interface functions. - -(defun gnus-disable-undo (&optional buffer) - "Disable undoing in the current buffer." - (interactive) - (save-excursion - (when buffer - (set-buffer buffer)) - (gnus-undo-mode -1))) - -(defun gnus-undo-boundary () - "Set Gnus undo boundary." - (if gnus-undo-boundary-inhibit - (setq gnus-undo-boundary-inhibit nil) - (setq gnus-undo-boundary t))) - -(defun gnus-undo-force-boundary () - "Set Gnus undo boundary." - (setq gnus-undo-boundary-inhibit nil - gnus-undo-boundary t)) - -(defun gnus-undo-register (form) - "Register FORMS as something to be performed to undo a change. -FORMS may use backtick quote syntax." - (when gnus-undo-mode - (gnus-undo-register-1 - `(lambda () - ,form)))) - -(put 'gnus-undo-register 'lisp-indent-function 0) -(put 'gnus-undo-register 'edebug-form-spec '(body)) - -(defun gnus-undo-register-1 (function) - "Register FUNCTION as something to be performed to undo a change." - (when gnus-undo-mode - (cond - ;; We are on a boundary, so we create a new action. - (gnus-undo-boundary - (push (list function) gnus-undo-actions) - (setq gnus-undo-boundary nil)) - ;; Prepend the function to an old action. - (gnus-undo-actions - (setcar gnus-undo-actions (cons function (car gnus-undo-actions)))) - ;; Initialize list. - (t - (setq gnus-undo-actions (list (list function))))) - ;; Limit the length of the undo list. - (let ((next (nthcdr gnus-undo-limit gnus-undo-actions))) - (when next - (setcdr next nil))) - ;; We are not at a boundary... - (setq gnus-undo-boundary-inhibit t))) - -(defun gnus-undo (n) - "Undo some previous changes in Gnus buffers. -Repeat this command to undo more changes. -A numeric argument serves as a repeat count." - (interactive "p") - (unless gnus-undo-mode - (error "Undoing is not enabled in this buffer")) - (message "%s" last-command) - (when (or (not (eq last-command 'gnus-undo)) - (not gnus-undo-last)) - (setq gnus-undo-last gnus-undo-actions)) - (let ((action (pop gnus-undo-last))) - (unless action - (error "Nothing further to undo")) - (setq gnus-undo-actions (delq action gnus-undo-actions)) - (setq gnus-undo-boundary t) - (while action - (funcall (pop action))))) - -(provide 'gnus-undo) - -;;; arch-tag: 0d787bc7-787d-499a-837f-211d2cb07f2e -;;; gnus-undo.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-util.el b/xemacs-packages/gnus/lisp/gnus-util.el deleted file mode 100644 index 6f052534..00000000 --- a/xemacs-packages/gnus/lisp/gnus-util.el +++ /dev/null @@ -1,1677 +0,0 @@ -;;; gnus-util.el --- utility functions for Gnus - -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; Nothing in this file depends on any other parts of Gnus -- all -;; functions and macros in this file are utility functions that are -;; used by Gnus and may be used by any other package without loading -;; Gnus first. - -;; [Unfortunately, it does depend on other parts of Gnus, e.g. the -;; autoloads below...] - -;;; Code: - -(require 'custom) -(eval-when-compile - (require 'cl) - ;; Fixme: this should be a gnus variable, not nnmail-. - (defvar nnmail-pathname-coding-system) - (defvar nnmail-active-file-coding-system) - - ;; Inappropriate references to other parts of Gnus. - (defvar gnus-emphasize-whitespace-regexp) - (defvar gnus-original-article-buffer) - (defvar gnus-user-agent) - ) -(require 'time-date) -(require 'netrc) - -(eval-and-compile - (autoload 'message-fetch-field "message") - (autoload 'gnus-get-buffer-window "gnus-win") - (autoload 'rmail-insert-rmail-file-header "rmail") - (autoload 'rmail-count-new-messages "rmail") - (autoload 'rmail-show-message "rmail") - (autoload 'nnheader-narrow-to-headers "nnheader") - (autoload 'nnheader-replace-chars-in-string "nnheader")) - -(eval-and-compile - (cond - ;; Prefer `replace-regexp-in-string' (present in Emacs, XEmacs 21.5, - ;; SXEmacs 22.1.4) over `replace-in-string'. The later leads to inf-loops - ;; on empty matches: - ;; (replace-in-string "foo" "/*$" "/") - ;; (replace-in-string "xe" "\\(x\\)?" "") - ((fboundp 'replace-regexp-in-string) - (defun gnus-replace-in-string (string regexp newtext &optional literal) - "Replace all matches for REGEXP with NEWTEXT in STRING. -If LITERAL is non-nil, insert NEWTEXT literally. Return a new -string containing the replacements. - -This is a compatibility function for different Emacsen." - (replace-regexp-in-string regexp newtext string nil literal))) - ((fboundp 'replace-in-string) - (defalias 'gnus-replace-in-string 'replace-in-string)) - (t - (defun gnus-replace-in-string (string regexp newtext &optional literal) - "Replace all matches for REGEXP with NEWTEXT in STRING. -If LITERAL is non-nil, insert NEWTEXT literally. Return a new -string containing the replacements. - -This is a compatibility function for different Emacsen." - (let ((start 0) tail) - (while (string-match regexp string start) - (setq tail (- (length string) (match-end 0))) - (setq string (replace-match newtext nil literal string)) - (setq start (- (length string) tail)))) - string)))) - -;;; bring in the netrc functions as aliases -(defalias 'gnus-netrc-get 'netrc-get) -(defalias 'gnus-netrc-machine 'netrc-machine) -(defalias 'gnus-parse-netrc 'netrc-parse) - -(defun gnus-boundp (variable) - "Return non-nil if VARIABLE is bound and non-nil." - (and (boundp variable) - (symbol-value variable))) - -(defmacro gnus-eval-in-buffer-window (buffer &rest forms) - "Pop to BUFFER, evaluate FORMS, and then return to the original window." - (let ((tempvar (make-symbol "GnusStartBufferWindow")) - (w (make-symbol "w")) - (buf (make-symbol "buf"))) - `(let* ((,tempvar (selected-window)) - (,buf ,buffer) - (,w (gnus-get-buffer-window ,buf 'visible))) - (unwind-protect - (progn - (if ,w - (progn - (select-window ,w) - (set-buffer (window-buffer ,w))) - (pop-to-buffer ,buf)) - ,@forms) - (select-window ,tempvar))))) - -(put 'gnus-eval-in-buffer-window 'lisp-indent-function 1) -(put 'gnus-eval-in-buffer-window 'edebug-form-spec '(form body)) - -(defmacro gnus-intern-safe (string hashtable) - "Get hash value. Arguments are STRING and HASHTABLE." - `(let ((symbol (intern ,string ,hashtable))) - (or (boundp symbol) - (set symbol nil)) - symbol)) - -;; Added by Geoffrey T. Dairiki . A safe way -;; to limit the length of a string. This function is necessary since -;; `(substr "abc" 0 30)' pukes with "Args out of range". -;; Fixme: Why not `truncate-string-to-width'? -(defsubst gnus-limit-string (str width) - (if (> (length str) width) - (substring str 0 width) - str)) - -(defsubst gnus-goto-char (point) - (and point (goto-char point))) - -(defmacro gnus-buffer-exists-p (buffer) - `(let ((buffer ,buffer)) - (when buffer - (funcall (if (stringp buffer) 'get-buffer 'buffer-name) - buffer)))) - -(defalias 'gnus-point-at-bol - (if (fboundp 'point-at-bol) - 'point-at-bol - 'line-beginning-position)) - -(defalias 'gnus-point-at-eol - (if (fboundp 'point-at-eol) - 'point-at-eol - 'line-end-position)) - -;; The LOCAL arg to `add-hook' is interpreted differently in Emacs and -;; XEmacs. In Emacs we don't need to call `make-local-hook' first. -;; It's harmless, though, so the main purpose of this alias is to shut -;; up the byte compiler. -(defalias 'gnus-make-local-hook - (if (eq (get 'make-local-hook 'byte-compile) - 'byte-compile-obsolete) - 'ignore ; Emacs - 'make-local-hook)) ; XEmacs - -(defun gnus-delete-first (elt list) - "Delete by side effect the first occurrence of ELT as a member of LIST." - (if (equal (car list) elt) - (cdr list) - (let ((total list)) - (while (and (cdr list) - (not (equal (cadr list) elt))) - (setq list (cdr list))) - (when (cdr list) - (setcdr list (cddr list))) - total))) - -;; Delete the current line (and the next N lines). -(defmacro gnus-delete-line (&optional n) - `(delete-region (gnus-point-at-bol) - (progn (forward-line ,(or n 1)) (point)))) - -(defun gnus-byte-code (func) - "Return a form that can be `eval'ed based on FUNC." - (let ((fval (indirect-function func))) - (if (byte-code-function-p fval) - (let ((flist (append fval nil))) - (setcar flist 'byte-code) - flist) - (cons 'progn (cddr fval))))) - -(defun gnus-extract-address-components (from) - "Extract address components from a From header. -Given an RFC-822 address FROM, extract full name and canonical address. -Returns a list of the form (FULL-NAME CANONICAL-ADDRESS). Much more simple -solution than `mail-extract-address-components', which works much better, but -is slower." - (let (name address) - ;; First find the address - the thing with the @ in it. This may - ;; not be accurate in mail addresses, but does the trick most of - ;; the time in news messages. - (cond (;; Check ``'' first in order to handle the quite common - ;; form ``"abc@xyz" '' (i.e. ``@'' as part of a comment) - ;; correctly. - (string-match "<\\([^@ \t<>]+[!@][^@ \t<>]+\\)>" from) - (setq address (substring from (match-beginning 1) (match-end 1)))) - ((string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" from) - (setq address (substring from (match-beginning 0) (match-end 0))))) - ;; Then we check whether the "name

" format is used. - (and address - ;; Linear white space is not required. - (string-match (concat "[ \t]*<" (regexp-quote address) ">") from) - (and (setq name (substring from 0 (match-beginning 0))) - ;; Strip any quotes from the name. - (string-match "^\".*\"$" name) - (setq name (substring name 1 (1- (match-end 0)))))) - ;; If not, then "address (name)" is used. - (or name - (and (string-match "(.+)" from) - (setq name (substring from (1+ (match-beginning 0)) - (1- (match-end 0))))) - (and (string-match "()" from) - (setq name address)) - ;; XOVER might not support folded From headers. - (and (string-match "(.*" from) - (setq name (substring from (1+ (match-beginning 0)) - (match-end 0))))) - (list (if (string= name "") nil name) (or address from)))) - - -(defun gnus-fetch-field (field) - "Return the value of the header FIELD of current article." - (save-excursion - (save-restriction - (let ((case-fold-search t) - (inhibit-point-motion-hooks t)) - (nnheader-narrow-to-headers) - (message-fetch-field field))))) - -(defun gnus-fetch-original-field (field) - "Fetch FIELD from the original version of the current article." - (with-current-buffer gnus-original-article-buffer - (gnus-fetch-field field))) - - -(defun gnus-goto-colon () - (beginning-of-line) - (let ((eol (gnus-point-at-eol))) - (goto-char (or (text-property-any (point) eol 'gnus-position t) - (search-forward ":" eol t) - (point))))) - -(defun gnus-decode-newsgroups (newsgroups group &optional method) - (let ((method (or method (gnus-find-method-for-group group)))) - (mapconcat (lambda (group) - (gnus-group-name-decode group (gnus-group-name-charset - method group))) - (message-tokenize-header newsgroups) - ","))) - -(defun gnus-remove-text-with-property (prop) - "Delete all text in the current buffer with text property PROP." - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (while (get-text-property (point) prop) - (delete-char 1)) - (goto-char (next-single-property-change (point) prop nil (point-max)))))) - -(defun gnus-newsgroup-directory-form (newsgroup) - "Make hierarchical directory name from NEWSGROUP name." - (let* ((newsgroup (gnus-newsgroup-savable-name newsgroup)) - (idx (string-match ":" newsgroup))) - (concat - (if idx (substring newsgroup 0 idx)) - (if idx "/") - (nnheader-replace-chars-in-string - (if idx (substring newsgroup (1+ idx)) newsgroup) - ?. ?/)))) - -(defun gnus-newsgroup-savable-name (group) - ;; Replace any slashes in a group name (eg. an ange-ftp nndoc group) - ;; with dots. - (nnheader-replace-chars-in-string group ?/ ?.)) - -(defun gnus-string> (s1 s2) - (not (or (string< s1 s2) - (string= s1 s2)))) - -(defun gnus-string< (s1 s2) - "Return t if first arg string is less than second in lexicographic order. -Case is significant if and only if `case-fold-search' is nil. -Symbols are also allowed; their print names are used instead." - (if case-fold-search - (string-lessp (downcase (if (symbolp s1) (symbol-name s1) s1)) - (downcase (if (symbolp s2) (symbol-name s2) s2))) - (string-lessp s1 s2))) - -;;; Time functions. - -(defun gnus-file-newer-than (file date) - (let ((fdate (nth 5 (file-attributes file)))) - (or (> (car fdate) (car date)) - (and (= (car fdate) (car date)) - (> (nth 1 fdate) (nth 1 date)))))) - -;;; Keymap macros. - -(defmacro gnus-local-set-keys (&rest plist) - "Set the keys in PLIST in the current keymap." - `(gnus-define-keys-1 (current-local-map) ',plist)) - -(defmacro gnus-define-keys (keymap &rest plist) - "Define all keys in PLIST in KEYMAP." - `(gnus-define-keys-1 (quote ,keymap) (quote ,plist))) - -(defmacro gnus-define-keys-safe (keymap &rest plist) - "Define all keys in PLIST in KEYMAP without overwriting previous definitions." - `(gnus-define-keys-1 (quote ,keymap) (quote ,plist) t)) - -(put 'gnus-define-keys 'lisp-indent-function 1) -(put 'gnus-define-keys-safe 'lisp-indent-function 1) -(put 'gnus-local-set-keys 'lisp-indent-function 1) - -(defmacro gnus-define-keymap (keymap &rest plist) - "Define all keys in PLIST in KEYMAP." - `(gnus-define-keys-1 ,keymap (quote ,plist))) - -(put 'gnus-define-keymap 'lisp-indent-function 1) - -(defun gnus-define-keys-1 (keymap plist &optional safe) - (when (null keymap) - (error "Can't set keys in a null keymap")) - (cond ((symbolp keymap) - (setq keymap (symbol-value keymap))) - ((keymapp keymap)) - ((listp keymap) - (set (car keymap) nil) - (define-prefix-command (car keymap)) - (define-key (symbol-value (caddr keymap)) (cadr keymap) (car keymap)) - (setq keymap (symbol-value (car keymap))))) - (let (key) - (while plist - (when (symbolp (setq key (pop plist))) - (setq key (symbol-value key))) - (if (or (not safe) - (eq (lookup-key keymap key) 'undefined)) - (define-key keymap key (pop plist)) - (pop plist))))) - -(defun gnus-completing-read-with-default (default prompt &rest args) - ;; Like `completing-read', except that DEFAULT is the default argument. - (let* ((prompt (if default - (concat prompt " (default " default "): ") - (concat prompt ": "))) - (answer (apply 'completing-read prompt args))) - (if (or (null answer) (zerop (length answer))) - default - answer))) - -;; Two silly functions to ensure that all `y-or-n-p' questions clear -;; the echo area. -(defun gnus-y-or-n-p (prompt) - (prog1 - (y-or-n-p prompt) - (message ""))) - -(defun gnus-yes-or-no-p (prompt) - (prog1 - (yes-or-no-p prompt) - (message ""))) - -;; By Frank Schmitt . Allows to have -;; age-depending date representations. (e.g. just the time if it's -;; from today, the day of the week if it's within the last 7 days and -;; the full date if it's older) - -(defun gnus-seconds-today () - "Return the number of seconds passed today." - (let ((now (decode-time (current-time)))) - (+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600)))) - -(defun gnus-seconds-month () - "Return the number of seconds passed this month." - (let ((now (decode-time (current-time)))) - (+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600) - (* (- (car (nthcdr 3 now)) 1) 3600 24)))) - -(defun gnus-seconds-year () - "Return the number of seconds passed this year." - (let ((now (decode-time (current-time))) - (days (format-time-string "%j" (current-time)))) - (+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600) - (* (- (string-to-number days) 1) 3600 24)))) - -(defvar gnus-user-date-format-alist - '(((gnus-seconds-today) . "%k:%M") - (604800 . "%a %k:%M") ;;that's one week - ((gnus-seconds-month) . "%a %d") - ((gnus-seconds-year) . "%b %d") - (t . "%b %d '%y")) ;;this one is used when no - ;;other does match - "Specifies date format depending on age of article. -This is an alist of items (AGE . FORMAT). AGE can be a number (of -seconds) or a Lisp expression evaluating to a number. When the age of -the article is less than this number, then use `format-time-string' -with the corresponding FORMAT for displaying the date of the article. -If AGE is not a number or a Lisp expression evaluating to a -non-number, then the corresponding FORMAT is used as a default value. - -Note that the list is processed from the beginning, so it should be -sorted by ascending AGE. Also note that items following the first -non-number AGE will be ignored. - -You can use the functions `gnus-seconds-today', `gnus-seconds-month' -and `gnus-seconds-year' in the AGE spec. They return the number of -seconds passed since the start of today, of this month, of this year, -respectively.") - -(defun gnus-user-date (messy-date) - "Format the messy-date according to gnus-user-date-format-alist. -Returns \" ? \" if there's bad input or if an other error occurs. -Input should look like this: \"Sun, 14 Oct 2001 13:34:39 +0200\"." - (condition-case () - (let* ((messy-date (time-to-seconds (safe-date-to-time messy-date))) - (now (time-to-seconds (current-time))) - ;;If we don't find something suitable we'll use this one - (my-format "%b %d '%y")) - (let* ((difference (- now messy-date)) - (templist gnus-user-date-format-alist) - (top (eval (caar templist)))) - (while (if (numberp top) (< top difference) (not top)) - (progn - (setq templist (cdr templist)) - (setq top (eval (caar templist))))) - (if (stringp (cdr (car templist))) - (setq my-format (cdr (car templist))))) - (format-time-string (eval my-format) (seconds-to-time messy-date))) - (error " ? "))) - -(defun gnus-dd-mmm (messy-date) - "Return a string like DD-MMM from a big messy string." - (condition-case () - (format-time-string "%d-%b" (safe-date-to-time messy-date)) - (error " - "))) - -(defmacro gnus-date-get-time (date) - "Convert DATE string to Emacs time. -Cache the result as a text property stored in DATE." - ;; Either return the cached value... - `(let ((d ,date)) - (if (equal "" d) - '(0 0) - (or (get-text-property 0 'gnus-time d) - ;; or compute the value... - (let ((time (safe-date-to-time d))) - ;; and store it back in the string. - (put-text-property 0 1 'gnus-time time d) - time))))) - -(defsubst gnus-time-iso8601 (time) - "Return a string of TIME in YYYYMMDDTHHMMSS format." - (format-time-string "%Y%m%dT%H%M%S" time)) - -(defun gnus-date-iso8601 (date) - "Convert the DATE to YYYYMMDDTHHMMSS." - (condition-case () - (gnus-time-iso8601 (gnus-date-get-time date)) - (error ""))) - -(defun gnus-mode-string-quote (string) - "Quote all \"%\"'s in STRING." - (gnus-replace-in-string string "%" "%%")) - -;; Make a hash table (default and minimum size is 256). -;; Optional argument HASHSIZE specifies the table size. -(defun gnus-make-hashtable (&optional hashsize) - (make-vector (if hashsize (max (gnus-create-hash-size hashsize) 256) 256) 0)) - -;; Make a number that is suitable for hashing; bigger than MIN and -;; equal to some 2^x. Many machines (such as sparcs) do not have a -;; hardware modulo operation, so they implement it in software. On -;; many sparcs over 50% of the time to intern is spent in the modulo. -;; Yes, it's slower than actually computing the hash from the string! -;; So we use powers of 2 so people can optimize the modulo to a mask. -(defun gnus-create-hash-size (min) - (let ((i 1)) - (while (< i min) - (setq i (* 2 i))) - i)) - -(defcustom gnus-verbose 7 - "*Integer that says how verbose Gnus should be. -The higher the number, the more messages Gnus will flash to say what -it's doing. At zero, Gnus will be totally mute; at five, Gnus will -display most important messages; and at ten, Gnus will keep on -jabbering all the time." - :group 'gnus-start - :type 'integer) - -(defun gnus-message (level &rest args) - "If LEVEL is lower than `gnus-verbose' print ARGS using `message'. - -Guideline for numbers: -1 - error messages, 3 - non-serious error messages, 5 - messages for things -that take a long time, 7 - not very important messages on stuff, 9 - messages -inside loops." - (if (<= level gnus-verbose) - (apply 'message args) - ;; We have to do this format thingy here even if the result isn't - ;; shown - the return value has to be the same as the return value - ;; from `message'. - (apply 'format args))) - -(defun gnus-error (level &rest args) - "Beep an error if LEVEL is equal to or less than `gnus-verbose'. -ARGS are passed to `message'." - (when (<= (floor level) gnus-verbose) - (apply 'message args) - (ding) - (let (duration) - (when (and (floatp level) - (not (zerop (setq duration (* 10 (- level (floor level))))))) - (sit-for duration)))) - nil) - -(defun gnus-split-references (references) - "Return a list of Message-IDs in REFERENCES." - (let ((beg 0) - ids) - (while (string-match "<[^<]+[^< \t]" references beg) - (push (substring references (match-beginning 0) (setq beg (match-end 0))) - ids)) - (nreverse ids))) - -(defsubst gnus-parent-id (references &optional n) - "Return the last Message-ID in REFERENCES. -If N, return the Nth ancestor instead." - (when (and references - (not (zerop (length references)))) - (if n - (let ((ids (inline (gnus-split-references references)))) - (while (nthcdr n ids) - (setq ids (cdr ids))) - (car ids)) - (when (string-match "\\(<[^<]+>\\)[ \t]*\\'" references) - (match-string 1 references))))) - -(defun gnus-buffer-live-p (buffer) - "Say whether BUFFER is alive or not." - (and buffer - (get-buffer buffer) - (buffer-name (get-buffer buffer)))) - -(defun gnus-horizontal-recenter () - "Recenter the current buffer horizontally." - (if (< (current-column) (/ (window-width) 2)) - (set-window-hscroll (gnus-get-buffer-window (current-buffer) t) 0) - (let* ((orig (point)) - (end (window-end (gnus-get-buffer-window (current-buffer) t))) - (max 0)) - (when end - ;; Find the longest line currently displayed in the window. - (goto-char (window-start)) - (while (and (not (eobp)) - (< (point) end)) - (end-of-line) - (setq max (max max (current-column))) - (forward-line 1)) - (goto-char orig) - ;; Scroll horizontally to center (sort of) the point. - (if (> max (window-width)) - (set-window-hscroll - (gnus-get-buffer-window (current-buffer) t) - (min (- (current-column) (/ (window-width) 3)) - (+ 2 (- max (window-width))))) - (set-window-hscroll (gnus-get-buffer-window (current-buffer) t) 0)) - max)))) - -(defun gnus-read-event-char (&optional prompt) - "Get the next event." - (let ((event (read-event prompt))) - ;; should be gnus-characterp, but this can't be called in XEmacs anyway - (cons (and (numberp event) event) event))) - -(defun gnus-sortable-date (date) - "Make string suitable for sorting from DATE." - (gnus-time-iso8601 (date-to-time date))) - -(defun gnus-copy-file (file &optional to) - "Copy FILE to TO." - (interactive - (list (read-file-name "Copy file: " default-directory) - (read-file-name "Copy file to: " default-directory))) - (unless to - (setq to (read-file-name "Copy file to: " default-directory))) - (when (file-directory-p to) - (setq to (concat (file-name-as-directory to) - (file-name-nondirectory file)))) - (copy-file file to)) - -(defvar gnus-work-buffer " *gnus work*") - -(defun gnus-set-work-buffer () - "Put point in the empty Gnus work buffer." - (if (get-buffer gnus-work-buffer) - (progn - (set-buffer gnus-work-buffer) - (erase-buffer)) - (set-buffer (gnus-get-buffer-create gnus-work-buffer)) - (kill-all-local-variables) - (mm-enable-multibyte))) - -(defmacro gnus-group-real-name (group) - "Find the real name of a foreign newsgroup." - `(let ((gname ,group)) - (if (string-match "^[^:]+:" gname) - (substring gname (match-end 0)) - gname))) - -(defmacro gnus-group-server (group) - "Find the server name of a foreign newsgroup. -For example, (gnus-group-server \"nnimap+yxa:INBOX.foo\") would -yield \"nnimap:yxa\"." - `(let ((gname ,group)) - (if (string-match "^\\([^:+]+\\)\\(?:\\+\\([^:]*\\)\\)?:" gname) - (format "%s:%s" (match-string 1 gname) (or - (match-string 2 gname) - "")) - (format "%s:%s" (car gnus-select-method) (cadr gnus-select-method))))) - -(defun gnus-make-sort-function (funs) - "Return a composite sort condition based on the functions in FUNS." - (cond - ;; Just a simple function. - ((functionp funs) funs) - ;; No functions at all. - ((null funs) funs) - ;; A list of functions. - ((or (cdr funs) - (listp (car funs))) - (gnus-byte-compile - `(lambda (t1 t2) - ,(gnus-make-sort-function-1 (reverse funs))))) - ;; A list containing just one function. - (t - (car funs)))) - -(defun gnus-make-sort-function-1 (funs) - "Return a composite sort condition based on the functions in FUNS." - (let ((function (car funs)) - (first 't1) - (last 't2)) - (when (consp function) - (cond - ;; Reversed spec. - ((eq (car function) 'not) - (setq function (cadr function) - first 't2 - last 't1)) - ((functionp function) - ;; Do nothing. - ) - (t - (error "Invalid sort spec: %s" function)))) - (if (cdr funs) - `(or (,function ,first ,last) - (and (not (,function ,last ,first)) - ,(gnus-make-sort-function-1 (cdr funs)))) - `(,function ,first ,last)))) - -(defun gnus-turn-off-edit-menu (type) - "Turn off edit menu in `gnus-TYPE-mode-map'." - (define-key (symbol-value (intern (format "gnus-%s-mode-map" type))) - [menu-bar edit] 'undefined)) - -(defmacro gnus-bind-print-variables (&rest forms) - "Bind print-* variables and evaluate FORMS. -This macro is used with `prin1', `pp', etc. in order to ensure printed -Lisp objects are loadable. Bind `print-quoted' and `print-readably' -to t, and `print-escape-multibyte', `print-escape-newlines', -`print-escape-nonascii', `print-length', `print-level' and -`print-string-length' to nil." - `(let ((print-quoted t) - (print-readably t) - ;;print-circle - ;;print-continuous-numbering - print-escape-multibyte - print-escape-newlines - print-escape-nonascii - ;;print-gensym - print-length - print-level - print-string-length) - ,@forms)) - -(defun gnus-prin1 (form) - "Use `prin1' on FORM in the current buffer. -Bind `print-quoted' and `print-readably' to t, and `print-length' and -`print-level' to nil. See also `gnus-bind-print-variables'." - (gnus-bind-print-variables (prin1 form (current-buffer)))) - -(defun gnus-prin1-to-string (form) - "The same as `prin1'. -Bind `print-quoted' and `print-readably' to t, and `print-length' and -`print-level' to nil. See also `gnus-bind-print-variables'." - (gnus-bind-print-variables (prin1-to-string form))) - -(defun gnus-pp (form) - "Use `pp' on FORM in the current buffer. -Bind `print-quoted' and `print-readably' to t, and `print-length' and -`print-level' to nil. See also `gnus-bind-print-variables'." - (gnus-bind-print-variables (pp form (current-buffer)))) - -(defun gnus-pp-to-string (form) - "The same as `pp-to-string'. -Bind `print-quoted' and `print-readably' to t, and `print-length' and -`print-level' to nil. See also `gnus-bind-print-variables'." - (gnus-bind-print-variables (pp-to-string form))) - -(defun gnus-make-directory (directory) - "Make DIRECTORY (and all its parents) if it doesn't exist." - (require 'nnmail) - (let ((file-name-coding-system nnmail-pathname-coding-system)) - (when (and directory - (not (file-exists-p directory))) - (make-directory directory t))) - t) - -(defun gnus-write-buffer (file) - "Write the current buffer's contents to FILE." - ;; Make sure the directory exists. - (gnus-make-directory (file-name-directory file)) - (let ((file-name-coding-system nnmail-pathname-coding-system)) - ;; Write the buffer. - (write-region (point-min) (point-max) file nil 'quietly))) - -(defun gnus-delete-file (file) - "Delete FILE if it exists." - (when (file-exists-p file) - (delete-file file))) - -(defun gnus-delete-directory (directory) - "Delete files in DIRECTORY. Subdirectories remain. -If there's no subdirectory, delete DIRECTORY as well." - (when (file-directory-p directory) - (let ((files (directory-files - directory t "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")) - file dir) - (while files - (setq file (pop files)) - (if (eq t (car (file-attributes file))) - ;; `file' is a subdirectory. - (setq dir t) - ;; `file' is a file or a symlink. - (delete-file file))) - (unless dir - (delete-directory directory))))) - -;; The following two functions are used in gnus-registry. -;; They were contributed by Andreas Fuchs . -(defun gnus-alist-to-hashtable (alist) - "Build a hashtable from the values in ALIST." - (let ((ht (make-hash-table - :size 4096 - :test 'equal))) - (mapc - (lambda (kv-pair) - (puthash (car kv-pair) (cdr kv-pair) ht)) - alist) - ht)) - -(defun gnus-hashtable-to-alist (hash) - "Build an alist from the values in HASH." - (let ((list nil)) - (maphash - (lambda (key value) - (setq list (cons (cons key value) list))) - hash) - list)) - -(defun gnus-strip-whitespace (string) - "Return STRING stripped of all whitespace." - (while (string-match "[\r\n\t ]+" string) - (setq string (replace-match "" t t string))) - string) - -(defsubst gnus-put-text-property-excluding-newlines (beg end prop val) - "The same as `put-text-property', but don't put this prop on any newlines in the region." - (save-match-data - (save-excursion - (save-restriction - (goto-char beg) - (while (re-search-forward gnus-emphasize-whitespace-regexp end 'move) - (gnus-put-text-property beg (match-beginning 0) prop val) - (setq beg (point))) - (gnus-put-text-property beg (point) prop val))))) - -(defsubst gnus-put-overlay-excluding-newlines (beg end prop val) - "The same as `put-text-property', but don't put this prop on any newlines in the region." - (save-match-data - (save-excursion - (save-restriction - (goto-char beg) - (while (re-search-forward gnus-emphasize-whitespace-regexp end 'move) - (gnus-overlay-put - (gnus-make-overlay beg (match-beginning 0)) - prop val) - (setq beg (point))) - (gnus-overlay-put (gnus-make-overlay beg (point)) prop val))))) - -(defun gnus-put-text-property-excluding-characters-with-faces (beg end - prop val) - "The same as `put-text-property', but don't put props on characters with the `gnus-face' property." - (let ((b beg)) - (while (/= b end) - (when (get-text-property b 'gnus-face) - (setq b (next-single-property-change b 'gnus-face nil end))) - (when (/= b end) - (inline - (gnus-put-text-property - b (setq b (next-single-property-change b 'gnus-face nil end)) - prop val)))))) - -(defmacro gnus-faces-at (position) - "Return a list of faces at POSITION." - (if (featurep 'xemacs) - `(let ((pos ,position)) - (mapcar-extents 'extent-face - nil (current-buffer) pos pos nil 'face)) - `(let ((pos ,position)) - (delq nil (cons (get-text-property pos 'face) - (mapcar - (lambda (overlay) - (overlay-get overlay 'face)) - (overlays-at pos))))))) - -;;; Protected and atomic operations. dmoore@ucsd.edu 21.11.1996 -;;; The primary idea here is to try to protect internal datastructures -;;; from becoming corrupted when the user hits C-g, or if a hook or -;;; similar blows up. Often in Gnus multiple tables/lists need to be -;;; updated at the same time, or information can be lost. - -(defvar gnus-atomic-be-safe t - "If t, certain operations will be protected from interruption by C-g.") - -(defmacro gnus-atomic-progn (&rest forms) - "Evaluate FORMS atomically, which means to protect the evaluation -from being interrupted by the user. An error from the forms themselves -will return without finishing the operation. Since interrupts from -the user are disabled, it is recommended that only the most minimal -operations are performed by FORMS. If you wish to assign many -complicated values atomically, compute the results into temporary -variables and then do only the assignment atomically." - `(let ((inhibit-quit gnus-atomic-be-safe)) - ,@forms)) - -(put 'gnus-atomic-progn 'lisp-indent-function 0) - -(defmacro gnus-atomic-progn-assign (protect &rest forms) - "Evaluate FORMS, but insure that the variables listed in PROTECT -are not changed if anything in FORMS signals an error or otherwise -non-locally exits. The variables listed in PROTECT are updated atomically. -It is safe to use gnus-atomic-progn-assign with long computations. - -Note that if any of the symbols in PROTECT were unbound, they will be -set to nil on a successful assignment. In case of an error or other -non-local exit, it will still be unbound." - (let* ((temp-sym-map (mapcar (lambda (x) (list (make-symbol - (concat (symbol-name x) - "-tmp")) - x)) - protect)) - (sym-temp-map (mapcar (lambda (x) (list (cadr x) (car x))) - temp-sym-map)) - (temp-sym-let (mapcar (lambda (x) (list (car x) - `(and (boundp ',(cadr x)) - ,(cadr x)))) - temp-sym-map)) - (sym-temp-let sym-temp-map) - (temp-sym-assign (apply 'append temp-sym-map)) - (sym-temp-assign (apply 'append sym-temp-map)) - (result (make-symbol "result-tmp"))) - `(let (,@temp-sym-let - ,result) - (let ,sym-temp-let - (setq ,result (progn ,@forms)) - (setq ,@temp-sym-assign)) - (let ((inhibit-quit gnus-atomic-be-safe)) - (setq ,@sym-temp-assign)) - ,result))) - -(put 'gnus-atomic-progn-assign 'lisp-indent-function 1) -;(put 'gnus-atomic-progn-assign 'edebug-form-spec '(sexp body)) - -(defmacro gnus-atomic-setq (&rest pairs) - "Similar to setq, except that the real symbols are only assigned when -there are no errors. And when the real symbols are assigned, they are -done so atomically. If other variables might be changed via side-effect, -see gnus-atomic-progn-assign. It is safe to use gnus-atomic-setq -with potentially long computations." - (let ((tpairs pairs) - syms) - (while tpairs - (push (car tpairs) syms) - (setq tpairs (cddr tpairs))) - `(gnus-atomic-progn-assign ,syms - (setq ,@pairs)))) - -;(put 'gnus-atomic-setq 'edebug-form-spec '(body)) - - -;;; Functions for saving to babyl/mail files. - -(eval-when-compile - (condition-case nil - (progn - (require 'rmail) - (autoload 'rmail-update-summary "rmailsum")) - (error - (define-compiler-macro rmail-select-summary (&rest body) - ;; Rmail of the XEmacs version is supplied by the package, and - ;; requires tm and apel packages. However, there may be those - ;; who haven't installed those packages. This macro helps such - ;; people even if they install those packages later. - `(eval '(rmail-select-summary ,@body))) - ;; If there's rmail but there's no tm (or there's apel of the - ;; mainstream, not the XEmacs version), loading rmail of the XEmacs - ;; version fails halfway, however it provides the rmail-select-summary - ;; macro which uses the following functions: - (autoload 'rmail-summary-displayed "rmail") - (autoload 'rmail-maybe-display-summary "rmail"))) - (defvar rmail-default-rmail-file) - (defvar mm-text-coding-system)) - -(defun gnus-output-to-rmail (filename &optional ask) - "Append the current article to an Rmail file named FILENAME." - (require 'rmail) - (require 'mm-util) - ;; Most of these codes are borrowed from rmailout.el. - (setq filename (expand-file-name filename)) - (setq rmail-default-rmail-file filename) - (let ((artbuf (current-buffer)) - (tmpbuf (get-buffer-create " *Gnus-output*"))) - (save-excursion - (or (get-file-buffer filename) - (file-exists-p filename) - (if (or (not ask) - (gnus-yes-or-no-p - (concat "\"" filename "\" does not exist, create it? "))) - (let ((file-buffer (create-file-buffer filename))) - (save-excursion - (set-buffer file-buffer) - (rmail-insert-rmail-file-header) - (let ((require-final-newline nil) - (coding-system-for-write mm-text-coding-system)) - (gnus-write-buffer filename))) - (kill-buffer file-buffer)) - (error "Output file does not exist"))) - (set-buffer tmpbuf) - (erase-buffer) - (insert-buffer-substring artbuf) - (gnus-convert-article-to-rmail) - ;; Decide whether to append to a file or to an Emacs buffer. - (let ((outbuf (get-file-buffer filename))) - (if (not outbuf) - (let ((file-name-coding-system nnmail-pathname-coding-system)) - (mm-append-to-file (point-min) (point-max) filename)) - ;; File has been visited, in buffer OUTBUF. - (set-buffer outbuf) - (let ((buffer-read-only nil) - (msg (and (boundp 'rmail-current-message) - (symbol-value 'rmail-current-message)))) - ;; If MSG is non-nil, buffer is in RMAIL mode. - (when msg - (widen) - (narrow-to-region (point-max) (point-max))) - (insert-buffer-substring tmpbuf) - (when msg - (goto-char (point-min)) - (widen) - (search-backward "\n\^_") - (narrow-to-region (point) (point-max)) - (rmail-count-new-messages t) - (when (rmail-summary-exists) - (rmail-select-summary - (rmail-update-summary))) - (rmail-count-new-messages t) - (rmail-show-message msg)) - (save-buffer))))) - (kill-buffer tmpbuf))) - -(defun gnus-output-to-mail (filename &optional ask) - "Append the current article to a mail file named FILENAME." - (setq filename (expand-file-name filename)) - (let ((artbuf (current-buffer)) - (tmpbuf (get-buffer-create " *Gnus-output*"))) - (save-excursion - ;; Create the file, if it doesn't exist. - (when (and (not (get-file-buffer filename)) - (not (file-exists-p filename))) - (if (or (not ask) - (gnus-y-or-n-p - (concat "\"" filename "\" does not exist, create it? "))) - (let ((file-buffer (create-file-buffer filename))) - (save-excursion - (set-buffer file-buffer) - (let ((require-final-newline nil) - (coding-system-for-write mm-text-coding-system)) - (gnus-write-buffer filename))) - (kill-buffer file-buffer)) - (error "Output file does not exist"))) - (set-buffer tmpbuf) - (erase-buffer) - (insert-buffer-substring artbuf) - (goto-char (point-min)) - (if (looking-at "From ") - (forward-line 1) - (insert "From nobody " (current-time-string) "\n")) - (let (case-fold-search) - (while (re-search-forward "^From " nil t) - (beginning-of-line) - (insert ">"))) - ;; Decide whether to append to a file or to an Emacs buffer. - (let ((outbuf (get-file-buffer filename))) - (if (not outbuf) - (let ((buffer-read-only nil)) - (save-excursion - (goto-char (point-max)) - (forward-char -2) - (unless (looking-at "\n\n") - (goto-char (point-max)) - (unless (bolp) - (insert "\n")) - (insert "\n")) - (goto-char (point-max)) - (let ((file-name-coding-system nnmail-pathname-coding-system)) - (mm-append-to-file (point-min) (point-max) filename)))) - ;; File has been visited, in buffer OUTBUF. - (set-buffer outbuf) - (let ((buffer-read-only nil)) - (goto-char (point-max)) - (unless (eobp) - (insert "\n")) - (insert "\n") - (insert-buffer-substring tmpbuf))))) - (kill-buffer tmpbuf))) - -(defun gnus-convert-article-to-rmail () - "Convert article in current buffer to Rmail message format." - (let ((buffer-read-only nil)) - ;; Convert article directly into Babyl format. - (goto-char (point-min)) - (insert "\^L\n0, unseen,,\n*** EOOH ***\n") - (while (search-forward "\n\^_" nil t) ;single char - (replace-match "\n^_" t t)) ;2 chars: "^" and "_" - (goto-char (point-max)) - (insert "\^_"))) - -(defun gnus-map-function (funs arg) - "Apply the result of the first function in FUNS to the second, and so on. -ARG is passed to the first function." - (while funs - (setq arg (funcall (pop funs) arg))) - arg) - -(defun gnus-run-hooks (&rest funcs) - "Does the same as `run-hooks', but saves the current buffer." - (save-current-buffer - (apply 'run-hooks funcs))) - -(defun gnus-run-mode-hooks (&rest funcs) - "Run `run-mode-hooks' if it is available, otherwise `run-hooks'. -This function saves the current buffer." - (if (fboundp 'run-mode-hooks) - (save-current-buffer (apply 'run-mode-hooks funcs)) - (save-current-buffer (apply 'run-hooks funcs)))) - -;;; Various - -(defvar gnus-group-buffer) ; Compiler directive -(defun gnus-alive-p () - "Say whether Gnus is running or not." - (and (boundp 'gnus-group-buffer) - (get-buffer gnus-group-buffer) - (save-excursion - (set-buffer gnus-group-buffer) - (eq major-mode 'gnus-group-mode)))) - -(defun gnus-remove-if (predicate list) - "Return a copy of LIST with all items satisfying PREDICATE removed." - (let (out) - (while list - (unless (funcall predicate (car list)) - (push (car list) out)) - (setq list (cdr list))) - (nreverse out))) - -(if (fboundp 'assq-delete-all) - (defalias 'gnus-delete-alist 'assq-delete-all) - (defun gnus-delete-alist (key alist) - "Delete from ALIST all elements whose car is KEY. -Return the modified alist." - (let (entry) - (while (setq entry (assq key alist)) - (setq alist (delq entry alist))) - alist))) - -(defmacro gnus-pull (key alist &optional assoc-p) - "Modify ALIST to be without KEY." - (unless (symbolp alist) - (error "Not a symbol: %s" alist)) - (let ((fun (if assoc-p 'assoc 'assq))) - `(setq ,alist (delq (,fun ,key ,alist) ,alist)))) - -(defun gnus-globalify-regexp (re) - "Return a regexp that matches a whole line, if RE matches a part of it." - (concat (unless (string-match "^\\^" re) "^.*") - re - (unless (string-match "\\$$" re) ".*$"))) - -(defun gnus-set-window-start (&optional point) - "Set the window start to POINT, or (point) if nil." - (let ((win (gnus-get-buffer-window (current-buffer) t))) - (when win - (set-window-start win (or point (point)))))) - -(defun gnus-annotation-in-region-p (b e) - (if (= b e) - (eq (cadr (memq 'gnus-undeletable (text-properties-at b))) t) - (text-property-any b e 'gnus-undeletable t))) - -(defun gnus-or (&rest elems) - "Return non-nil if any of the elements are non-nil." - (catch 'found - (while elems - (when (pop elems) - (throw 'found t))))) - -(defun gnus-and (&rest elems) - "Return non-nil if all of the elements are non-nil." - (catch 'found - (while elems - (unless (pop elems) - (throw 'found nil))) - t)) - -(defun gnus-write-active-file (file hashtb &optional full-names) - (let ((coding-system-for-write nnmail-active-file-coding-system)) - (with-temp-file file - (mapatoms - (lambda (sym) - (when (and sym - (boundp sym) - (symbol-value sym)) - (insert (format "%S %d %d y\n" - (if full-names - sym - (intern (gnus-group-real-name (symbol-name sym)))) - (or (cdr (symbol-value sym)) - (car (symbol-value sym))) - (car (symbol-value sym)))))) - hashtb) - (goto-char (point-max)) - (while (search-backward "\\." nil t) - (delete-char 1))))) - -;; Fixme: Why not use `with-output-to-temp-buffer'? -(defmacro gnus-with-output-to-file (file &rest body) - (let ((buffer (make-symbol "output-buffer")) - (size (make-symbol "output-buffer-size")) - (leng (make-symbol "output-buffer-length")) - (append (make-symbol "output-buffer-append"))) - `(let* ((,size 131072) - (,buffer (make-string ,size 0)) - (,leng 0) - (,append nil) - (standard-output - (lambda (c) - (aset ,buffer ,leng c) - - (if (= ,size (setq ,leng (1+ ,leng))) - (progn (write-region ,buffer nil ,file ,append 'no-msg) - (setq ,leng 0 - ,append t)))))) - ,@body - (when (> ,leng 0) - (let ((coding-system-for-write 'no-conversion)) - (write-region (substring ,buffer 0 ,leng) nil ,file - ,append 'no-msg)))))) - -(put 'gnus-with-output-to-file 'lisp-indent-function 1) -(put 'gnus-with-output-to-file 'edebug-form-spec '(form body)) - -(if (fboundp 'union) - (defalias 'gnus-union 'union) - (defun gnus-union (l1 l2) - "Set union of lists L1 and L2." - (cond ((null l1) l2) - ((null l2) l1) - ((equal l1 l2) l1) - (t - (or (>= (length l1) (length l2)) - (setq l1 (prog1 l2 (setq l2 l1)))) - (while l2 - (or (member (car l2) l1) - (push (car l2) l1)) - (pop l2)) - l1)))) - -(defun gnus-add-text-properties-when - (property value start end properties &optional object) - "Like `gnus-add-text-properties', only applied on where PROPERTY is VALUE." - (let (point) - (while (and start - (< start end) ;; XEmacs will loop for every when start=end. - (setq point (text-property-not-all start end property value))) - (gnus-add-text-properties start point properties object) - (setq start (text-property-any point end property value))) - (if start - (gnus-add-text-properties start end properties object)))) - -(defun gnus-remove-text-properties-when - (property value start end properties &optional object) - "Like `remove-text-properties', only applied on where PROPERTY is VALUE." - (let (point) - (while (and start - (< start end) - (setq point (text-property-not-all start end property value))) - (remove-text-properties start point properties object) - (setq start (text-property-any point end property value))) - (if start - (remove-text-properties start end properties object)) - t)) - -;; This might use `compare-strings' to reduce consing in the -;; case-insensitive case, but it has to cope with null args. -;; (`string-equal' uses symbol print names.) -(defun gnus-string-equal (x y) - "Like `string-equal', except it compares case-insensitively." - (and (= (length x) (length y)) - (or (string-equal x y) - (string-equal (downcase x) (downcase y))))) - -(defcustom gnus-use-byte-compile t - "If non-nil, byte-compile crucial run-time code. -Setting it to nil has no effect after the first time `gnus-byte-compile' -is run." - :type 'boolean - :version "22.1" - :group 'gnus-various) - -(defun gnus-byte-compile (form) - "Byte-compile FORM if `gnus-use-byte-compile' is non-nil." - (if gnus-use-byte-compile - (progn - (condition-case nil - ;; Work around a bug in XEmacs 21.4 - (require 'byte-optimize) - (error)) - (require 'bytecomp) - (defalias 'gnus-byte-compile - (lambda (form) - (let ((byte-compile-warnings '(unresolved callargs redefine))) - (byte-compile form)))) - (gnus-byte-compile form)) - form)) - -(defun gnus-remassoc (key alist) - "Delete by side effect any elements of LIST whose car is `equal' to KEY. -The modified LIST is returned. If the first member -of LIST has a car that is `equal' to KEY, there is no way to remove it -by side effect; therefore, write `(setq foo (gnus-remassoc key foo))' to be -sure of changing the value of `foo'." - (when alist - (if (equal key (caar alist)) - (cdr alist) - (setcdr alist (gnus-remassoc key (cdr alist))) - alist))) - -(defun gnus-update-alist-soft (key value alist) - (if value - (cons (cons key value) (gnus-remassoc key alist)) - (gnus-remassoc key alist))) - -(defun gnus-create-info-command (node) - "Create a command that will go to info NODE." - `(lambda () - (interactive) - ,(concat "Enter the info system at node " node) - (Info-goto-node ,node) - (setq gnus-info-buffer (current-buffer)) - (gnus-configure-windows 'info))) - -(defun gnus-not-ignore (&rest args) - t) - -(defvar gnus-directory-sep-char-regexp "/" - "The regexp of directory separator character. -If you find some problem with the directory separator character, try -\"[/\\\\\]\" for some systems.") - -(defun gnus-url-unhex (x) - (if (> x ?9) - (if (>= x ?a) - (+ 10 (- x ?a)) - (+ 10 (- x ?A))) - (- x ?0))) - -;; Fixme: Do it like QP. -(defun gnus-url-unhex-string (str &optional allow-newlines) - "Remove %XX, embedded spaces, etc in a url. -If optional second argument ALLOW-NEWLINES is non-nil, then allow the -decoding of carriage returns and line feeds in the string, which is normally -forbidden in URL encoding." - (let ((tmp "") - (case-fold-search t)) - (while (string-match "%[0-9a-f][0-9a-f]" str) - (let* ((start (match-beginning 0)) - (ch1 (gnus-url-unhex (elt str (+ start 1)))) - (code (+ (* 16 ch1) - (gnus-url-unhex (elt str (+ start 2)))))) - (setq tmp (concat - tmp (substring str 0 start) - (cond - (allow-newlines - (char-to-string code)) - ((or (= code ?\n) (= code ?\r)) - " ") - (t (char-to-string code)))) - str (substring str (match-end 0))))) - (setq tmp (concat tmp str)) - tmp)) - -(defun gnus-make-predicate (spec) - "Transform SPEC into a function that can be called. -SPEC is a predicate specifier that contains stuff like `or', `and', -`not', lists and functions. The functions all take one parameter." - `(lambda (elem) ,(gnus-make-predicate-1 spec))) - -(defun gnus-make-predicate-1 (spec) - (cond - ((symbolp spec) - `(,spec elem)) - ((listp spec) - (if (memq (car spec) '(or and not)) - `(,(car spec) ,@(mapcar 'gnus-make-predicate-1 (cdr spec))) - (error "Invalid predicate specifier: %s" spec))))) - -(defun gnus-local-map-property (map) - "Return a list suitable for a text property list specifying keymap MAP." - (cond - ((featurep 'xemacs) - (list 'keymap map)) - ((>= emacs-major-version 21) - (list 'keymap map)) - (t - (list 'local-map map)))) - -(defmacro gnus-completing-read-maybe-default (prompt table &optional predicate - require-match initial-contents - history default) - "Like `completing-read', allowing for non-existent 7th arg in older XEmacsen." - `(completing-read ,prompt ,table ,predicate ,require-match - ,initial-contents ,history - ,@(if (and (featurep 'xemacs) (< emacs-minor-version 2)) - () - (list default)))) - -(defun gnus-completing-read (prompt table &optional predicate require-match - history) - (when (and history - (not (boundp history))) - (set history nil)) - (gnus-completing-read-maybe-default - (if (symbol-value history) - (concat prompt " (" (car (symbol-value history)) "): ") - (concat prompt ": ")) - table - predicate - require-match - nil - history - (car (symbol-value history)))) - -(defun gnus-graphic-display-p () - (or (and (fboundp 'display-graphic-p) - (display-graphic-p)) - ;;;!!!This is bogus. Fixme! - (and (featurep 'xemacs) - t))) - -(put 'gnus-parse-without-error 'lisp-indent-function 0) -(put 'gnus-parse-without-error 'edebug-form-spec '(body)) - -(defmacro gnus-parse-without-error (&rest body) - "Allow continuing onto the next line even if an error occurs." - `(while (not (eobp)) - (condition-case () - (progn - ,@body - (goto-char (point-max))) - (error - (gnus-error 4 "Invalid data on line %d" - (count-lines (point-min) (point))) - (forward-line 1))))) - -(defun gnus-cache-file-contents (file variable function) - "Cache the contents of FILE in VARIABLE. The contents come from FUNCTION." - (let ((time (nth 5 (file-attributes file))) - contents value) - (if (or (null (setq value (symbol-value variable))) - (not (equal (car value) file)) - (not (equal (nth 1 value) time))) - (progn - (setq contents (funcall function file)) - (set variable (list file time contents)) - contents) - (nth 2 value)))) - -(defun gnus-multiple-choice (prompt choice &optional idx) - "Ask user a multiple choice question. -CHOICE is a list of the choice char and help message at IDX." - (let (tchar buf) - (save-window-excursion - (save-excursion - (while (not tchar) - (message "%s (%s): " - prompt - (concat - (mapconcat (lambda (s) (char-to-string (car s))) - choice ", ") ", ?")) - (setq tchar (read-char)) - (when (not (assq tchar choice)) - (setq tchar nil) - (setq buf (get-buffer-create "*Gnus Help*")) - (pop-to-buffer buf) - (fundamental-mode) ; for Emacs 20.4+ - (buffer-disable-undo) - (erase-buffer) - (insert prompt ":\n\n") - (let ((max -1) - (list choice) - (alist choice) - (idx (or idx 1)) - (i 0) - n width pad format) - ;; find the longest string to display - (while list - (setq n (length (nth idx (car list)))) - (unless (> max n) - (setq max n)) - (setq list (cdr list))) - (setq max (+ max 4)) ; %c, `:', SPACE, a SPACE at end - (setq n (/ (1- (window-width)) max)) ; items per line - (setq width (/ (1- (window-width)) n)) ; width of each item - ;; insert `n' items, each in a field of width `width' - (while alist - (if (< i n) - () - (setq i 0) - (delete-char -1) ; the `\n' takes a char - (insert "\n")) - (setq pad (- width 3)) - (setq format (concat "%c: %-" (int-to-string pad) "s")) - (insert (format format (caar alist) (nth idx (car alist)))) - (setq alist (cdr alist)) - (setq i (1+ i)))))))) - (if (buffer-live-p buf) - (kill-buffer buf)) - tchar)) - -(defun gnus-select-frame-set-input-focus (frame) - "Select FRAME, raise it, and set input focus, if possible." - (cond ((featurep 'xemacs) - (if (fboundp 'select-frame-set-input-focus) - (select-frame-set-input-focus frame) - (raise-frame frame) - (select-frame frame) - (focus-frame frame))) - ;; `select-frame-set-input-focus' defined in Emacs 21 will not - ;; set the input focus. - ((>= emacs-major-version 22) - (select-frame-set-input-focus frame)) - (t - (raise-frame frame) - (select-frame frame) - (cond ((memq window-system '(x mac)) - (x-focus-frame frame)) - ((eq window-system 'w32) - (w32-focus-frame frame))) - (when focus-follows-mouse - (set-mouse-position frame (1- (frame-width frame)) 0))))) - -(defun gnus-frame-or-window-display-name (object) - "Given a frame or window, return the associated display name. -Return nil otherwise." - (if (featurep 'xemacs) - (device-connection (dfw-device object)) - (if (or (framep object) - (and (windowp object) - (setq object (window-frame object)))) - (let ((display (frame-parameter object 'display))) - (if (and (stringp display) - ;; Exclude invalid display names. - (string-match "\\`[^:]*:[0-9]+\\(\\.[0-9]+\\)?\\'" - display)) - display))))) - -(eval-when-compile - (defvar tool-bar-mode)) - -(defun gnus-tool-bar-update (&rest ignore) - "Update the tool bar." - (when (and (boundp 'tool-bar-mode) - tool-bar-mode) - (let* ((args nil) - (func (cond ((featurep 'xemacs) - 'ignore) - ((fboundp 'tool-bar-update) - 'tool-bar-update) - ((fboundp 'force-window-update) - 'force-window-update) - ((fboundp 'redraw-frame) - (setq args (list (selected-frame))) - 'redraw-frame) - (t 'ignore)))) - (apply func args)))) - -;; Fixme: This has only one use (in gnus-agent), which isn't worthwhile. -(defmacro gnus-mapcar (function seq1 &rest seqs2_n) - "Apply FUNCTION to each element of the sequences, and make a list of the results. -If there are several sequences, FUNCTION is called with that many arguments, -and mapping stops as soon as the shortest sequence runs out. With just one -sequence, this is like `mapcar'. With several, it is like the Common Lisp -`mapcar' function extended to arbitrary sequence types." - - (if seqs2_n - (let* ((seqs (cons seq1 seqs2_n)) - (cnt 0) - (heads (mapcar (lambda (seq) - (make-symbol (concat "head" - (int-to-string - (setq cnt (1+ cnt)))))) - seqs)) - (result (make-symbol "result")) - (result-tail (make-symbol "result-tail"))) - `(let* ,(let* ((bindings (cons nil nil)) - (heads heads)) - (nconc bindings (list (list result '(cons nil nil)))) - (nconc bindings (list (list result-tail result))) - (while heads - (nconc bindings (list (list (pop heads) (pop seqs))))) - (cdr bindings)) - (while (and ,@heads) - (setcdr ,result-tail (cons (funcall ,function - ,@(mapcar (lambda (h) (list 'car h)) - heads)) - nil)) - (setq ,result-tail (cdr ,result-tail) - ,@(apply 'nconc (mapcar (lambda (h) (list h (list 'cdr h))) heads)))) - (cdr ,result))) - `(mapcar ,function ,seq1))) - -(if (fboundp 'merge) - (defalias 'gnus-merge 'merge) - ;; Adapted from cl-seq.el - (defun gnus-merge (type list1 list2 pred) - "Destructively merge lists LIST1 and LIST2 to produce a new list. -Argument TYPE is for compatibility and ignored. -Ordering of the elements is preserved according to PRED, a `less-than' -predicate on the elements." - (let ((res nil)) - (while (and list1 list2) - (if (funcall pred (car list2) (car list1)) - (push (pop list2) res) - (push (pop list1) res))) - (nconc (nreverse res) list1 list2)))) - -(eval-when-compile - (defvar xemacs-codename) - (defvar sxemacs-codename) - (defvar emacs-program-version)) - -(defun gnus-emacs-version () - "Stringified Emacs version." - (let* ((lst (if (listp gnus-user-agent) - gnus-user-agent - '(gnus emacs type))) - (system-v (cond ((memq 'config lst) - system-configuration) - ((memq 'type lst) - (symbol-name system-type)) - (t nil))) - codename emacsname) - (cond ((featurep 'sxemacs) - (setq emacsname "SXEmacs" - codename sxemacs-codename)) - ((featurep 'xemacs) - (setq emacsname "XEmacs" - codename xemacs-codename)) - (t - (setq emacsname "Emacs"))) - (cond - ((not (memq 'emacs lst)) - nil) - ((string-match "^\\(\\([.0-9]+\\)*\\)\\.[0-9]+$" emacs-version) - ;; Emacs: - (concat "Emacs/" (match-string 1 emacs-version) - (if system-v - (concat " (" system-v ")") - ""))) - ((or (featurep 'sxemacs) (featurep 'xemacs)) - ;; XEmacs or SXEmacs: - (concat emacsname "/" emacs-program-version - " (" - (when (and (memq 'codename lst) - codename) - (concat codename - (when system-v ", "))) - (when system-v system-v) - ")")) - (t emacs-version)))) - -(defun gnus-rename-file (old-path new-path &optional trim) - "Rename OLD-PATH as NEW-PATH. If TRIM, recursively delete -empty directories from OLD-PATH." - (when (file-exists-p old-path) - (let* ((old-dir (file-name-directory old-path)) - (old-name (file-name-nondirectory old-path)) - (new-dir (file-name-directory new-path)) - (new-name (file-name-nondirectory new-path)) - temp) - (gnus-make-directory new-dir) - (rename-file old-path new-path t) - (when trim - (while (progn (setq temp (directory-files old-dir)) - (while (member (car temp) '("." "..")) - (setq temp (cdr temp))) - (= (length temp) 0)) - (delete-directory old-dir) - (setq old-dir (file-name-as-directory - (file-truename - (concat old-dir ".."))))))))) - -(if (fboundp 'set-process-query-on-exit-flag) - (defalias 'gnus-set-process-query-on-exit-flag - 'set-process-query-on-exit-flag) - (defalias 'gnus-set-process-query-on-exit-flag - 'process-kill-without-query)) - -(if (fboundp 'with-local-quit) - (defalias 'gnus-with-local-quit 'with-local-quit) - (defmacro gnus-with-local-quit (&rest body) - "Execute BODY, allowing quits to terminate BODY but not escape further. -When a quit terminates BODY, `gnus-with-local-quit' returns nil but -requests another quit. That quit will be processed as soon as quitting -is allowed once again. (Immediately, if `inhibit-quit' is nil.)" - ;;(declare (debug t) (indent 0)) - `(condition-case nil - (let ((inhibit-quit nil)) - ,@body) - (quit (setq quit-flag t) - ;; This call is to give a chance to handle quit-flag - ;; in case inhibit-quit is nil. - ;; Without this, it will not be handled until the next function - ;; call, and that might allow it to exit thru a condition-case - ;; that intends to handle the quit signal next time. - (eval '(ignore nil)))))) - -(provide 'gnus-util) - -;;; arch-tag: f94991af-d32b-4c97-8c26-ca12a934de49 -;;; gnus-util.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-uu.el b/xemacs-packages/gnus/lisp/gnus-uu.el deleted file mode 100644 index ae220cf2..00000000 --- a/xemacs-packages/gnus/lisp/gnus-uu.el +++ /dev/null @@ -1,2120 +0,0 @@ -;;; gnus-uu.el --- extract (uu)encoded files in Gnus - -;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, -;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Created: 2 Oct 1993 -;; Keyword: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) -(require 'gnus-art) -(require 'message) -(require 'gnus-msg) -(require 'mm-decode) - -(defgroup gnus-extract nil - "Extracting encoded files." - :prefix "gnus-uu-" - :group 'gnus) - -(defgroup gnus-extract-view nil - "Viewwing extracted files." - :group 'gnus-extract) - -(defgroup gnus-extract-archive nil - "Extracting encoded archives." - :group 'gnus-extract) - -(defgroup gnus-extract-post nil - "Extracting encoded archives." - :prefix "gnus-uu-post" - :group 'gnus-extract) - -;; Default viewing action rules - -(defcustom gnus-uu-default-view-rules - '(("\\.te?xt$\\|\\.doc$\\|read.*me\\|\\.c?$\\|\\.h$\\|\\.bat$\\|\\.asm$\\|makefile" "cat %s | sed 's/\r$//'") - ("\\.pas$" "cat %s | sed 's/\r$//'") - ("\\.[1-9]$" "groff -mandoc -Tascii %s | sed s/\b.//g") - ("\\.\\(jpe?g\\|gif\\|tiff?\\|p[pgb]m\\|xwd\\|xbm\\|pcx\\)$" "display") - ("\\.tga$" "tgatoppm %s | ee -") - ("\\.\\(wav\\|aiff\\|hcom\\|u[blw]\\|s[bfw]\\|voc\\|smp\\)$" - "sox -v .5 %s -t .au -u - > /dev/audio") - ("\\.au$" "cat %s > /dev/audio") - ("\\.midi?$" "playmidi -f") - ("\\.mod$" "str32") - ("\\.ps$" "ghostview") - ("\\.dvi$" "xdvi") - ("\\.html$" "xmosaic") - ("\\.mpe?g$" "mpeg_play") - ("\\.\\(flc\\|fli\\|rle\\|iff\\|pfx\\|avi\\|sme\\|rpza\\|dl\\|qt\\|rsrc\\|mov\\)$" "xanim") - ("\\.\\(tar\\|arj\\|zip\\|zoo\\|arc\\|gz\\|Z\\|lzh\\|ar\\|lha\\)$" - "gnus-uu-archive")) - "*Default actions to be taken when the user asks to view a file. -To change the behavior, you can either edit this variable or set -`gnus-uu-user-view-rules' to something useful. - -For example: - -To make gnus-uu use 'xli' to display JPEG and GIF files, put the -following in your .emacs file: - - (setq gnus-uu-user-view-rules '((\"jpg$\\\\|gif$\" \"xli\"))) - -Both these variables are lists of lists with two string elements. The -first string is a regular expression. If the file name matches this -regular expression, the command in the second string is executed with -the file as an argument. - -If the command string contains \"%s\", the file name will be inserted -at that point in the command string. If there's no \"%s\" in the -command string, the file name will be appended to the command string -before executing. - -There are several user variables to tailor the behavior of gnus-uu to -your needs. First we have `gnus-uu-user-view-rules', which is the -variable gnus-uu first consults when trying to decide how to view a -file. If this variable contains no matches, gnus-uu examines the -default rule variable provided in this package. If gnus-uu finds no -match here, it uses `gnus-uu-user-view-rules-end' to try to make a -match." - :group 'gnus-extract-view - :type '(repeat (group regexp (string :tag "Command")))) - -(defcustom gnus-uu-user-view-rules nil - "What actions are to be taken to view a file. -See the documentation on the `gnus-uu-default-view-rules' variable for -details." - :group 'gnus-extract-view - :type '(repeat (group regexp (string :tag "Command")))) - -(defcustom gnus-uu-user-view-rules-end - '(("" "file")) - "*What actions are to be taken if no rule matched the file name. -See the documentation on the `gnus-uu-default-view-rules' variable for -details." - :group 'gnus-extract-view - :type '(repeat (group regexp (string :tag "Command")))) - -;; Default unpacking commands - -(defcustom gnus-uu-default-archive-rules - '(("\\.tar$" "tar xf") - ("\\.zip$" "unzip -o") - ("\\.ar$" "ar x") - ("\\.arj$" "unarj x") - ("\\.zoo$" "zoo -e") - ("\\.\\(lzh\\|lha\\)$" "lha x") - ("\\.Z$" "uncompress") - ("\\.gz$" "gunzip") - ("\\.arc$" "arc -x")) - "*See `gnus-uu-user-archive-rules'." - :group 'gnus-extract-archive - :type '(repeat (group regexp (string :tag "Command")))) - -(defvar gnus-uu-destructive-archivers - (list "uncompress" "gunzip")) - -(defcustom gnus-uu-user-archive-rules nil - "A list that can be set to override the default archive unpacking commands. -To use, for instance, 'untar' to unpack tar files and 'zip -x' to -unpack zip files, say the following: - (setq gnus-uu-user-archive-rules - '((\"\\\\.tar$\" \"untar\") - (\"\\\\.zip$\" \"zip -x\")))" - :group 'gnus-extract-archive - :type '(repeat (group regexp (string :tag "Command")))) - -(defcustom gnus-uu-ignore-files-by-name nil - "*A regular expression saying what files should not be viewed based on name. -If, for instance, you want gnus-uu to ignore all .au and .wav files, -you could say something like - - (setq gnus-uu-ignore-files-by-name \"\\\\.au$\\\\|\\\\.wav$\") - -Note that this variable can be used in conjunction with the -`gnus-uu-ignore-files-by-type' variable." - :group 'gnus-extract - :type '(choice (const :tag "off" nil) - (regexp :format "%v"))) - -(defcustom gnus-uu-ignore-files-by-type nil - "*A regular expression saying what files that shouldn't be viewed, based on MIME file type. -If, for instance, you want gnus-uu to ignore all audio files and all mpegs, -you could say something like - - (setq gnus-uu-ignore-files-by-type \"audio/\\\\|video/mpeg\") - -Note that this variable can be used in conjunction with the -`gnus-uu-ignore-files-by-name' variable." - :group 'gnus-extract - :type '(choice (const :tag "off" nil) - (regexp :format "%v"))) - -;; Pseudo-MIME support - -(defconst gnus-uu-ext-to-mime-list - '(("\\.gif$" "image/gif") - ("\\.jpe?g$" "image/jpeg") - ("\\.tiff?$" "image/tiff") - ("\\.xwd$" "image/xwd") - ("\\.pbm$" "image/pbm") - ("\\.pgm$" "image/pgm") - ("\\.ppm$" "image/ppm") - ("\\.xbm$" "image/xbm") - ("\\.pcx$" "image/pcx") - ("\\.tga$" "image/tga") - ("\\.ps$" "image/postscript") - ("\\.fli$" "video/fli") - ("\\.wav$" "audio/wav") - ("\\.aiff$" "audio/aiff") - ("\\.hcom$" "audio/hcom") - ("\\.voc$" "audio/voc") - ("\\.smp$" "audio/smp") - ("\\.mod$" "audio/mod") - ("\\.dvi$" "image/dvi") - ("\\.mpe?g$" "video/mpeg") - ("\\.au$" "audio/basic") - ("\\.\\(te?xt\\|doc\\|c\\|h\\)$" "text/plain") - ("\\.\\(c\\|h\\)$" "text/source") - ("read.*me" "text/plain") - ("\\.html$" "text/html") - ("\\.bat$" "text/bat") - ("\\.[1-6]$" "text/man") - ("\\.flc$" "video/flc") - ("\\.rle$" "video/rle") - ("\\.pfx$" "video/pfx") - ("\\.avi$" "video/avi") - ("\\.sme$" "video/sme") - ("\\.rpza$" "video/prza") - ("\\.dl$" "video/dl") - ("\\.qt$" "video/qt") - ("\\.rsrc$" "video/rsrc") - ("\\..*$" "unknown/unknown"))) - -;; Various variables users may set - -(defcustom gnus-uu-tmp-dir - (cond ((fboundp 'temp-directory) (temp-directory)) - ((boundp 'temporary-file-directory) temporary-file-directory) - ("/tmp/")) - "*Variable saying where gnus-uu is to do its work. -Default is \"/tmp/\"." - :group 'gnus-extract - :type 'directory) - -(defcustom gnus-uu-do-not-unpack-archives nil - "*Non-nil means that gnus-uu won't peek inside archives looking for files to display. -Default is nil." - :group 'gnus-extract-archive - :type 'boolean) - -(defcustom gnus-uu-ignore-default-view-rules nil - "*Non-nil means that gnus-uu will ignore the default viewing rules. -Only the user viewing rules will be consulted. Default is nil." - :group 'gnus-extract-view - :type 'boolean) - -(defcustom gnus-uu-grabbed-file-functions nil - "Functions run on each file after successful decoding. -They will be called with the name of the file as the argument. -Likely functions you can use in this list are `gnus-uu-grab-view' -and `gnus-uu-grab-move'." - :group 'gnus-extract - :options '(gnus-uu-grab-view gnus-uu-grab-move) - :type 'hook) - -(defcustom gnus-uu-ignore-default-archive-rules nil - "*Non-nil means that gnus-uu will ignore the default archive unpacking commands. -Only the user unpacking commands will be consulted. Default is nil." - :group 'gnus-extract-archive - :type 'boolean) - -(defcustom gnus-uu-kill-carriage-return t - "*Non-nil means that gnus-uu will strip all carriage returns from articles. -Default is t." - :group 'gnus-extract - :type 'boolean) - -(defcustom gnus-uu-view-with-metamail nil - "*Non-nil means that files will be viewed with metamail. -The gnus-uu viewing functions will be ignored and gnus-uu will try -to guess at a content-type based on file name suffixes. Default -it nil." - :group 'gnus-extract - :type 'boolean) - -(defcustom gnus-uu-unmark-articles-not-decoded nil - "*Non-nil means that gnus-uu will mark articles that were unsuccessfully decoded as unread. -Default is nil." - :group 'gnus-extract - :type 'boolean) - -(defcustom gnus-uu-correct-stripped-uucode nil - "*Non-nil means that gnus-uu will *try* to fix uuencoded files that have had trailing spaces deleted. -Default is nil." - :group 'gnus-extract - :type 'boolean) - -(defcustom gnus-uu-save-in-digest nil - "*Non-nil means that gnus-uu, when asked to save without decoding, will save in digests. -If this variable is nil, gnus-uu will just save everything in a -file without any embellishments. The digesting almost conforms to RFC1153 - -no easy way to specify any meaningful volume and issue numbers were found, -so I simply dropped them." - :group 'gnus-extract - :type 'boolean) - -(defcustom gnus-uu-pre-uudecode-hook nil - "Hook run before sending a message to uudecode." - :group 'gnus-extract - :type 'hook) - -(defcustom gnus-uu-digest-headers - '("^Date:" "^From:" "^To:" "^Cc:" "^Subject:" "^Message-ID:" "^Keywords:" - "^Summary:" "^References:" "^Content-Type:" "^Content-Transfer-Encoding:" - "^MIME-Version:" "^Content-Disposition:" "^Content-Description:" - "^Content-ID:") - "*List of regexps to match headers included in digested messages. -The headers will be included in the sequence they are matched. If nil -include all headers." - :group 'gnus-extract - :type '(repeat regexp)) - -(defcustom gnus-uu-save-separate-articles nil - "*Non-nil means that gnus-uu will save articles in separate files." - :group 'gnus-extract - :type 'boolean) - -(defcustom gnus-uu-be-dangerous 'ask - "*Specifies what to do if unusual situations arise during decoding. -If nil, be as conservative as possible. If t, ignore things that -didn't work, and overwrite existing files. Otherwise, ask each time." - :group 'gnus-extract - :type '(choice (const :tag "conservative" nil) - (const :tag "ask" ask) - (const :tag "liberal" t))) - -;; Internal variables - -(defvar gnus-uu-saved-article-name nil) - -(defvar gnus-uu-begin-string "^begin[ \t]+0?[0-7][0-7][0-7][ \t]+\\(.*\\)$") -(defvar gnus-uu-end-string "^end[ \t]*$") - -(defvar gnus-uu-body-line "^M") -(let ((i 61)) - (while (> (setq i (1- i)) 0) - (setq gnus-uu-body-line (concat gnus-uu-body-line "[^a-z]"))) - (setq gnus-uu-body-line (concat gnus-uu-body-line ".?$"))) - -;"^M.............................................................?$" - -(defvar gnus-uu-shar-begin-string "^#! */bin/sh") - -(defvar gnus-uu-shar-file-name nil) -(defvar gnus-uu-shar-name-marker - "begin 0?[0-7][0-7][0-7][ \t]+\\(\\(\\w\\|[.\\:]\\)*\\b\\)") - -(defvar gnus-uu-postscript-begin-string "^%!PS-") -(defvar gnus-uu-postscript-end-string "^%%EOF$") - -(defvar gnus-uu-file-name nil) -(defvar gnus-uu-uudecode-process nil) -(defvar gnus-uu-binhex-article-name nil) - -(defvar gnus-uu-work-dir nil) - -(defvar gnus-uu-output-buffer-name " *Gnus UU Output*") - -(defvar gnus-uu-default-dir gnus-article-save-directory) -(defvar gnus-uu-digest-from-subject nil) -(defvar gnus-uu-digest-buffer nil) - -;; Commands. - -(defun gnus-uu-decode-uu (&optional n) - "Uudecodes the current article." - (interactive "P") - (gnus-uu-decode-with-method 'gnus-uu-uustrip-article n)) - -(defun gnus-uu-decode-uu-and-save (n dir) - "Decodes and saves the resulting file." - (interactive - (list current-prefix-arg - (file-name-as-directory - (read-file-name "Uudecode and save in dir: " - gnus-uu-default-dir - gnus-uu-default-dir t)))) - (gnus-uu-decode-with-method 'gnus-uu-uustrip-article n dir nil nil t)) - -(defun gnus-uu-decode-unshar (&optional n) - "Unshars the current article." - (interactive "P") - (gnus-uu-decode-with-method 'gnus-uu-unshar-article n nil nil 'scan t)) - -(defun gnus-uu-decode-unshar-and-save (n dir) - "Unshars and saves the current article." - (interactive - (list current-prefix-arg - (file-name-as-directory - (read-file-name "Unshar and save in dir: " - gnus-uu-default-dir - gnus-uu-default-dir t)))) - (gnus-uu-decode-with-method 'gnus-uu-unshar-article n dir nil 'scan t)) - -(defun gnus-uu-decode-save (n file) - "Saves the current article." - (interactive - (list current-prefix-arg - (read-file-name - (if gnus-uu-save-separate-articles - "Save articles in dir: " - "Save articles in file: ") - gnus-uu-default-dir - gnus-uu-default-dir))) - (setq gnus-uu-saved-article-name file) - (gnus-uu-decode-with-method 'gnus-uu-save-article n nil t)) - -(defun gnus-uu-decode-binhex (n dir) - "Unbinhexes the current article." - (interactive - (list current-prefix-arg - (file-name-as-directory - (read-file-name "Unbinhex and save in dir: " - gnus-uu-default-dir - gnus-uu-default-dir)))) - (setq gnus-uu-binhex-article-name - (mm-make-temp-file (expand-file-name "binhex" gnus-uu-work-dir))) - (gnus-uu-decode-with-method 'gnus-uu-binhex-article n dir)) - -(defun gnus-uu-decode-uu-view (&optional n) - "Uudecodes and views the current article." - (interactive "P") - (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) - (gnus-uu-decode-uu n))) - -(defun gnus-uu-decode-uu-and-save-view (n dir) - "Decodes, views and saves the resulting file." - (interactive - (list current-prefix-arg - (read-file-name "Uudecode, view and save in dir: " - gnus-uu-default-dir - gnus-uu-default-dir t))) - (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) - (gnus-uu-decode-uu-and-save n dir))) - -(defun gnus-uu-decode-unshar-view (&optional n) - "Unshars and views the current article." - (interactive "P") - (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) - (gnus-uu-decode-unshar n))) - -(defun gnus-uu-decode-unshar-and-save-view (n dir) - "Unshars and saves the current article." - (interactive - (list current-prefix-arg - (read-file-name "Unshar, view and save in dir: " - gnus-uu-default-dir - gnus-uu-default-dir t))) - (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) - (gnus-uu-decode-unshar-and-save n dir))) - -(defun gnus-uu-decode-save-view (n file) - "Saves and views the current article." - (interactive - (list current-prefix-arg - (read-file-name (if gnus-uu-save-separate-articles - "Save articles is dir: " - "Save articles in file: ") - gnus-uu-default-dir gnus-uu-default-dir))) - (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) - (gnus-uu-decode-save n file))) - -(defun gnus-uu-decode-binhex-view (n file) - "Unbinhexes and views the current article." - (interactive - (list current-prefix-arg - (read-file-name "Unbinhex, view and save in dir: " - gnus-uu-default-dir gnus-uu-default-dir))) - (setq gnus-uu-binhex-article-name - (mm-make-temp-file (expand-file-name "binhex" gnus-uu-work-dir))) - (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) - (gnus-uu-decode-binhex n file))) - - -;; Digest and forward articles - -(defun gnus-uu-digest-mail-forward (&optional n post) - "Digests and forwards all articles in this series." - (interactive "P") - (let ((gnus-uu-save-in-digest t) - (file (mm-make-temp-file (nnheader-concat gnus-uu-tmp-dir "forward"))) - (message-forward-as-mime message-forward-as-mime) - (mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets) - gnus-uu-digest-buffer subject from) - (if (and n (not (numberp n))) - (setq message-forward-as-mime (not message-forward-as-mime) - n nil)) - (let ((gnus-article-reply (gnus-summary-work-articles n))) - (gnus-setup-message 'forward - (setq gnus-uu-digest-from-subject nil) - (setq gnus-uu-digest-buffer - (gnus-get-buffer-create " *gnus-uu-forward*")) - (gnus-uu-decode-save n file) - (switch-to-buffer gnus-uu-digest-buffer) - (let ((fs gnus-uu-digest-from-subject)) - (when fs - (setq from (caar fs) - subject (gnus-simplify-subject-fuzzy (cdar fs)) - fs (cdr fs)) - (while (and fs (or from subject)) - (when from - (unless (string= from (caar fs)) - (setq from nil))) - (when subject - (unless (string= (gnus-simplify-subject-fuzzy (cdar fs)) - subject) - (setq subject nil))) - (setq fs (cdr fs)))) - (unless subject - (setq subject "Digested Articles")) - (unless from - (setq from - (if (gnus-news-group-p gnus-newsgroup-name) - gnus-newsgroup-name - "Various")))) - (goto-char (point-min)) - (when (re-search-forward "^Subject: ") - (delete-region (point) (gnus-point-at-eol)) - (insert subject)) - (goto-char (point-min)) - (when (re-search-forward "^From:") - (delete-region (point) (gnus-point-at-eol)) - (insert " " from)) - (let ((message-forward-decoded-p t)) - (message-forward post t)))) - (setq gnus-uu-digest-from-subject nil))) - -(defun gnus-uu-digest-post-forward (&optional n) - "Digest and forward to a newsgroup." - (interactive "P") - (gnus-uu-digest-mail-forward n t)) - -;; Process marking. - -(defun gnus-message-process-mark (unmarkp new-marked) - (let ((old (- (length gnus-newsgroup-processable) (length new-marked)))) - (message "%d mark%s %s%s" - (length new-marked) - (if (= (length new-marked) 1) "" "s") - (if unmarkp "removed" "added") - (cond - ((and (zerop old) - (not unmarkp)) - "") - (unmarkp - (format ", %d remain marked" - (length gnus-newsgroup-processable))) - (t - (format ", %d already marked" old)))))) - -(defun gnus-new-processable (unmarkp articles) - (if unmarkp - (gnus-intersection gnus-newsgroup-processable articles) - (gnus-set-difference articles gnus-newsgroup-processable))) - -(defun gnus-uu-mark-by-regexp (regexp &optional unmark) - "Set the process mark on articles whose subjects match REGEXP. -When called interactively, prompt for REGEXP. -Optional UNMARK non-nil means unmark instead of mark." - (interactive "sMark (regexp): \nP") - (save-excursion - (let* ((articles (gnus-uu-find-articles-matching regexp)) - (new-marked (gnus-new-processable unmark articles))) - (while articles - (if unmark - (gnus-summary-remove-process-mark (pop articles)) - (gnus-summary-set-process-mark (pop articles)))) - (gnus-message-process-mark unmark new-marked))) - (gnus-summary-position-point)) - -(defun gnus-uu-unmark-by-regexp (regexp) - "Remove the process mark from articles whose subjects match REGEXP. -When called interactively, prompt for REGEXP." - (interactive "sUnmark (regexp): ") - (gnus-uu-mark-by-regexp regexp t)) - -(defun gnus-uu-mark-series () - "Mark the current series with the process mark." - (interactive) - (let* ((articles (gnus-uu-find-articles-matching)) - (l (length articles))) - (while articles - (gnus-summary-set-process-mark (car articles)) - (setq articles (cdr articles))) - (message "Marked %d articles" l)) - (gnus-summary-position-point)) - -(defun gnus-uu-mark-region (beg end &optional unmark) - "Set the process mark on all articles between point and mark." - (interactive "r") - (save-excursion - (goto-char beg) - (while (< (point) end) - (if unmark - (gnus-summary-remove-process-mark (gnus-summary-article-number)) - (gnus-summary-set-process-mark (gnus-summary-article-number))) - (forward-line 1))) - (gnus-summary-position-point)) - -(defun gnus-uu-unmark-region (beg end) - "Remove the process mark from all articles between point and mark." - (interactive "r") - (gnus-uu-mark-region beg end t)) - -(defun gnus-uu-mark-buffer () - "Set the process mark on all articles in the buffer." - (interactive) - (gnus-uu-mark-region (point-min) (point-max))) - -(defun gnus-uu-unmark-buffer () - "Remove the process mark on all articles in the buffer." - (interactive) - (gnus-uu-mark-region (point-min) (point-max) t)) - -(defun gnus-uu-mark-thread () - "Marks all articles downwards in this thread." - (interactive) - (gnus-save-hidden-threads - (let ((level (gnus-summary-thread-level))) - (while (and (gnus-summary-set-process-mark - (gnus-summary-article-number)) - (zerop (gnus-summary-next-subject 1 nil t)) - (> (gnus-summary-thread-level) level))))) - (gnus-summary-position-point)) - -(defun gnus-uu-unmark-thread () - "Unmarks all articles downwards in this thread." - (interactive) - (let ((level (gnus-summary-thread-level))) - (while (and (gnus-summary-remove-process-mark - (gnus-summary-article-number)) - (zerop (gnus-summary-next-subject 1)) - (> (gnus-summary-thread-level) level)))) - (gnus-summary-position-point)) - -(defun gnus-uu-invert-processable () - "Invert the list of process-marked articles." - (interactive) - (let ((data gnus-newsgroup-data) - number) - (save-excursion - (while data - (if (memq (setq number (gnus-data-number (pop data))) - gnus-newsgroup-processable) - (gnus-summary-remove-process-mark number) - (gnus-summary-set-process-mark number))))) - (gnus-summary-position-point)) - -(defun gnus-uu-mark-over (&optional score) - "Mark all articles with a score over SCORE (the prefix)." - (interactive "P") - (let ((score (or score gnus-summary-default-score 0)) - (data gnus-newsgroup-data)) - (save-excursion - (while data - (when (> (or (cdr (assq (gnus-data-number (car data)) - gnus-newsgroup-scored)) - gnus-summary-default-score 0) - score) - (gnus-summary-set-process-mark (caar data))) - (setq data (cdr data)))) - (gnus-summary-position-point))) - -(defun gnus-uu-mark-sparse () - "Mark all series that have some articles marked." - (interactive) - (let ((marked (nreverse gnus-newsgroup-processable)) - subject articles total headers) - (unless marked - (error "No articles marked with the process mark")) - (setq gnus-newsgroup-processable nil) - (save-excursion - (while marked - (and (vectorp (setq headers - (gnus-summary-article-header (car marked)))) - (setq subject (mail-header-subject headers) - articles (gnus-uu-find-articles-matching - (gnus-uu-reginize-string subject)) - total (nconc total articles))) - (while articles - (gnus-summary-set-process-mark (car articles)) - (setcdr marked (delq (car articles) (cdr marked))) - (setq articles (cdr articles))) - (setq marked (cdr marked))) - (setq gnus-newsgroup-processable (nreverse total))) - (gnus-summary-position-point))) - -(defun gnus-uu-mark-all () - "Mark all articles in \"series\" order." - (interactive) - (setq gnus-newsgroup-processable nil) - (save-excursion - (let ((data gnus-newsgroup-data) - number) - (while data - (when (and (not (memq (setq number (gnus-data-number (car data))) - gnus-newsgroup-processable)) - (vectorp (gnus-data-header (car data)))) - (gnus-summary-goto-subject number) - (gnus-uu-mark-series)) - (setq data (cdr data))))) - (gnus-summary-position-point)) - -;; All PostScript functions written by Erik Selberg . - -(defun gnus-uu-decode-postscript (&optional n) - "Gets postscript of the current article." - (interactive "P") - (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article n)) - -(defun gnus-uu-decode-postscript-view (&optional n) - "Gets and views the current article." - (interactive "P") - (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) - (gnus-uu-decode-postscript n))) - -(defun gnus-uu-decode-postscript-and-save (n dir) - "Extracts postscript and saves the current article." - (interactive - (list current-prefix-arg - (file-name-as-directory - (read-file-name "Save in dir: " - gnus-uu-default-dir - gnus-uu-default-dir t)))) - (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article - n dir nil nil t)) - -(defun gnus-uu-decode-postscript-and-save-view (n dir) - "Decodes, views and saves the resulting file." - (interactive - (list current-prefix-arg - (read-file-name "Where do you want to save the file(s)? " - gnus-uu-default-dir - gnus-uu-default-dir t))) - (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) - (gnus-uu-decode-postscript-and-save n dir))) - - -;; Internal functions. - -(defun gnus-uu-decode-with-method (method n &optional save not-insert - scan cdir) - (gnus-uu-initialize scan) - (when save - (setq gnus-uu-default-dir save)) - ;; Create the directory we save to. - (when (and scan cdir save - (not (file-exists-p save))) - (make-directory save t)) - (let ((articles (gnus-uu-get-list-of-articles n)) - files) - (setq files (gnus-uu-grab-articles articles method t)) - (let ((gnus-current-article (car articles))) - (when scan - (setq files (gnus-uu-scan-directory gnus-uu-work-dir)))) - (when save - (gnus-uu-save-files files save)) - (when (eq gnus-uu-do-not-unpack-archives nil) - (setq files (gnus-uu-unpack-files files))) - (setq files (nreverse (gnus-uu-get-actions files))) - (or not-insert (not gnus-insert-pseudo-articles) - (gnus-summary-insert-pseudos files save)))) - -(defun gnus-uu-scan-directory (dir &optional rec) - "Return a list of all files under DIR." - (let ((files (directory-files dir t)) - out file) - (while (setq file (pop files)) - (unless (member (file-name-nondirectory file) '("." "..")) - (push (list (cons 'name file) - (cons 'article gnus-current-article)) - out) - (when (file-directory-p file) - (setq out (nconc (gnus-uu-scan-directory file t) out))))) - (if rec - out - (nreverse out)))) - -(defun gnus-uu-save-files (files dir) - "Save FILES in DIR." - (let ((len (length files)) - (reg (concat "^" (regexp-quote gnus-uu-work-dir))) - to-file file fromdir) - (while (setq file (cdr (assq 'name (pop files)))) - (when (file-exists-p file) - (string-match reg file) - (setq fromdir (substring file (match-end 0))) - (if (file-directory-p file) - (gnus-make-directory (concat dir fromdir)) - (setq to-file (concat dir fromdir)) - (when (or (not (file-exists-p to-file)) - (eq gnus-uu-be-dangerous t) - (and gnus-uu-be-dangerous - (gnus-y-or-n-p (format "%s exists; overwrite? " - to-file)))) - (copy-file file to-file t t))))) - (gnus-message 5 "Saved %d file%s" len (if (= len 1) "" "s")))) - -;; Functions for saving and possibly digesting articles without -;; any decoding. - -;; Function called by gnus-uu-grab-articles to treat each article. -(defun gnus-uu-save-article (buffer in-state) - (cond - (gnus-uu-save-separate-articles - (save-excursion - (set-buffer buffer) - (let ((coding-system-for-write mm-text-coding-system)) - (gnus-write-buffer - (concat gnus-uu-saved-article-name gnus-current-article))) - (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin)) - ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name - 'begin 'end)) - ((eq in-state 'last) (list 'end)) - (t (list 'middle))))) - ((not gnus-uu-save-in-digest) - (save-excursion - (set-buffer buffer) - (write-region (point-min) (point-max) gnus-uu-saved-article-name t) - (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin)) - ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name - 'begin 'end)) - ((eq in-state 'last) (list 'end)) - (t (list 'middle))))) - (t - (let ((header (gnus-summary-article-header))) - (push (cons (mail-header-from header) - (mail-header-subject header)) - gnus-uu-digest-from-subject)) - (let ((name (file-name-nondirectory gnus-uu-saved-article-name)) - beg subj headers headline sorthead body end-string state) - (if (or (eq in-state 'first) - (eq in-state 'first-and-last)) - (progn - (setq state (list 'begin)) - (save-excursion - (set-buffer (gnus-get-buffer-create "*gnus-uu-body*")) - (erase-buffer)) - (save-excursion - (set-buffer (gnus-get-buffer-create "*gnus-uu-pre*")) - (erase-buffer) - (insert (format - "Date: %s\nFrom: %s\nSubject: %s Digest\n\n" - (message-make-date) name name)) - (when (and message-forward-as-mime gnus-uu-digest-buffer) - (insert - "<#mml type=message/rfc822>\nSubject: Topics\n\n<#/mml>\n") - (forward-line -1)) - (insert "Topics:\n"))) - (when (not (eq in-state 'end)) - (setq state (list 'middle)))) - (save-excursion - (set-buffer "*gnus-uu-body*") - (goto-char (setq beg (point-max))) - (save-excursion - (save-restriction - (set-buffer buffer) - (let (buffer-read-only) - (gnus-set-text-properties (point-min) (point-max) nil) - ;; These two are necessary for XEmacs 19.12 fascism. - (put-text-property (point-min) (point-max) 'invisible nil) - (put-text-property (point-min) (point-max) 'intangible nil)) - (when (and message-forward-as-mime - message-forward-show-mml - gnus-uu-digest-buffer) - (mm-enable-multibyte) - (mime-to-mml)) - (goto-char (point-min)) - (re-search-forward "\n\n") - (unless (and message-forward-as-mime gnus-uu-digest-buffer) - ;; Quote all 30-dash lines. - (save-excursion - (while (re-search-forward "^-" nil t) - (beginning-of-line) - (delete-char 1) - (insert "- ")))) - (setq body (buffer-substring (1- (point)) (point-max))) - (narrow-to-region (point-min) (point)) - (if (not (setq headers gnus-uu-digest-headers)) - (setq sorthead (buffer-string)) - (while headers - (setq headline (car headers)) - (setq headers (cdr headers)) - (goto-char (point-min)) - (while (re-search-forward headline nil t) - (setq sorthead - (concat sorthead - (buffer-substring - (match-beginning 0) - (or (and (re-search-forward "^[^ \t]" nil t) - (1- (point))) - (progn (forward-line 1) (point))))))))) - (widen))) - (if (and message-forward-as-mime gnus-uu-digest-buffer) - (if message-forward-show-mml - (progn - (insert "\n<#mml type=message/rfc822>\n") - (insert sorthead) (goto-char (point-max)) - (insert body) (goto-char (point-max)) - (insert "\n<#/mml>\n")) - (let ((buf (mml-generate-new-buffer " *mml*"))) - (with-current-buffer buf - (insert sorthead) - (goto-char (point-min)) - (when (re-search-forward "^Subject: \\(.*\\)$" nil t) - (setq subj (buffer-substring (match-beginning 1) - (match-end 1)))) - (goto-char (point-max)) - (insert body)) - (insert "\n<#part type=message/rfc822" - " buffer=\"" (buffer-name buf) "\">\n"))) - (insert sorthead) (goto-char (point-max)) - (insert body) (goto-char (point-max)) - (insert (concat "\n" (make-string 30 ?-) "\n\n"))) - (goto-char beg) - (when (re-search-forward "^Subject: \\(.*\\)$" nil t) - (setq subj (buffer-substring (match-beginning 1) (match-end 1)))) - (when subj - (save-excursion - (set-buffer "*gnus-uu-pre*") - (insert (format " %s\n" subj))))) - (when (or (eq in-state 'last) - (eq in-state 'first-and-last)) - (if (and message-forward-as-mime gnus-uu-digest-buffer) - (with-current-buffer gnus-uu-digest-buffer - (erase-buffer) - (insert-buffer-substring "*gnus-uu-pre*") - (goto-char (point-max)) - (insert-buffer-substring "*gnus-uu-body*")) - (save-excursion - (set-buffer "*gnus-uu-pre*") - (insert (format "\n\n%s\n\n" (make-string 70 ?-))) - (if gnus-uu-digest-buffer - (with-current-buffer gnus-uu-digest-buffer - (erase-buffer) - (insert-buffer-substring "*gnus-uu-pre*")) - (let ((coding-system-for-write mm-text-coding-system)) - (gnus-write-buffer gnus-uu-saved-article-name)))) - (save-excursion - (set-buffer "*gnus-uu-body*") - (goto-char (point-max)) - (insert - (concat (setq end-string (format "End of %s Digest" name)) - "\n")) - (insert (concat (make-string (length end-string) ?*) "\n")) - (if gnus-uu-digest-buffer - (with-current-buffer gnus-uu-digest-buffer - (goto-char (point-max)) - (insert-buffer-substring "*gnus-uu-body*")) - (let ((coding-system-for-write mm-text-coding-system) - (file-name-coding-system nnmail-pathname-coding-system)) - (write-region - (point-min) (point-max) gnus-uu-saved-article-name t))))) - (gnus-kill-buffer "*gnus-uu-pre*") - (gnus-kill-buffer "*gnus-uu-body*") - (push 'end state)) - (if (memq 'begin state) - (cons gnus-uu-saved-article-name state) - state))))) - -;; Binhex treatment - not very advanced. - -(defvar gnus-uu-binhex-body-line - "^[^:]...............................................................$") -(defvar gnus-uu-binhex-begin-line - "^:...............................................................$") -(defvar gnus-uu-binhex-end-line - ":$") - -(defun gnus-uu-binhex-article (buffer in-state) - (let (state start-char) - (save-excursion - (set-buffer buffer) - (widen) - (goto-char (point-min)) - (when (not (re-search-forward gnus-uu-binhex-begin-line nil t)) - (when (not (re-search-forward gnus-uu-binhex-body-line nil t)) - (setq state (list 'wrong-type)))) - - (if (memq 'wrong-type state) - () - (beginning-of-line) - (setq start-char (point)) - (if (looking-at gnus-uu-binhex-begin-line) - (progn - (setq state (list 'begin)) - (write-region (point-min) (point-min) - gnus-uu-binhex-article-name)) - (setq state (list 'middle))) - (goto-char (point-max)) - (re-search-backward (concat gnus-uu-binhex-body-line "\\|" - gnus-uu-binhex-end-line) - nil t) - (when (looking-at gnus-uu-binhex-end-line) - (setq state (if (memq 'begin state) - (cons 'end state) - (list 'end)))) - (beginning-of-line) - (forward-line 1) - (when (file-exists-p gnus-uu-binhex-article-name) - (mm-append-to-file start-char (point) gnus-uu-binhex-article-name)))) - (if (memq 'begin state) - (cons gnus-uu-binhex-article-name state) - state))) - -;; PostScript - -(defun gnus-uu-decode-postscript-article (process-buffer in-state) - (let ((state (list 'ok)) - start-char end-char file-name) - (save-excursion - (set-buffer process-buffer) - (goto-char (point-min)) - (if (not (re-search-forward gnus-uu-postscript-begin-string nil t)) - (setq state (list 'wrong-type)) - (beginning-of-line) - (setq start-char (point)) - (if (not (re-search-forward gnus-uu-postscript-end-string nil t)) - (setq state (list 'wrong-type)) - (setq end-char (point)) - (set-buffer (gnus-get-buffer-create gnus-uu-output-buffer-name)) - (insert-buffer-substring process-buffer start-char end-char) - (setq file-name (concat gnus-uu-work-dir - (cdr gnus-article-current) ".ps")) - (write-region (point-min) (point-max) file-name) - (setq state (list file-name 'begin 'end))))) - state)) - - -;; Find actions. - -(defun gnus-uu-get-actions (files) - (let ((ofiles files) - action name) - (while files - (setq name (cdr (assq 'name (car files)))) - (and - (setq action (gnus-uu-get-action name)) - (setcar files (nconc (list (if (string= action "gnus-uu-archive") - (cons 'action "file") - (cons 'action action)) - (cons 'execute (gnus-uu-command - action name))) - (car files)))) - (setq files (cdr files))) - ofiles)) - -(defun gnus-uu-get-action (file-name) - (let (action) - (setq action - (gnus-uu-choose-action - file-name - (append - gnus-uu-user-view-rules - (if gnus-uu-ignore-default-view-rules - nil - gnus-uu-default-view-rules) - gnus-uu-user-view-rules-end))) - (when (and (not (string= (or action "") "gnus-uu-archive")) - gnus-uu-view-with-metamail) - (when (setq action - (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list)) - (setq action (format "metamail -d -b -c \"%s\"" action)))) - action)) - - -;; Functions for treating subjects and collecting series. - -(defun gnus-uu-reginize-string (string) - ;; Takes a string and puts a \ in front of every special character; - ;; replaces the last thing that looks like "2/3" with "[0-9]+/3" - ;; or, if it can't find something like that, tries "2 of 3", then - ;; finally just replaces the next to last number with "[0-9]+". - (save-excursion - (set-buffer (gnus-get-buffer-create gnus-uu-output-buffer-name)) - (buffer-disable-undo) - (erase-buffer) - (insert (regexp-quote string)) - - (setq case-fold-search nil) - - (end-of-line) - (if (re-search-backward "\\([^0-9]\\)[0-9]+/\\([0-9]+\\)" nil t) - (replace-match "\\1[0-9]+/\\2") - - (end-of-line) - (if (re-search-backward "\\([^0-9]\\)[0-9]+[ \t]*of[ \t]*\\([0-9]+\\)" - nil t) - (replace-match "\\1[0-9]+ of \\2") - - (end-of-line) - (if (re-search-backward "\\([^0-9]\\)[0-9]+\\([^0-9]+\\)[0-9]+" - nil t) - (replace-match "\\1[0-9]+\\2[0-9]+" t nil nil nil)))) - - (goto-char 1) - (while (re-search-forward "[ \t]+" nil t) - (replace-match "[ \t]+" t t)) - - (buffer-string))) - -(defun gnus-uu-get-list-of-articles (n) - ;; If N is non-nil, the article numbers of the N next articles - ;; will be returned. - ;; If any articles have been marked as processable, they will be - ;; returned. - ;; Failing that, articles that have subjects that are part of the - ;; same "series" as the current will be returned. - (let (articles) - (cond - (n - (setq n (prefix-numeric-value n)) - (let ((backward (< n 0)) - (n (abs n))) - (save-excursion - (while (and (> n 0) - (push (gnus-summary-article-number) - articles) - (gnus-summary-search-forward nil nil backward)) - (setq n (1- n)))) - (nreverse articles))) - (gnus-newsgroup-processable - (reverse gnus-newsgroup-processable)) - (t - (gnus-uu-find-articles-matching))))) - -(defun gnus-uu-string< (l1 l2) - (string< (car l1) (car l2))) - -(defun gnus-uu-find-articles-matching - (&optional subject only-unread do-not-translate) - ;; Finds all articles that matches the regexp SUBJECT. If it is - ;; nil, the current article name will be used. If ONLY-UNREAD is - ;; non-nil, only unread articles are chosen. If DO-NOT-TRANSLATE is - ;; non-nil, article names are not equalized before sorting. - (let ((subject (or subject - (gnus-uu-reginize-string (gnus-summary-article-subject)))) - list-of-subjects) - (save-excursion - (when subject - ;; Collect all subjects matching subject. - (let ((case-fold-search t) - (data gnus-newsgroup-data) - subj mark d) - (while data - (setq d (pop data)) - (and (not (gnus-data-pseudo-p d)) - (or (not only-unread) - (= (setq mark (gnus-data-mark d)) - gnus-unread-mark) - (= mark gnus-ticked-mark) - (= mark gnus-dormant-mark)) - (setq subj (mail-header-subject (gnus-data-header d))) - (string-match subject subj) - (push (cons subj (gnus-data-number d)) - list-of-subjects)))) - - ;; Expand numbers, sort, and return the list of article - ;; numbers. - (mapcar (lambda (sub) (cdr sub)) - (sort (gnus-uu-expand-numbers - list-of-subjects - (not do-not-translate)) - 'gnus-uu-string<)))))) - -(defun gnus-uu-expand-numbers (string-list &optional translate) - ;; Takes a list of strings and "expands" all numbers in all the - ;; strings. That is, this function makes all numbers equal length by - ;; prepending lots of zeroes before each number. This is to ease later - ;; sorting to find out what sequence the articles are supposed to be - ;; decoded in. Returns the list of expanded strings. - (let ((out-list string-list) - string) - (save-excursion - (set-buffer (gnus-get-buffer-create gnus-uu-output-buffer-name)) - (buffer-disable-undo) - (while string-list - (erase-buffer) - (insert (caar string-list)) - ;; Translate multiple spaces to one space. - (goto-char (point-min)) - (while (re-search-forward "[ \t]+" nil t) - (replace-match " ")) - ;; Translate all characters to "a". - (goto-char (point-min)) - (when translate - (while (re-search-forward "[A-Za-z]" nil t) - (replace-match "a" t t))) - ;; Expand numbers. - (goto-char (point-min)) - (while (re-search-forward "[0-9]+" nil t) - (ignore-errors - (replace-match - (format "%06d" - (string-to-number (buffer-substring - (match-beginning 0) (match-end 0))))))) - (setq string (buffer-substring 1 (point-max))) - (setcar (car string-list) string) - (setq string-list (cdr string-list)))) - out-list)) - - -;; `gnus-uu-grab-articles' is the general multi-article treatment -;; function. It takes a list of articles to be grabbed and a function -;; to apply to each article. -;; -;; The function to be called should take two parameters. The first -;; parameter is the article buffer. The function should leave the -;; result, if any, in this buffer. Most treatment functions will just -;; generate files... -;; -;; The second parameter is the state of the list of articles, and can -;; have four values: `first', `middle', `last' and `first-and-last'. -;; -;; The function should return a list. The list may contain the -;; following symbols: -;; `error' if an error occurred -;; `begin' if the beginning of an encoded file has been received -;; If the list returned contains a `begin', the first element of -;; the list *must* be a string with the file name of the decoded -;; file. -;; `end' if the end of an encoded file has been received -;; `middle' if the article was a body part of an encoded file -;; `wrong-type' if the article was not a part of an encoded file -;; `ok', which can be used everything is ok - -(defvar gnus-uu-has-been-grabbed nil) - -(defun gnus-uu-unmark-list-of-grabbed (&optional dont-unmark-last-article) - (let (art) - (if (not (and gnus-uu-has-been-grabbed - gnus-uu-unmark-articles-not-decoded)) - () - (when dont-unmark-last-article - (setq art (car gnus-uu-has-been-grabbed)) - (setq gnus-uu-has-been-grabbed (cdr gnus-uu-has-been-grabbed))) - (while gnus-uu-has-been-grabbed - (gnus-summary-tick-article (car gnus-uu-has-been-grabbed) t) - (setq gnus-uu-has-been-grabbed (cdr gnus-uu-has-been-grabbed))) - (when dont-unmark-last-article - (setq gnus-uu-has-been-grabbed (list art)))))) - -;; This function takes a list of articles and a function to apply to -;; each article grabbed. -;; -;; This function returns a list of files decoded if the grabbing and -;; the process-function has been successful and nil otherwise. -(defun gnus-uu-grab-articles (articles process-function - &optional sloppy limit no-errors) - (let ((state 'first) - (gnus-asynchronous nil) - (gnus-inhibit-treatment t) - has-been-begin article result-file result-files process-state - gnus-summary-display-article-function - gnus-article-prepare-hook gnus-display-mime-function - article-series files) - - (while (and articles - (not (memq 'error process-state)) - (or sloppy - (not (memq 'end process-state)))) - - (setq article (pop articles)) - (when (vectorp (gnus-summary-article-header article)) - (push article article-series) - - (unless articles - (if (eq state 'first) - (setq state 'first-and-last) - (setq state 'last))) - - (let ((part (gnus-uu-part-number article))) - (gnus-message 6 "Getting article %d%s..." - article (if (string= part "") "" (concat ", " part)))) - (gnus-summary-display-article article) - - ;; Push the article to the processing function. - (save-excursion - (set-buffer gnus-original-article-buffer) - (let ((buffer-read-only nil)) - (save-excursion - (set-buffer gnus-summary-buffer) - (setq process-state - (funcall process-function - gnus-original-article-buffer state))))) - - (gnus-summary-remove-process-mark article) - - ;; If this is the beginning of a decoded file, we push it - ;; on to a list. - (when (or (memq 'begin process-state) - (and (or (eq state 'first) - (eq state 'first-and-last)) - (memq 'ok process-state))) - (when has-been-begin - ;; If there is a `result-file' here, that means that the - ;; file was unsuccessfully decoded, so we delete it. - (when (and result-file - (file-exists-p result-file) - (not gnus-uu-be-dangerous) - (or (eq gnus-uu-be-dangerous t) - (gnus-y-or-n-p - (format "Delete unsuccessfully decoded file %s? " - result-file)))) - (delete-file result-file))) - (when (memq 'begin process-state) - (setq result-file (car process-state))) - (setq has-been-begin t)) - - ;; Check whether we have decoded one complete file. - (when (memq 'end process-state) - (setq article-series nil) - (setq has-been-begin nil) - (if (stringp result-file) - (setq files (list result-file)) - (setq files result-file)) - (setq result-file (car files)) - (while files - (push (list (cons 'name (pop files)) - (cons 'article article)) - result-files)) - ;; Allow user-defined functions to be run on this file. - (when gnus-uu-grabbed-file-functions - (let ((funcs gnus-uu-grabbed-file-functions)) - (unless (listp funcs) - (setq funcs (list funcs))) - (while funcs - (funcall (pop funcs) result-file)))) - (setq result-file nil) - ;; Check whether we have decoded enough articles. - (and limit (= (length result-files) limit) - (setq articles nil))) - - ;; If this is the last article to be decoded, and - ;; we still haven't reached the end, then we delete - ;; the partially decoded file. - (and (or (eq state 'last) (eq state 'first-and-last)) - (not (memq 'end process-state)) - result-file - (file-exists-p result-file) - (not gnus-uu-be-dangerous) - (or (eq gnus-uu-be-dangerous t) - (gnus-y-or-n-p - (format "Delete incomplete file %s? " result-file))) - (delete-file result-file)) - - ;; If this was a file of the wrong sort, then - (when (and (or (memq 'wrong-type process-state) - (memq 'error process-state)) - gnus-uu-unmark-articles-not-decoded) - (gnus-summary-tick-article article t)) - - ;; Set the new series state. - (if (and (not has-been-begin) - (not sloppy) - (or (memq 'end process-state) - (memq 'middle process-state))) - (progn - (setq process-state (list 'error)) - (gnus-message 2 "No begin part at the beginning") - (sleep-for 2)) - (setq state 'middle)))) - - ;; When there are no result-files, then something must be wrong. - (if result-files - (message "") - (cond - ((not has-been-begin) - (gnus-message 2 "Wrong type file")) - ((memq 'error process-state) - (gnus-message 2 "An error occurred during decoding")) - ((not (or (memq 'ok process-state) - (memq 'end process-state))) - (gnus-message 2 "End of articles reached before end of file"))) - ;; Make unsuccessfully decoded articles unread. - (when gnus-uu-unmark-articles-not-decoded - (while article-series - (gnus-summary-tick-article (pop article-series) t)))) - - ;; The original article buffer is hosed, shoot it down. - (gnus-kill-buffer gnus-original-article-buffer) - (setq gnus-current-article nil) - result-files)) - -(defun gnus-uu-grab-view (file) - "View FILE using the gnus-uu methods." - (let ((action (gnus-uu-get-action file))) - (gnus-execute-command - (if (string-match "%" action) - (format action file) - (concat action " " file)) - (eq gnus-view-pseudos 'not-confirm)))) - -(defun gnus-uu-grab-move (file) - "Move FILE to somewhere." - (when gnus-uu-default-dir - (let ((to-file (concat (file-name-as-directory gnus-uu-default-dir) - (file-name-nondirectory file)))) - (rename-file file to-file) - (unless (file-exists-p file) - (make-symbolic-link to-file file))))) - -(defun gnus-uu-part-number (article) - (let* ((header (gnus-summary-article-header article)) - (subject (and header (mail-header-subject header))) - (part nil)) - (if subject - (while (string-match "[0-9]+/[0-9]+\\|[0-9]+[ \t]+of[ \t]+[0-9]+" - subject) - (setq part (match-string 0 subject)) - (setq subject (substring subject (match-end 0))))) - (or part - (while (string-match "\\([0-9]+\\)[^0-9]+\\([0-9]+\\)" subject) - (setq part (match-string 0 subject)) - (setq subject (substring subject (match-end 0))))) - (or part ""))) - -(defun gnus-uu-uudecode-sentinel (process event) - (delete-process (get-process process))) - -(defun gnus-uu-uustrip-article (process-buffer in-state) - ;; Uudecodes a file asynchronously. - (save-excursion - (set-buffer process-buffer) - (let ((state (list 'wrong-type)) - process-connection-type case-fold-search buffer-read-only - files start-char) - (goto-char (point-min)) - - ;; Deal with ^M at the end of the lines. - (when gnus-uu-kill-carriage-return - (save-excursion - (while (search-forward "\r" nil t) - (delete-backward-char 1)))) - - (while (or (re-search-forward gnus-uu-begin-string nil t) - (re-search-forward gnus-uu-body-line nil t)) - (setq state (list 'ok)) - ;; Ok, we are at the first uucoded line. - (beginning-of-line) - (setq start-char (point)) - - (if (not (looking-at gnus-uu-begin-string)) - (setq state (list 'middle)) - ;; This is the beginning of a uuencoded article. - ;; We replace certain characters that could make things messy. - (setq gnus-uu-file-name - (gnus-map-function - mm-file-name-rewrite-functions - (file-name-nondirectory (match-string 1)))) - (replace-match (concat "begin 644 " gnus-uu-file-name) t t) - - ;; Remove any non gnus-uu-body-line right after start. - (forward-line 1) - (while (and (not (eobp)) - (not (looking-at gnus-uu-body-line))) - (gnus-delete-line)) - - ;; If a process is running, we kill it. - (when (and gnus-uu-uudecode-process - (memq (process-status gnus-uu-uudecode-process) - '(run stop))) - (delete-process gnus-uu-uudecode-process) - (gnus-uu-unmark-list-of-grabbed t)) - - ;; Start a new uudecoding process. - (let ((cdir default-directory)) - (unwind-protect - (progn - (cd gnus-uu-work-dir) - (setq gnus-uu-uudecode-process - (start-process - "*uudecode*" - (gnus-get-buffer-create gnus-uu-output-buffer-name) - shell-file-name shell-command-switch - (format "cd %s %s uudecode" gnus-uu-work-dir - gnus-shell-command-separator)))) - (cd cdir))) - (set-process-sentinel - gnus-uu-uudecode-process 'gnus-uu-uudecode-sentinel) - (setq state (list 'begin)) - (push (concat gnus-uu-work-dir gnus-uu-file-name) files)) - - ;; We look for the end of the thing to be decoded. - (if (re-search-forward gnus-uu-end-string nil t) - (push 'end state) - (goto-char (point-max)) - (re-search-backward gnus-uu-body-line nil t)) - - (forward-line 1) - - (when gnus-uu-uudecode-process - (when (memq (process-status gnus-uu-uudecode-process) '(run stop)) - ;; Try to correct mishandled uucode. - (when gnus-uu-correct-stripped-uucode - (gnus-uu-check-correct-stripped-uucode start-char (point))) - (gnus-run-hooks 'gnus-uu-pre-uudecode-hook) - - ;; Send the text to the process. - (condition-case nil - (process-send-region - gnus-uu-uudecode-process start-char (point)) - (error - (progn - (delete-process gnus-uu-uudecode-process) - (gnus-message 2 "gnus-uu: Couldn't uudecode") - (setq state (list 'wrong-type))))) - - (if (memq 'end state) - (progn - ;; Send an EOF, just in case. - (ignore-errors - (process-send-eof gnus-uu-uudecode-process)) - (while (memq (process-status gnus-uu-uudecode-process) - '(open run)) - (accept-process-output gnus-uu-uudecode-process 1))) - (when (or (not gnus-uu-uudecode-process) - (not (memq (process-status gnus-uu-uudecode-process) - '(run stop)))) - (setq state (list 'wrong-type))))))) - - (if (memq 'begin state) - (cons (if (= (length files) 1) (car files) files) state) - state)))) - -(defvar gnus-uu-unshar-warning - "*** WARNING *** - -Shell archives are an archaic method of bundling files for distribution -across computer networks. During the unpacking process, arbitrary commands -are executed on your system, and all kinds of nasty things can happen. -Please examine the archive very carefully before you instruct Emacs to -unpack it. You can browse the archive buffer using \\[scroll-other-window]. - -If you are unsure what to do, please answer \"no\"." - "Text of warning message displayed by `gnus-uu-unshar-article'. -Make sure that this text consists only of few text lines. Otherwise, -Gnus might fail to display all of it.") - - -;; This function is used by `gnus-uu-grab-articles' to treat -;; a shared article. -(defun gnus-uu-unshar-article (process-buffer in-state) - (let ((state (list 'ok)) - start-char) - (save-excursion - (set-buffer process-buffer) - (goto-char (point-min)) - (if (not (re-search-forward gnus-uu-shar-begin-string nil t)) - (setq state (list 'wrong-type)) - (save-window-excursion - (save-excursion - (switch-to-buffer (current-buffer)) - (delete-other-windows) - (let ((buffer (get-buffer-create (generate-new-buffer-name - "*Warning*")))) - (unless - (unwind-protect - (with-current-buffer buffer - (insert (substitute-command-keys - gnus-uu-unshar-warning)) - (goto-char (point-min)) - (display-buffer buffer) - (yes-or-no-p "This is a shell archive, unshar it? ")) - (kill-buffer buffer)) - (setq state (list 'error)))))) - (unless (memq 'error state) - (beginning-of-line) - (setq start-char (point)) - (call-process-region - start-char (point-max) shell-file-name nil - (gnus-get-buffer-create gnus-uu-output-buffer-name) nil - shell-command-switch - (concat "cd " gnus-uu-work-dir " " - gnus-shell-command-separator " sh"))))) - state)) - -;; Returns the name of what the shar file is going to unpack. -(defun gnus-uu-find-name-in-shar () - (let ((oldpoint (point)) - res) - (goto-char (point-min)) - (when (re-search-forward gnus-uu-shar-name-marker nil t) - (setq res (buffer-substring (match-beginning 1) (match-end 1)))) - (goto-char oldpoint) - res)) - -;; `gnus-uu-choose-action' chooses what action to perform given the name -;; and `gnus-uu-file-action-list'. Returns either nil if no action is -;; found, or the name of the command to run if such a rule is found. -(defun gnus-uu-choose-action (file-name file-action-list &optional no-ignore) - (let ((action-list (copy-sequence file-action-list)) - (case-fold-search t) - rule action) - (and - (unless no-ignore - (and (not - (and gnus-uu-ignore-files-by-name - (string-match gnus-uu-ignore-files-by-name file-name))) - (not - (and gnus-uu-ignore-files-by-type - (string-match gnus-uu-ignore-files-by-type - (or (gnus-uu-choose-action - file-name gnus-uu-ext-to-mime-list t) - "")))))) - (while (not (or (eq action-list ()) action)) - (setq rule (car action-list)) - (setq action-list (cdr action-list)) - (when (string-match (car rule) file-name) - (setq action (cadr rule))))) - action)) - -(defun gnus-uu-treat-archive (file-path) - ;; Unpacks an archive. Returns t if unpacking is successful. - (let ((did-unpack t) - action command dir) - (setq action (gnus-uu-choose-action - file-path (append gnus-uu-user-archive-rules - (if gnus-uu-ignore-default-archive-rules - nil - gnus-uu-default-archive-rules)))) - - (when (not action) - (error "No unpackers for the file %s" file-path)) - - (string-match "/[^/]*$" file-path) - (setq dir (substring file-path 0 (match-beginning 0))) - - (when (member action gnus-uu-destructive-archivers) - (copy-file file-path (concat file-path "~") t)) - - (setq command (format "cd %s ; %s" dir (gnus-uu-command action file-path))) - - (save-excursion - (set-buffer (gnus-get-buffer-create gnus-uu-output-buffer-name)) - (erase-buffer)) - - (gnus-message 5 "Unpacking: %s..." (gnus-uu-command action file-path)) - - (if (eq 0 (call-process shell-file-name nil - (gnus-get-buffer-create gnus-uu-output-buffer-name) - nil shell-command-switch command)) - (message "") - (gnus-message 2 "Error during unpacking of archive") - (setq did-unpack nil)) - - (when (member action gnus-uu-destructive-archivers) - (rename-file (concat file-path "~") file-path t)) - - did-unpack)) - -(defun gnus-uu-dir-files (dir) - (let ((dirs (directory-files dir t "[^/][^\\.][^\\.]?$")) - files file) - (while dirs - (if (file-directory-p (setq file (car dirs))) - (setq files (append files (gnus-uu-dir-files file))) - (push file files)) - (setq dirs (cdr dirs))) - files)) - -(defun gnus-uu-unpack-files (files &optional ignore) - ;; Go through FILES and look for files to unpack. - (let* ((totfiles (gnus-uu-ls-r gnus-uu-work-dir)) - (ofiles files) - file did-unpack) - (while files - (setq file (cdr (assq 'name (car files)))) - (when (and (not (member file ignore)) - (equal (gnus-uu-get-action (file-name-nondirectory file)) - "gnus-uu-archive")) - (push file did-unpack) - (unless (gnus-uu-treat-archive file) - (gnus-message 2 "Error during unpacking of %s" file)) - (let* ((newfiles (gnus-uu-ls-r gnus-uu-work-dir)) - (nfiles newfiles)) - (while nfiles - (unless (member (car nfiles) totfiles) - (push (list (cons 'name (car nfiles)) - (cons 'original file)) - ofiles)) - (setq nfiles (cdr nfiles))) - (setq totfiles newfiles))) - (setq files (cdr files))) - (if did-unpack - (gnus-uu-unpack-files ofiles (append did-unpack ignore)) - ofiles))) - -(defun gnus-uu-ls-r (dir) - (let* ((files (gnus-uu-directory-files dir t)) - (ofiles files)) - (while files - (when (file-directory-p (car files)) - (setq ofiles (delete (car files) ofiles)) - (setq ofiles (append ofiles (gnus-uu-ls-r (car files))))) - (setq files (cdr files))) - ofiles)) - -;; Various stuff - -(defun gnus-uu-directory-files (dir &optional full) - (let (files out file) - (setq files (directory-files dir full)) - (while files - (setq file (car files)) - (setq files (cdr files)) - (unless (member (file-name-nondirectory file) '("." "..")) - (push file out))) - (setq out (nreverse out)) - out)) - -(defun gnus-uu-check-correct-stripped-uucode (start end) - (save-excursion - (let (found beg length) - (if (not gnus-uu-correct-stripped-uucode) - () - (goto-char start) - - (if (re-search-forward " \\|`" end t) - (progn - (goto-char start) - (while (not (eobp)) - (progn - (when (looking-at "\n") - (replace-match "")) - (forward-line 1)))) - - (while (not (eobp)) - (if (looking-at (concat gnus-uu-begin-string "\\|" - gnus-uu-end-string)) - () - (when (not found) - (beginning-of-line) - (setq beg (point)) - (end-of-line) - (setq length (- (point) beg))) - (setq found t) - (beginning-of-line) - (setq beg (point)) - (end-of-line) - (when (not (= length (- (point) beg))) - (insert (make-string (- length (- (point) beg)) ? )))) - (forward-line 1))))))) - -(defvar gnus-uu-tmp-alist nil) - -(defun gnus-uu-initialize (&optional scan) - (let (entry) - (if (and (not scan) - (when (setq entry (assoc gnus-newsgroup-name gnus-uu-tmp-alist)) - (if (file-exists-p (cdr entry)) - (setq gnus-uu-work-dir (cdr entry)) - (setq gnus-uu-tmp-alist (delq entry gnus-uu-tmp-alist)) - nil))) - t - (setq gnus-uu-tmp-dir (file-name-as-directory - (expand-file-name gnus-uu-tmp-dir))) - (if (not (file-directory-p gnus-uu-tmp-dir)) - (error "Temp directory %s doesn't exist" gnus-uu-tmp-dir) - (when (not (file-writable-p gnus-uu-tmp-dir)) - (error "Temp directory %s can't be written to" - gnus-uu-tmp-dir))) - - (setq gnus-uu-work-dir - (mm-make-temp-file (concat gnus-uu-tmp-dir "gnus") 'dir)) - (set-file-modes gnus-uu-work-dir 448) - (setq gnus-uu-work-dir (file-name-as-directory gnus-uu-work-dir)) - (push (cons gnus-newsgroup-name gnus-uu-work-dir) - gnus-uu-tmp-alist)))) - - -;; Kills the temporary uu buffers, kills any processes, etc. -(defun gnus-uu-clean-up () - (let (buf) - (and gnus-uu-uudecode-process - (memq (process-status (or gnus-uu-uudecode-process "nevair")) - '(stop run)) - (delete-process gnus-uu-uudecode-process)) - (when (setq buf (get-buffer gnus-uu-output-buffer-name)) - (kill-buffer buf)))) - -;; Inputs an action and a filename and returns a full command, making sure -;; that the filename will be treated as a single argument when the shell -;; executes the command. -(defun gnus-uu-command (action file) - (let ((quoted-file (mm-quote-arg file))) - (if (string-match "%s" action) - (format action quoted-file) - (concat action " " quoted-file)))) - -(defun gnus-uu-delete-work-dir (&optional dir) - "Delete recursively all files and directories under `gnus-uu-work-dir'." - (if dir - (gnus-message 7 "Deleting directory %s..." dir) - (setq dir gnus-uu-work-dir)) - (when (and dir - (file-exists-p dir)) - (let ((files (directory-files dir t nil t)) - file) - (while (setq file (pop files)) - (unless (member (file-name-nondirectory file) '("." "..")) - (if (file-directory-p file) - (gnus-uu-delete-work-dir file) - (gnus-message 9 "Deleting file %s..." file) - (condition-case err - (delete-file file) - (error (gnus-message 3 "Deleting file %s failed... %s" file err)))))) - (condition-case err - (delete-directory dir) - (error (gnus-message 3 "Deleting directory %s failed... %s" file err)))) - (gnus-message 7 ""))) - -;; Initializing - -(add-hook 'gnus-exit-group-hook 'gnus-uu-clean-up) -(add-hook 'gnus-exit-group-hook 'gnus-uu-delete-work-dir) - - - -;;; -;;; uuencoded posting -;;; - -;; Any function that is to be used as and encoding method will take two -;; parameters: PATH-NAME and FILE-NAME. (E.g. "/home/gaga/spiral.jpg" -;; and "spiral.jpg", respectively.) The function should return nil if -;; the encoding wasn't successful. -(defcustom gnus-uu-post-encode-method 'gnus-uu-post-encode-uuencode - "Function used for encoding binary files. -There are three functions supplied with gnus-uu for encoding files: -`gnus-uu-post-encode-uuencode', which does straight uuencoding; -`gnus-uu-post-encode-mime', which encodes with base64 and adds MIME -headers; and `gnus-uu-post-encode-mime-uuencode', which encodes with -uuencode and adds MIME headers." - :group 'gnus-extract-post - :type '(radio (function-item gnus-uu-post-encode-uuencode) - (function-item gnus-uu-post-encode-mime) - (function-item gnus-uu-post-encode-mime-uuencode) - (function :tag "Other"))) - -(defcustom gnus-uu-post-include-before-composing nil - "Non-nil means that gnus-uu will ask for a file to encode before you compose the article. -If this variable is t, you can either include an encoded file with -\\[gnus-uu-post-insert-binary-in-article] or have one included for you when you post the article." - :group 'gnus-extract-post - :type 'boolean) - -(defcustom gnus-uu-post-length 990 - "Maximum length of an article. -The encoded file will be split into how many articles it takes to -post the entire file." - :group 'gnus-extract-post - :type 'integer) - -(defcustom gnus-uu-post-threaded nil - "Non-nil means that gnus-uu will post the encoded file in a thread. -This may not be smart, as no other decoder I have seen are able to -follow threads when collecting uuencoded articles. (Well, I have seen -one package that does that - gnus-uu, but somehow, I don't think that -counts...) The default is nil." - :group 'gnus-extract-post - :type 'boolean) - -(defcustom gnus-uu-post-separate-description t - "Non-nil means that the description will be posted in a separate article. -The first article will typically be numbered (0/x). If this variable -is nil, the description the user enters will be included at the -beginning of the first article, which will be numbered (1/x). Default -is t." - :group 'gnus-extract-post - :type 'boolean) - -(defvar gnus-uu-post-binary-separator "--binary follows this line--") -(defvar gnus-uu-post-message-id nil) -(defvar gnus-uu-post-inserted-file-name nil) -(defvar gnus-uu-winconf-post-news nil) - -(defun gnus-uu-post-news () - "Compose an article and post an encoded file." - (interactive) - (setq gnus-uu-post-inserted-file-name nil) - (setq gnus-uu-winconf-post-news (current-window-configuration)) - - (gnus-summary-post-news) - - (let ((map (make-sparse-keymap))) - (set-keymap-parent map (current-local-map)) - (use-local-map map)) - ;;(local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done) - (local-set-key "\C-c\C-c" 'gnus-uu-post-news-inews) - (local-set-key "\C-c\C-s" 'gnus-uu-post-news-inews) - (local-set-key "\C-c\C-i" 'gnus-uu-post-insert-binary-in-article) - - (when gnus-uu-post-include-before-composing - (save-excursion (setq gnus-uu-post-inserted-file-name - (gnus-uu-post-insert-binary))))) - -(defun gnus-uu-post-insert-binary-in-article () - "Inserts an encoded file in the buffer. -The user will be asked for a file name." - (interactive) - (save-excursion - (setq gnus-uu-post-inserted-file-name (gnus-uu-post-insert-binary)))) - -;; Encodes with uuencode and substitutes all spaces with backticks. -(defun gnus-uu-post-encode-uuencode (path file-name) - (when (gnus-uu-post-encode-file "uuencode" path file-name) - (goto-char (point-min)) - (forward-line 1) - (while (re-search-forward " " nil t) - (replace-match "`")) - t)) - -;; Encodes with uuencode and adds MIME headers. -(defun gnus-uu-post-encode-mime-uuencode (path file-name) - (when (gnus-uu-post-encode-uuencode path file-name) - (gnus-uu-post-make-mime file-name "x-uue") - t)) - -;; Encodes with base64 and adds MIME headers -(defun gnus-uu-post-encode-mime (path file-name) - (when (eq 0 (call-process shell-file-name nil t nil shell-command-switch - (format "%s %s -o %s" "mmencode" path file-name))) - (gnus-uu-post-make-mime file-name "base64") - t)) - -;; Adds MIME headers. -(defun gnus-uu-post-make-mime (file-name encoding) - (goto-char (point-min)) - (insert (format "Content-Type: %s; name=\"%s\"\n" - (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list) - file-name)) - (insert (format "Content-Transfer-Encoding: %s\n\n" encoding)) - (save-restriction - (set-buffer gnus-message-buffer) - (goto-char (point-min)) - (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) - (forward-line -1) - (narrow-to-region (point-min) (point)) - (unless (mail-fetch-field "mime-version") - (widen) - (insert "MIME-Version: 1.0\n")) - (widen))) - -;; Encodes a file PATH with COMMAND, leaving the result in the -;; current buffer. -(defun gnus-uu-post-encode-file (command path file-name) - (eq 0 (call-process shell-file-name nil t nil shell-command-switch - (format "%s %s %s" command path file-name)))) - -(defun gnus-uu-post-news-inews () - "Posts the composed news article and encoded file. -If no file has been included, the user will be asked for a file." - (interactive) - - (let (file-name) - - (if gnus-uu-post-inserted-file-name - (setq file-name gnus-uu-post-inserted-file-name) - (setq file-name (gnus-uu-post-insert-binary))) - - (gnus-uu-post-encoded file-name gnus-uu-post-threaded)) - (setq gnus-uu-post-inserted-file-name nil) - (when gnus-uu-winconf-post-news - (set-window-configuration gnus-uu-winconf-post-news))) - -;; Asks for a file to encode, encodes it and inserts the result in -;; the current buffer. Returns the file name the user gave. -(defun gnus-uu-post-insert-binary () - (let ((uuencode-buffer-name "*uuencode buffer*") - file-path uubuf file-name) - - (setq file-path (read-file-name - "What file do you want to encode? ")) - (when (not (file-exists-p file-path)) - (error "%s: No such file" file-path)) - - (goto-char (point-max)) - (insert (format "\n%s\n" gnus-uu-post-binary-separator)) - - ;; #### Unix-specific? - (when (string-match "^~/" file-path) - (setq file-path (concat "$HOME" (substring file-path 1)))) - ;; #### Unix-specific? - (if (string-match "/[^/]*$" file-path) - (setq file-name (substring file-path (1+ (match-beginning 0)))) - (setq file-name file-path)) - - (unwind-protect - (if (save-excursion - (set-buffer (setq uubuf - (gnus-get-buffer-create uuencode-buffer-name))) - (erase-buffer) - (funcall gnus-uu-post-encode-method file-path file-name)) - (insert-buffer-substring uubuf) - (error "Encoding unsuccessful")) - (kill-buffer uubuf)) - file-name)) - -;; Posts the article and all of the encoded file. -(defun gnus-uu-post-encoded (file-name &optional threaded) - (let ((send-buffer-name "*uuencode send buffer*") - (encoded-buffer-name "*encoded buffer*") - (top-string "[ cut here %s (%s %d/%d) %s gnus-uu ]") - (separator (concat mail-header-separator "\n\n")) - uubuf length parts header i end beg - beg-line minlen post-buf whole-len beg-binary end-binary) - - (setq post-buf (current-buffer)) - - (goto-char (point-min)) - (when (not (re-search-forward - (if gnus-uu-post-separate-description - (concat "^" (regexp-quote gnus-uu-post-binary-separator) - "$") - (concat "^" (regexp-quote mail-header-separator) "$")) - nil t)) - (error "Internal error: No binary/header separator")) - (beginning-of-line) - (forward-line 1) - (setq beg-binary (point)) - (setq end-binary (point-max)) - - (save-excursion - (set-buffer (setq uubuf (gnus-get-buffer-create encoded-buffer-name))) - (erase-buffer) - (insert-buffer-substring post-buf beg-binary end-binary) - (goto-char (point-min)) - (setq length (count-lines (point-min) (point-max))) - (setq parts (/ length gnus-uu-post-length)) - (unless (< (% length gnus-uu-post-length) 4) - (incf parts))) - - (when gnus-uu-post-separate-description - (forward-line -1)) - (delete-region (point) (point-max)) - - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$") nil t) - (beginning-of-line) - (setq header (buffer-substring (point-min) (point))) - - (goto-char (point-min)) - (when gnus-uu-post-separate-description - (when (re-search-forward "^Subject: " nil t) - (end-of-line) - (insert (format " (0/%d)" parts))) - (save-excursion - (message-send)) - (setq gnus-uu-post-message-id (message-fetch-field "message-id"))) - - (save-excursion - (setq i 1) - (setq beg 1) - (while (not (> i parts)) - (set-buffer (gnus-get-buffer-create send-buffer-name)) - (erase-buffer) - (insert header) - (when (and threaded gnus-uu-post-message-id) - (insert "References: " gnus-uu-post-message-id "\n")) - (insert separator) - (setq whole-len - (- 62 (length (format top-string "" file-name i parts "")))) - (when (> 1 (setq minlen (/ whole-len 2))) - (setq minlen 1)) - (setq - beg-line - (format top-string - (make-string minlen ?-) - file-name i parts - (make-string - (if (= 0 (% whole-len 2)) (1- minlen) minlen) ?-))) - - (goto-char (point-min)) - (when (re-search-forward "^Subject: " nil t) - (end-of-line) - (insert (format " (%d/%d)" i parts))) - - (goto-char (point-max)) - (save-excursion - (set-buffer uubuf) - (goto-char beg) - (if (= i parts) - (goto-char (point-max)) - (forward-line gnus-uu-post-length)) - (when (and (= (1+ i) parts) (< (count-lines (point) (point-max)) 4)) - (forward-line -4)) - (setq end (point))) - (insert-buffer-substring uubuf beg end) - (insert beg-line "\n") - (setq beg end) - (incf i) - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$") nil t) - (beginning-of-line) - (forward-line 2) - (when (re-search-forward - (concat "^" (regexp-quote gnus-uu-post-binary-separator) "$") - nil t) - (replace-match "") - (forward-line 1)) - (insert beg-line) - (insert "\n") - (let (message-sent-message-via) - (save-excursion - (message-send)) - (setq gnus-uu-post-message-id - (concat (message-fetch-field "references") " " - (message-fetch-field "message-id")))))) - - (gnus-kill-buffer send-buffer-name) - (gnus-kill-buffer encoded-buffer-name) - - (when (not gnus-uu-post-separate-description) - (set-buffer-modified-p nil) - (when (fboundp 'bury-buffer) - (bury-buffer))))) - -(provide 'gnus-uu) - -;;; arch-tag: 05312384-0a83-4720-9a58-b3160b888853 -;;; gnus-uu.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-vm.el b/xemacs-packages/gnus/lisp/gnus-vm.el deleted file mode 100644 index 8624db41..00000000 --- a/xemacs-packages/gnus/lisp/gnus-vm.el +++ /dev/null @@ -1,109 +0,0 @@ -;;; gnus-vm.el --- vm interface for Gnus - -;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, -;; 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Per Persson -;; Keywords: news, mail - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; Major contributors: -;; Christian Limpach -;; Some code stolen from: -;; Rick Sladkey - -;;; Code: - -(require 'sendmail) -(require 'message) -(require 'gnus) -(require 'gnus-msg) - -(eval-when-compile - (require 'cl) - (autoload 'vm-mode "vm") - (autoload 'vm-save-message "vm") - (autoload 'vm-forward-message "vm") - (autoload 'vm-reply "vm") - (autoload 'vm-mail "vm")) - -(defvar gnus-vm-inhibit-window-system nil - "Inhibit loading `win-vm' if using a window-system. -Has to be set before gnus-vm is loaded.") - -(unless gnus-vm-inhibit-window-system - (ignore-errors - (when window-system - (require 'win-vm)))) - -(when (not (featurep 'vm)) - (load "vm")) - -(defun gnus-vm-make-folder (&optional buffer) - (let ((article (or buffer (current-buffer))) - (tmp-folder (generate-new-buffer " *tmp-folder*")) - (start (point-min)) - (end (point-max))) - (set-buffer tmp-folder) - (insert-buffer-substring article start end) - (goto-char (point-min)) - (if (looking-at "^\\(From [^ ]+ \\).*$") - (replace-match (concat "\\1" (current-time-string))) - (insert "From " gnus-newsgroup-name " " - (current-time-string) "\n")) - (while (re-search-forward "\n\nFrom " nil t) - (replace-match "\n\n>From ")) - ;; insert a newline, otherwise the last line gets lost - (goto-char (point-max)) - (insert "\n") - (vm-mode) - tmp-folder)) - -(defun gnus-summary-save-article-vm (&optional arg) - "Append the current article to a vm folder. -If N is a positive number, save the N next articles. -If N is a negative number, save the N previous articles. -If N is nil and any articles have been marked with the process mark, -save those articles instead." - (interactive "P") - (require 'gnus-art) - (let ((gnus-default-article-saver 'gnus-summary-save-in-vm)) - (gnus-summary-save-article arg))) - -(defun gnus-summary-save-in-vm (&optional folder) - (interactive) - (setq folder - (gnus-read-save-file-name - "Save %s in VM folder:" folder - gnus-mail-save-name gnus-newsgroup-name - gnus-current-headers 'gnus-newsgroup-last-mail)) - (gnus-eval-in-buffer-window gnus-original-article-buffer - (save-excursion - (save-restriction - (widen) - (let ((vm-folder (gnus-vm-make-folder))) - (vm-save-message folder) - (kill-buffer vm-folder)))))) - -(provide 'gnus-vm) - -;;; arch-tag: 42ca7f88-a12f-461d-be3e-cac7efb44866 -;;; gnus-vm.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-win.el b/xemacs-packages/gnus/lisp/gnus-win.el deleted file mode 100644 index 182e27cc..00000000 --- a/xemacs-packages/gnus/lisp/gnus-win.el +++ /dev/null @@ -1,587 +0,0 @@ -;;; gnus-win.el --- window configuration functions for Gnus - -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) -(require 'gnus-util) - -(defgroup gnus-windows nil - "Window configuration." - :group 'gnus) - -(defcustom gnus-use-full-window t - "*If non-nil, use the entire Emacs screen." - :group 'gnus-windows - :type 'boolean) - -(defvar gnus-window-configuration nil - "Obsolete variable. See `gnus-buffer-configuration'.") - -(defcustom gnus-window-min-width 2 - "*Minimum width of Gnus buffers." - :group 'gnus-windows - :type 'integer) - -(defcustom gnus-window-min-height 1 - "*Minimum height of Gnus buffers." - :group 'gnus-windows - :type 'integer) - -(defcustom gnus-always-force-window-configuration nil - "*If non-nil, always force the Gnus window configurations." - :group 'gnus-windows - :type 'boolean) - -(defcustom gnus-use-frames-on-any-display nil - "*If non-nil, frames on all displays will be considered useable by Gnus. -When nil, only frames on the same display as the selected frame will be -used to display Gnus windows." - :version "22.1" - :group 'gnus-windows - :type 'boolean) - -(defvar gnus-buffer-configuration - '((group - (vertical 1.0 - (group 1.0 point) - (if gnus-carpal '(group-carpal 4)))) - (summary - (vertical 1.0 - (summary 1.0 point) - (if gnus-carpal '(summary-carpal 4)))) - (article - (cond - (gnus-use-trees - '(vertical 1.0 - (summary 0.25 point) - (tree 0.25) - (article 1.0))) - (t - '(vertical 1.0 - (summary 0.25 point) - (if gnus-carpal '(summary-carpal 4)) - (article 1.0))))) - (server - (vertical 1.0 - (server 1.0 point) - (if gnus-carpal '(server-carpal 2)))) - (browse - (vertical 1.0 - (browse 1.0 point) - (if gnus-carpal '(browse-carpal 2)))) - (message - (vertical 1.0 - (message 1.0 point))) - (pick - (vertical 1.0 - (article 1.0 point))) - (info - (vertical 1.0 - (info 1.0 point))) - (summary-faq - (vertical 1.0 - (summary 0.25) - (faq 1.0 point))) - (edit-article - (vertical 1.0 - (article 1.0 point))) - (edit-form - (vertical 1.0 - (group 0.5) - (edit-form 1.0 point))) - (edit-score - (vertical 1.0 - (summary 0.25) - (edit-score 1.0 point))) - (post - (vertical 1.0 - (post 1.0 point))) - (reply - (vertical 1.0 - (article 0.5) - (message 1.0 point))) - (forward - (vertical 1.0 - (message 1.0 point))) - (reply-yank - (vertical 1.0 - (message 1.0 point))) - (mail-bounce - (vertical 1.0 - (article 0.5) - (message 1.0 point))) - (pipe - (vertical 1.0 - (summary 0.25 point) - (if gnus-carpal '(summary-carpal 4)) - ("*Shell Command Output*" 1.0))) - (bug - (vertical 1.0 - (if gnus-bug-create-help-buffer '("*Gnus Help Bug*" 0.5)) - ("*Gnus Bug*" 1.0 point))) - (score-trace - (vertical 1.0 - (summary 0.5 point) - ("*Score Trace*" 1.0))) - (score-words - (vertical 1.0 - (summary 0.5 point) - ("*Score Words*" 1.0))) - (split-trace - (vertical 1.0 - (summary 0.5 point) - ("*Split Trace*" 1.0))) - (category - (vertical 1.0 - (category 1.0))) - (compose-bounce - (vertical 1.0 - (article 0.5) - (message 1.0 point))) - (display-term - (vertical 1.0 - ("*display*" 1.0)))) - "Window configuration for all possible Gnus buffers. -See the Gnus manual for an explanation of the syntax used.") - -(defvar gnus-window-to-buffer - '((group . gnus-group-buffer) - (summary . gnus-summary-buffer) - (article . gnus-article-buffer) - (server . gnus-server-buffer) - (browse . "*Gnus Browse Server*") - (edit-group . gnus-group-edit-buffer) - (edit-form . gnus-edit-form-buffer) - (edit-server . gnus-server-edit-buffer) - (group-carpal . gnus-carpal-group-buffer) - (summary-carpal . gnus-carpal-summary-buffer) - (server-carpal . gnus-carpal-server-buffer) - (browse-carpal . gnus-carpal-browse-buffer) - (edit-score . gnus-score-edit-buffer) - (message . gnus-message-buffer) - (mail . gnus-message-buffer) - (post-news . gnus-message-buffer) - (faq . gnus-faq-buffer) - (tree . gnus-tree-buffer) - (score-trace . "*Score Trace*") - (split-trace . "*Split Trace*") - (info . gnus-info-buffer) - (category . gnus-category-buffer) - (article-copy . gnus-article-copy) - (draft . gnus-draft-buffer)) - "Mapping from short symbols to buffer names or buffer variables.") - -(defcustom gnus-configure-windows-hook nil - "*A hook called when configuring windows." - :version "22.1" - :group 'gnus-windows - :type 'hook) - -;;; Internal variables. - -(defvar gnus-current-window-configuration nil - "The most recently set window configuration.") - -(defvar gnus-created-frames nil) -(defvar gnus-window-frame-focus nil) - -(defun gnus-kill-gnus-frames () - "Kill all frames Gnus has created." - (while gnus-created-frames - (when (frame-live-p (car gnus-created-frames)) - ;; We slap a condition-case around this `delete-frame' to ensure - ;; against errors if we try do delete the single frame that's left. - (ignore-errors - (delete-frame (car gnus-created-frames)))) - (pop gnus-created-frames))) - -(defun gnus-window-configuration-element (list) - (while (and list - (not (assq (car list) gnus-window-configuration))) - (pop list)) - (cadr (assq (car list) gnus-window-configuration))) - -(defun gnus-windows-old-to-new (setting) - ;; First we take care of the really, really old Gnus 3 actions. - (when (symbolp setting) - (setq setting - ;; Take care of ooold GNUS 3.x values. - (cond ((eq setting 'SelectArticle) 'article) - ((memq setting '(SelectNewsgroup SelectSubject ExpandSubject)) - 'summary) - ((memq setting '(ExitNewsgroup)) 'group) - (t setting)))) - (if (or (listp setting) - (not (and gnus-window-configuration - (memq setting '(group summary article))))) - setting - (let* ((elem - (cond - ((eq setting 'group) - (gnus-window-configuration-element - '(group newsgroups ExitNewsgroup))) - ((eq setting 'summary) - (gnus-window-configuration-element - '(summary SelectNewsgroup SelectSubject ExpandSubject))) - ((eq setting 'article) - (gnus-window-configuration-element - '(article SelectArticle))))) - (total (apply '+ elem)) - (types '(group summary article)) - (pbuf (if (eq setting 'newsgroups) 'group 'summary)) - (i 0) - perc out) - (while (< i 3) - (or (not (numberp (nth i elem))) - (zerop (nth i elem)) - (progn - (setq perc (if (= i 2) - 1.0 - (/ (float (nth i elem)) total))) - (push (if (eq pbuf (nth i types)) - (list (nth i types) perc 'point) - (list (nth i types) perc)) - out))) - (incf i)) - `(vertical 1.0 ,@(nreverse out))))) - -;;;###autoload -(defun gnus-add-configuration (conf) - "Add the window configuration CONF to `gnus-buffer-configuration'." - (setq gnus-buffer-configuration - (cons conf (delq (assq (car conf) gnus-buffer-configuration) - gnus-buffer-configuration)))) - -(defvar gnus-frame-list nil) - -(defun gnus-window-to-buffer-helper (obj) - (cond ((not (symbolp obj)) - obj) - ((boundp obj) - (symbol-value obj)) - ((fboundp obj) - (funcall obj)) - (t - nil))) - -(defun gnus-configure-frame (split &optional window) - "Split WINDOW according to SPLIT." - (let ((current-window - (or (get-buffer-window (current-buffer)) (selected-window)))) - (unless window - (setq window current-window)) - (select-window window) - ;; This might be an old-style buffer config. - (when (vectorp split) - (setq split (append split nil))) - (when (or (consp (car split)) - (vectorp (car split))) - (push 1.0 split) - (push 'vertical split)) - ;; The SPLIT might be something that is to be evaled to - ;; return a new SPLIT. - (while (and (not (assq (car split) gnus-window-to-buffer)) - (symbolp (car split)) (fboundp (car split))) - (setq split (eval split))) - (let* ((type (car split)) - (subs (cddr split)) - (len (if (eq type 'horizontal) (window-width) (window-height))) - (total 0) - (window-min-width (or gnus-window-min-width window-min-width)) - (window-min-height (or gnus-window-min-height window-min-height)) - s result new-win rest comp-subs size sub) - (cond - ;; Nothing to do here. - ((null split)) - ;; Don't switch buffers. - ((null type) - (and (memq 'point split) window)) - ;; This is a buffer to be selected. - ((not (memq type '(frame horizontal vertical))) - (let ((buffer (cond ((stringp type) type) - (t (cdr (assq type gnus-window-to-buffer)))))) - (unless buffer - (error "Invalid buffer type: %s" type)) - (let ((buf (gnus-get-buffer-create - (gnus-window-to-buffer-helper buffer)))) - (if (eq buf (window-buffer (selected-window))) (set-buffer buf) - (switch-to-buffer buf))) - (when (memq 'frame-focus split) - (setq gnus-window-frame-focus window)) - ;; We return the window if it has the `point' spec. - (and (memq 'point split) window))) - ;; This is a frame split. - ((eq type 'frame) - (unless gnus-frame-list - (setq gnus-frame-list (list (window-frame current-window)))) - (let ((i 0) - params frame fresult) - (while (< i (length subs)) - ;; Frame parameter is gotten from the sub-split. - (setq params (cadr (elt subs i))) - ;; It should be a list. - (unless (listp params) - (setq params nil)) - ;; Create a new frame? - (unless (setq frame (elt gnus-frame-list i)) - (nconc gnus-frame-list (list (setq frame (make-frame params)))) - (push frame gnus-created-frames)) - ;; Is the old frame still alive? - (unless (frame-live-p frame) - (setcar (nthcdr i gnus-frame-list) - (setq frame (make-frame params)))) - ;; Select the frame in question and do more splits there. - (select-frame frame) - (setq fresult (or (gnus-configure-frame (elt subs i)) fresult)) - (incf i)) - ;; Select the frame that has the selected buffer. - (when fresult - (select-frame (window-frame fresult))))) - ;; This is a normal split. - (t - (when (> (length subs) 0) - ;; First we have to compute the sizes of all new windows. - (while subs - (setq sub (append (pop subs) nil)) - (while (and (not (assq (car sub) gnus-window-to-buffer)) - (symbolp (car sub)) (fboundp (car sub))) - (setq sub (eval sub))) - (when sub - (push sub comp-subs) - (setq size (cadar comp-subs)) - (cond ((equal size 1.0) - (setq rest (car comp-subs)) - (setq s 0)) - ((floatp size) - (setq s (floor (* size len)))) - ((integerp size) - (setq s size)) - (t - (error "Invalid size: %s" size))) - ;; Try to make sure that we are inside the safe limits. - (cond ((zerop s)) - ((eq type 'horizontal) - (setq s (max s window-min-width))) - ((eq type 'vertical) - (setq s (max s window-min-height)))) - (setcar (cdar comp-subs) s) - (incf total s))) - ;; Take care of the "1.0" spec. - (if rest - (setcar (cdr rest) (- len total)) - (error "No 1.0 specs in %s" split)) - ;; The we do the actual splitting in a nice recursive - ;; fashion. - (setq comp-subs (nreverse comp-subs)) - (while comp-subs - (if (null (cdr comp-subs)) - (setq new-win window) - (setq new-win - (split-window window (cadar comp-subs) - (eq type 'horizontal)))) - (setq result (or (gnus-configure-frame - (car comp-subs) window) - result)) - (select-window new-win) - (setq window new-win) - (setq comp-subs (cdr comp-subs)))) - ;; Return the proper window, if any. - (when result - (select-window result))))))) - -(defvar gnus-frame-split-p nil) - -(defun gnus-configure-windows (setting &optional force) - (if (window-configuration-p setting) - (set-window-configuration setting) - (setq gnus-current-window-configuration setting) - (setq force (or force gnus-always-force-window-configuration)) - (setq setting (gnus-windows-old-to-new setting)) - (let ((split (if (symbolp setting) - (cadr (assq setting gnus-buffer-configuration)) - setting)) - all-visible) - - (setq gnus-frame-split-p nil) - - (unless split - (error "No such setting in `gnus-buffer-configuration': %s" setting)) - - (if (and (setq all-visible (gnus-all-windows-visible-p split)) - (not force)) - ;; All the windows mentioned are already visible, so we just - ;; put point in the assigned buffer, and do not touch the - ;; winconf. - (select-window all-visible) - - ;; Make sure "the other" buffer, nntp-server-buffer, is live. - (unless (gnus-buffer-live-p nntp-server-buffer) - (nnheader-init-server-buffer)) - - ;; Either remove all windows or just remove all Gnus windows. - (let ((frame (selected-frame))) - (unwind-protect - (if gnus-use-full-window - ;; We want to remove all other windows. - (if (not gnus-frame-split-p) - ;; This is not a `frame' split, so we ignore the - ;; other frames. - (delete-other-windows) - ;; This is a `frame' split, so we delete all windows - ;; on all frames. - (gnus-delete-windows-in-gnusey-frames)) - ;; Just remove some windows. - (gnus-remove-some-windows) - (if (featurep 'xemacs) - (switch-to-buffer nntp-server-buffer) - (set-buffer nntp-server-buffer))) - (select-frame frame))) - - (let (gnus-window-frame-focus) - (if (featurep 'xemacs) - (switch-to-buffer nntp-server-buffer) - (set-buffer nntp-server-buffer)) - (gnus-configure-frame split) - (run-hooks 'gnus-configure-windows-hook) - (when gnus-window-frame-focus - (gnus-select-frame-set-input-focus - (window-frame gnus-window-frame-focus)))))))) - -(defun gnus-delete-windows-in-gnusey-frames () - "Do a `delete-other-windows' in all frames that have Gnus windows." - (let ((buffers (gnus-buffers))) - (mapcar - (lambda (frame) - (unless (eq (cdr (assq 'minibuffer - (frame-parameters frame))) - 'only) - (select-frame frame) - (let (do-delete) - (walk-windows - (lambda (window) - (when (memq (window-buffer window) buffers) - (setq do-delete t)))) - (when do-delete - (delete-other-windows))))) - (frame-list)))) - -(defun gnus-all-windows-visible-p (split) - "Say whether all buffers in SPLIT are currently visible. -In particular, the value returned will be the window that -should have point." - (let ((stack (list split)) - (all-visible t) - type buffer win buf) - (while (and (setq split (pop stack)) - all-visible) - ;; Be backwards compatible. - (when (vectorp split) - (setq split (append split nil))) - (when (or (consp (car split)) - (vectorp (car split))) - (push 1.0 split) - (push 'vertical split)) - ;; The SPLIT might be something that is to be evaled to - ;; return a new SPLIT. - (while (and (not (assq (car split) gnus-window-to-buffer)) - (symbolp (car split)) (fboundp (car split))) - (setq split (eval split))) - - (setq type (elt split 0)) - (cond - ;; Nothing here. - ((null split) t) - ;; A buffer. - ((not (memq type '(horizontal vertical frame))) - (setq buffer (cond ((stringp type) type) - (t (cdr (assq type gnus-window-to-buffer))))) - (unless buffer - (error "Invalid buffer type: %s" type)) - (if (and (setq buf (get-buffer (gnus-window-to-buffer-helper buffer))) - (setq win (gnus-get-buffer-window buf t))) - (if (memq 'point split) - (setq all-visible win)) - (setq all-visible nil))) - (t - (when (eq type 'frame) - (setq gnus-frame-split-p t)) - (setq stack (append (cddr split) stack))))) - (unless (eq all-visible t) - all-visible))) - -(defun gnus-window-top-edge (&optional window) - (nth 1 (window-edges window))) - -(defun gnus-remove-some-windows () - (let ((buffers (gnus-buffers)) - buf bufs lowest-buf lowest) - (save-excursion - ;; Remove windows on all known Gnus buffers. - (while (setq buf (pop buffers)) - (when (get-buffer-window buf) - (push buf bufs) - (pop-to-buffer buf) - (when (or (not lowest) - (< (gnus-window-top-edge) lowest)) - (setq lowest (gnus-window-top-edge) - lowest-buf buf)))) - (when lowest-buf - (pop-to-buffer lowest-buf) - (if (featurep 'xemacs) - (switch-to-buffer nntp-server-buffer) - (set-buffer nntp-server-buffer))) - (mapcar (lambda (b) (delete-windows-on b t)) - (delq lowest-buf bufs))))) - -(eval-and-compile - (cond - ((fboundp 'frames-on-display-list) - (defalias 'gnus-frames-on-display-list 'frames-on-display-list)) - ((and (featurep 'xemacs) (fboundp 'frame-device)) - (defun gnus-frames-on-display-list () - (apply 'filtered-frame-list 'identity (list (frame-device nil))))) - (t - (defalias 'gnus-frames-on-display-list 'frame-list)))) - -(defun gnus-get-buffer-window (buffer &optional frame) - (cond ((and (null gnus-use-frames-on-any-display) - (memq frame '(t 0 visible))) - (car - (let ((frames (gnus-frames-on-display-list))) - (gnus-remove-if (lambda (win) (not (memq (window-frame win) - frames))) - (get-buffer-window-list buffer nil frame))))) - (t - (get-buffer-window buffer frame)))) - -(provide 'gnus-win) - -;; arch-tag: ccd5a394-2ddf-4397-b8f8-6d80d3e46e2b -;;; gnus-win.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus-xmas.el b/xemacs-packages/gnus/lisp/gnus-xmas.el deleted file mode 100644 index 37438fac..00000000 --- a/xemacs-packages/gnus/lisp/gnus-xmas.el +++ /dev/null @@ -1,982 +0,0 @@ -;;; gnus-xmas.el --- Gnus functions for XEmacs - -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2005, 2006, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile - (autoload 'gnus-active "gnus" nil nil 'macro) - (autoload 'gnus-group-entry "gnus" nil nil 'macro) - (autoload 'gnus-info-level "gnus" nil nil 'macro) - (autoload 'gnus-info-marks "gnus" nil nil 'macro) - (autoload 'gnus-info-method "gnus" nil nil 'macro) - (autoload 'gnus-info-score "gnus" nil nil 'macro)) - -(require 'text-props) -(defvar menu-bar-mode (featurep 'menubar)) -(require 'messagexmas) -(require 'wid-edit) - -(defgroup gnus-xmas nil - "XEmacsoid support for Gnus" - :group 'gnus) - -(defcustom gnus-xmas-glyph-directory nil - "Directory where Gnus logos and icons are located. -If this variable is nil, Gnus will try to locate the directory -automatically." - :type '(choice (const :tag "autodetect" nil) - directory) - :group 'gnus-xmas) - -(unless gnus-xmas-glyph-directory - (unless (setq gnus-xmas-glyph-directory - (message-xmas-find-glyph-directory "gnus")) - (error "Can't find glyph directory. \ -Possibly the `etc' directory has not been installed."))) - -;;; Internal variables. - -;; Don't warn about these undefined variables. - -;;defined in gnus.el -(defvar gnus-active-hashtb) -(defvar gnus-article-buffer) -(defvar gnus-auto-center-summary) -(defvar gnus-current-headers) -(defvar gnus-level-killed) -(defvar gnus-level-zombie) -(defvar gnus-newsgroup-bookmarks) -(defvar gnus-newsgroup-dependencies) -(defvar gnus-newsgroup-selected-overlay) -(defvar gnus-newsrc-hashtb) -(defvar gnus-read-mark) -(defvar gnus-refer-article-method) -(defvar gnus-reffed-article-number) -(defvar gnus-unread-mark) -(defvar gnus-version) -(defvar gnus-view-pseudos) -(defvar gnus-view-pseudos-separately) -(defvar gnus-visual) -(defvar gnus-zombie-list) -;;defined in gnus-msg.el -(defvar gnus-article-copy) -(defvar gnus-check-before-posting) -;;defined in gnus-vis.el -(defvar gnus-article-button-face) -(defvar gnus-article-mouse-face) -(defvar gnus-summary-selected-face) -(defvar gnus-group-reading-menu) -(defvar gnus-group-group-menu) -(defvar gnus-group-misc-menu) -(defvar gnus-summary-article-menu) -(defvar gnus-summary-thread-menu) -(defvar gnus-summary-misc-menu) -(defvar gnus-summary-post-menu) -(defvar gnus-summary-kill-menu) -(defvar gnus-article-article-menu) -(defvar gnus-article-treatment-menu) -(defvar gnus-mouse-2) -(defvar standard-display-table) -(defvar gnus-tree-minimize-window) - -(defun gnus-xmas-set-text-properties (start end props &optional buffer) - "You should NEVER use this function. It is ideologically blasphemous. -It is provided only to ease porting of broken FSF Emacs programs." - (if (stringp buffer) - nil - (map-extents (lambda (extent ignored) - (remove-text-properties - start end - (list (extent-property extent 'text-prop) nil) - buffer) - nil) - buffer start end nil nil 'text-prop) - (gnus-add-text-properties start end props buffer))) - -(defun gnus-xmas-highlight-selected-summary () - ;; Highlight selected article in summary buffer - (when gnus-summary-selected-face - (when gnus-newsgroup-selected-overlay - (delete-extent gnus-newsgroup-selected-overlay)) - (setq gnus-newsgroup-selected-overlay - (make-extent (gnus-point-at-bol) (gnus-point-at-eol))) - (set-extent-face gnus-newsgroup-selected-overlay - gnus-summary-selected-face))) - -(defcustom gnus-xmas-force-redisplay nil - "*If non-nil, force a redisplay before recentering the summary buffer. -This is ugly, but it works around a bug in `window-displayed-height'." - :type 'boolean - :group 'gnus-xmas) - -(defun gnus-xmas-switch-horizontal-scrollbar-off () - (when (featurep 'scrollbar) - (set-specifier scrollbar-height (cons (current-buffer) 0)))) - -(defun gnus-xmas-summary-recenter () - "\"Center\" point in the summary window. -If `gnus-auto-center-summary' is nil, or the article buffer isn't -displayed, no centering will be performed." - ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle). - ;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu. - ;; Force redisplay to get properly computed window height. - (when gnus-xmas-force-redisplay - (sit-for 0)) - (when gnus-auto-center-summary - (let* ((height (if (fboundp 'window-displayed-height) - (window-displayed-height) - (- (window-height) 2))) - (top (cond ((< height 4) 0) - ((< height 7) 1) - (t (if (numberp gnus-auto-center-summary) - gnus-auto-center-summary - 2)))) - (bottom (save-excursion (goto-char (point-max)) - (forward-line (- height)) - (point))) - (window (get-buffer-window (current-buffer)))) - (when (get-buffer-window gnus-article-buffer) - ;; Only do recentering when the article buffer is displayed, - ;; Set the window start to either `bottom', which is the biggest - ;; possible valid number, or the second line from the top, - ;; whichever is the least. - ;; NOFORCE parameter suggested by Daniel Pittman . - (set-window-start - window (min bottom (save-excursion (forward-line (- top)) (point))) - t)) - ;; Do horizontal recentering while we're at it. - (when (and (get-buffer-window (current-buffer) t) - (not (eq gnus-auto-center-summary 'vertical))) - (let ((selected (selected-window))) - (select-window (get-buffer-window (current-buffer) t)) - (gnus-summary-position-point) - (gnus-horizontal-recenter) - (select-window selected)))))) - -(defun gnus-xmas-summary-set-display-table () - ;; Setup the display table -- like `gnus-summary-setup-display-table', - ;; but done in an XEmacsish way. - (let ((table (make-display-table)) - (i 32)) - ;; Nix out all the control chars... - (while (>= (setq i (1- i)) 0) - (put-display-table i [??] table)) - ;; ... but not newline and cr, of course. (cr is necessary for the - ;; selective display). - (put-display-table ?\n nil table) - (put-display-table ?\r nil table) - ;; We keep TAB as well. - (put-display-table ?\t nil table) - ;; We nix out any glyphs over 126 below ctl-arrow. - (let ((i (if (integerp ctl-arrow) ctl-arrow 160))) - (while (>= (setq i (1- i)) 127) - (unless (get-display-table i table) - (put-display-table i [??] table)))) - ;; Can't use `set-specifier' because of a bug in 19.14 and earlier - (add-spec-to-specifier current-display-table table (current-buffer) nil))) - -(defun gnus-xmas-add-text-properties (start end props &optional object) - (add-text-properties start end props object) - (put-text-property start end 'start-closed nil object)) - -(defun gnus-xmas-put-text-property (start end prop value &optional object) - (put-text-property start end prop value object) - (put-text-property start end 'start-closed nil object)) - -(defun gnus-xmas-extent-start-open (point) - (map-extents (lambda (extent arg) - (set-extent-property extent 'start-open t)) - nil point (min (1+ (point)) (point-max)))) - -(defun gnus-xmas-article-push-button (event) - "Check text under the mouse pointer for a callback function. -If the text under the mouse pointer has a `gnus-callback' property, -call it with the value of the `gnus-data' text property." - (interactive "e") - (set-buffer (window-buffer (event-window event))) - (let* ((pos (event-closest-point event)) - (data (get-text-property pos 'gnus-data)) - (fun (get-text-property pos 'gnus-callback))) - (goto-char pos) - (when fun - (funcall fun data)))) - -(defun gnus-xmas-move-overlay (extent start end &optional buffer) - (set-extent-endpoints extent start end buffer)) - -(defun gnus-xmas-kill-all-overlays () - "Delete all extents in the current buffer." - (map-extents (lambda (extent ignore) - (delete-extent extent) - nil))) - -(defun gnus-xmas-window-top-edge (&optional window) - (nth 1 (window-pixel-edges window))) - -(defun gnus-xmas-tree-minimize () - (when (and gnus-tree-minimize-window - (not (one-window-p))) - (let* ((window-min-height 2) - (height (1+ (count-lines (point-min) (point-max)))) - (min (max (1- window-min-height) height)) - (tot (if (numberp gnus-tree-minimize-window) - (min gnus-tree-minimize-window min) - min)) - (win (get-buffer-window (current-buffer))) - (wh (and win (1- (window-height win))))) - (when (and win - (not (eq tot wh))) - (let ((selected (selected-window))) - (select-window win) - (enlarge-window (- tot wh)) - (select-window selected)))))) - -;; Select the lowest window on the frame. -(defun gnus-xmas-appt-select-lowest-window () - (let* ((lowest-window (selected-window)) - (bottom-edge (car (cdr (cdr (cdr (window-pixel-edges)))))) - (last-window (previous-window)) - (window-search t)) - (while window-search - (let* ((this-window (next-window)) - (next-bottom-edge (car (cdr (cdr (cdr - (window-pixel-edges - this-window))))))) - (when (< bottom-edge next-bottom-edge) - (setq bottom-edge next-bottom-edge) - (setq lowest-window this-window)) - - (select-window this-window) - (when (eq last-window this-window) - (select-window lowest-window) - (setq window-search nil)))))) - -(defmacro gnus-xmas-menu-add (type &rest menus) - `(gnus-xmas-menu-add-1 ',type ',menus)) -(put 'gnus-xmas-menu-add 'lisp-indent-function 1) - -(defun gnus-xmas-menu-add-1 (type menus) - (when (and menu-bar-mode - (gnus-visual-p (intern (format "%s-menu" type)) 'menu)) - (while menus - (easy-menu-add (symbol-value (pop menus)))))) - -(defun gnus-xmas-group-menu-add () - (gnus-xmas-menu-add group - gnus-group-reading-menu gnus-group-group-menu gnus-group-misc-menu)) - -(defun gnus-xmas-summary-menu-add () - (gnus-xmas-menu-add summary - gnus-summary-misc-menu gnus-summary-kill-menu - gnus-summary-article-menu gnus-summary-thread-menu - gnus-summary-post-menu )) - -(defun gnus-xmas-article-menu-add () - (gnus-xmas-menu-add article - gnus-article-article-menu gnus-article-treatment-menu - gnus-article-post-menu gnus-article-commands-menu)) - -(defun gnus-xmas-score-menu-add () - (gnus-xmas-menu-add score - gnus-score-menu)) - -(defun gnus-xmas-pick-menu-add () - (gnus-xmas-menu-add pick - gnus-pick-menu)) - -(defun gnus-xmas-topic-menu-add () - (gnus-xmas-menu-add topic - gnus-topic-menu)) - -(defun gnus-xmas-binary-menu-add () - (gnus-xmas-menu-add binary - gnus-binary-menu)) - -(defun gnus-xmas-agent-summary-menu-add () - (gnus-xmas-menu-add agent-summary - gnus-agent-summary-menu)) - -(defun gnus-xmas-agent-group-menu-add () - (gnus-xmas-menu-add agent-group - gnus-agent-group-menu)) - -(defun gnus-xmas-agent-server-menu-add () - (gnus-xmas-menu-add agent-server - gnus-agent-server-menu)) - -(defun gnus-xmas-tree-menu-add () - (gnus-xmas-menu-add tree - gnus-tree-menu)) - -(defun gnus-xmas-draft-menu-add () - (gnus-xmas-menu-add draft - gnus-draft-menu)) - -(defun gnus-xmas-server-menu-add () - (gnus-xmas-menu-add menu - gnus-server-server-menu gnus-server-connections-menu)) - -(defun gnus-xmas-browse-menu-add () - (gnus-xmas-menu-add browse - gnus-browse-menu)) - -(defun gnus-xmas-grouplens-menu-add () - (gnus-xmas-menu-add grouplens - gnus-grouplens-menu)) - -(defun gnus-xmas-read-event-char (&optional prompt) - "Get the next event." - (when prompt - (message "%s" prompt)) - (let ((event (next-command-event))) - (sit-for 0) - ;; We junk all non-key events. Is this naughty? - (while (not (or (key-press-event-p event) - (button-press-event-p event))) - (dispatch-event event) - (setq event (next-command-event))) - (cons (and (key-press-event-p event) - (event-to-character event)) - event))) - -(defun gnus-xmas-define () - (setq gnus-mouse-2 [button2]) - (setq gnus-mouse-3 [button3]) - (setq gnus-widget-button-keymap widget-button-keymap) - - (unless (memq 'underline (face-list)) - (and (fboundp 'make-face) - (funcall (intern "make-face") 'underline))) - ;; Must avoid calling set-face-underline-p directly, because it - ;; is a defsubst in emacs19, and will make the .elc files non - ;; portable! - (unless (face-differs-from-default-p 'underline) - (funcall (intern "set-face-underline-p") 'underline t)) - - (cond - ((fboundp 'char-or-char-int-p) - ;; Handle both types of marks for XEmacs-20.x. - (defalias 'gnus-characterp 'char-or-char-int-p)) - ;; V19 of XEmacs, probably. - (t - (defalias 'gnus-characterp 'characterp))) - - (defalias 'gnus-make-overlay 'make-extent) - (defalias 'gnus-delete-overlay 'delete-extent) - (defalias 'gnus-overlay-put 'set-extent-property) - (defalias 'gnus-move-overlay 'gnus-xmas-move-overlay) - (defalias 'gnus-overlay-buffer 'extent-object) - (defalias 'gnus-overlay-start 'extent-start-position) - (defalias 'gnus-overlay-end 'extent-end-position) - (defalias 'gnus-kill-all-overlays 'gnus-xmas-kill-all-overlays) - (defalias 'gnus-extent-detached-p 'extent-detached-p) - (defalias 'gnus-add-text-properties 'gnus-xmas-add-text-properties) - (defalias 'gnus-put-text-property 'gnus-xmas-put-text-property) - (defalias 'gnus-deactivate-mark 'ignore) - (defalias 'gnus-window-edges 'window-pixel-edges) - (defalias 'gnus-assq-delete-all 'gnus-xmas-assq-delete-all) - - (if (and (<= emacs-major-version 19) - (< emacs-minor-version 14)) - (defalias 'gnus-set-text-properties 'gnus-xmas-set-text-properties)) - - (unless (boundp 'standard-display-table) - (setq standard-display-table nil)) - - (defvar gnus-mouse-face-prop 'highlight) - - (defun gnus-byte-code (func) - "Return a form that can be `eval'ed based on FUNC." - (let ((fval (indirect-function func))) - (if (compiled-function-p fval) - (list 'funcall fval) - (cons 'progn (cdr (cdr fval)))))) - - (unless (fboundp 'match-string-no-properties) - (defalias 'match-string-no-properties 'match-string)) - - (defalias 'gnus-x-color-values - (if (fboundp 'x-color-values) - 'x-color-values - (lambda (color) - (color-instance-rgb-components - (make-color-instance color)))))) - -(defun gnus-xmas-redefine () - "Redefine lots of Gnus functions for XEmacs." - (defalias 'gnus-summary-set-display-table 'gnus-xmas-summary-set-display-table) - (defalias 'gnus-visual-turn-off-edit-menu 'identity) - (defalias 'gnus-summary-recenter 'gnus-xmas-summary-recenter) - (defalias 'gnus-extent-start-open 'gnus-xmas-extent-start-open) - (defalias 'gnus-article-push-button 'gnus-xmas-article-push-button) - (defalias 'gnus-window-top-edge 'gnus-xmas-window-top-edge) - (defalias 'gnus-read-event-char 'gnus-xmas-read-event-char) - (defalias 'gnus-group-startup-message 'gnus-xmas-group-startup-message) - (defalias 'gnus-tree-minimize 'gnus-xmas-tree-minimize) - (defalias 'gnus-appt-select-lowest-window - 'gnus-xmas-appt-select-lowest-window) - (defalias 'gnus-mail-strip-quoted-names 'gnus-xmas-mail-strip-quoted-names) - (defalias 'gnus-character-to-event 'character-to-event) - (defalias 'gnus-mode-line-buffer-identification - 'gnus-xmas-mode-line-buffer-identification) - (defalias 'gnus-key-press-event-p 'key-press-event-p) - (defalias 'gnus-region-active-p 'region-active-p) - (defalias 'gnus-mark-active-p 'region-exists-p) - (defalias 'gnus-annotation-in-region-p 'gnus-xmas-annotation-in-region-p) - (defalias 'gnus-mime-button-menu 'gnus-xmas-mime-button-menu) - (defalias 'gnus-image-type-available-p 'gnus-xmas-image-type-available-p) - (defalias 'gnus-put-image 'gnus-xmas-put-image) - (defalias 'gnus-create-image 'gnus-xmas-create-image) - (defalias 'gnus-remove-image 'gnus-xmas-remove-image) - - (when (or (< emacs-major-version 21) - (and (= emacs-major-version 21) - (< emacs-minor-version 3))) - (defalias 'gnus-completing-read 'gnus-xmas-completing-read)) - - ;; These ones are not defcutom'ed, sometimes not even defvar'ed. They - ;; probably should. If that is done, the code below should then be moved - ;; where each variable is defined, in order not to mess with user settings. - ;; -- didier - (add-hook 'gnus-score-mode-hook 'gnus-xmas-score-menu-add) - (add-hook 'gnus-binary-mode-hook 'gnus-xmas-binary-menu-add) - (add-hook 'gnus-grouplens-mode-hook 'gnus-xmas-grouplens-menu-add) - (add-hook 'gnus-server-mode-hook 'gnus-xmas-server-menu-add) - (add-hook 'gnus-browse-mode-hook 'gnus-xmas-browse-menu-add) - (add-hook 'gnus-draft-mode-hook 'gnus-xmas-draft-menu-add) - (add-hook 'gnus-mailing-list-mode-hook 'gnus-xmas-mailing-list-menu-add)) - - -;;; XEmacs logo and toolbar. - -(defun gnus-xmas-group-startup-message (&optional x y) - "Insert startup message in current buffer." - ;; Insert the message. - (erase-buffer) - (cond - ((and (console-on-window-system-p) - (or (featurep 'xpm) - (featurep 'xbm))) - (let* ((logo-xpm (expand-file-name "gnus.xpm" gnus-xmas-glyph-directory)) - (logo-xbm (expand-file-name "gnus.xbm" gnus-xmas-glyph-directory)) - (glyph (make-glyph - (cond ((featurep 'xpm) - `[xpm - :file ,logo-xpm - :color-symbols - (("thing" . ,(car gnus-logo-colors)) - ("shadow" . ,(cadr gnus-logo-colors)) - ("oort" . "#eeeeee") - ("background" . ,(face-background 'default)))]) - ((featurep 'xbm) - `[xbm :file ,logo-xbm]) - (t [nothing]))))) - (insert " ") - (set-extent-begin-glyph (make-extent (point) (point)) glyph) - (goto-char (point-min)) - (while (not (eobp)) - (insert (make-string (/ (max (- (window-width) (or x 35)) 0) 2) - ?\ )) - (forward-line 1)) - (setq gnus-simple-splash nil)) - (goto-char (point-min)) - (let* ((pheight (+ 20 (count-lines (point-min) (point-max)))) - (wheight (window-height)) - (rest (- wheight pheight))) - (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))) - (t - (insert - (format " %s - _ ___ _ _ - _ ___ __ ___ __ _ ___ - __ _ ___ __ ___ - _ ___ _ - _ _ __ _ - ___ __ _ - __ _ - _ _ _ - _ _ _ - _ _ _ - __ ___ - _ _ _ _ - _ _ - _ _ - _ _ - _ - __ - -" - "")) - ;; And then hack it. - (gnus-indent-rigidly (point-min) (point-max) - (/ (max (- (window-width) (or x 46)) 0) 2)) - (goto-char (point-min)) - (forward-line 1) - (let* ((pheight (count-lines (point-min) (point-max))) - (wheight (window-height)) - (rest (- wheight pheight))) - (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n))) - ;; Paint it. - (put-text-property (point-min) (point-max) 'face 'gnus-splash))) - (setq modeline-buffer-identification - (list (concat gnus-version ": *Group*"))) - (set-buffer-modified-p t)) - - -;;; The toolbar. - -(defun gnus-xmas-update-toolbars () - "Update the toolbars' appearance." - (when (and (not noninteractive) - (featurep 'gnus-xmas)) - (save-excursion - (dolist (buffer (buffer-list)) - (set-buffer buffer) - (cond ((eq major-mode 'gnus-group-mode) - (gnus-xmas-setup-group-toolbar)) - ((eq major-mode 'gnus-summary-mode) - (gnus-xmas-setup-summary-toolbar))))))) - -(defcustom gnus-use-toolbar (if (featurep 'toolbar) 'default) - "*Position to display the toolbar. Nil means do not use a toolbar. -If it is non-nil, it should be one of the symbols `default', `top', -`bottom', `right', and `left'. `default' means to use the default -toolbar, the rest mean to display the toolbar on the place which those -names show." - :type '(choice (const default) - (const top) (const bottom) (const left) (const right) - (const :tag "no toolbar" nil)) - :set (lambda (symbol value) - (set-default - symbol - (if (or (not value) - (memq value (list 'default 'top 'bottom 'right 'left))) - value - 'default)) - (gnus-xmas-update-toolbars)) - :group 'gnus-xmas) - -(defcustom gnus-toolbar-thickness - (if (featurep 'toolbar) - (cons (specifier-instance default-toolbar-height) - (specifier-instance default-toolbar-width))) - "*Cons of the height and the width specifying the thickness of a toolbar. -The height is used for the toolbar displayed on the top or the bottom, -the width is used for the toolbar displayed on the right or the left." - :type '(cons :tag "height & width" - (integer :tag "height") (integer :tag "width")) - :set (lambda (symbol value) - (set-default - symbol - (if (and (consp value) (natnump (car value)) (natnump (cdr value))) - value - '(37 . 40))) - (gnus-xmas-update-toolbars)) - :group 'gnus-xmas) - -(defvar gnus-group-toolbar - '([gnus-group-get-new-news gnus-group-get-new-news t "Get new news"] - [gnus-group-get-new-news-this-group - gnus-group-get-new-news-this-group t "Get new news in this group"] - [gnus-group-catchup-current - gnus-group-catchup-current t "Catchup group"] - [gnus-group-describe-group - gnus-group-describe-group t "Describe group"] - [gnus-group-unsubscribe gnus-group-unsubscribe t "Unsubscribe group"] - [gnus-group-subscribe gnus-group-subscribe t "Subscribe group"] - [gnus-group-kill-group gnus-group-kill-group t "Kill group"] - [gnus-summary-mail-save - gnus-group-save-newsrc t "Save .newsrc files"] ; borrowed icon. - [gnus-group-exit gnus-group-exit t "Exit Gnus"]) - "The group buffer toolbar.") - -(defvar gnus-summary-toolbar - '([gnus-summary-prev-unread - gnus-summary-prev-page-or-article t "Page up"] - [gnus-summary-next-unread - gnus-summary-next-page t "Page down"] - [gnus-summary-post-news - gnus-summary-post-news t "Post an article"] - [gnus-summary-followup-with-original - gnus-summary-followup-with-original t - "Post a followup and yank the original"] - [gnus-summary-followup - gnus-summary-followup t "Post a followup"] - [gnus-summary-reply-with-original - gnus-summary-reply-with-original t "Mail a reply and yank the original"] - [gnus-summary-reply - gnus-summary-reply t "Mail a reply"] - [gnus-summary-caesar-message - gnus-summary-caesar-message t "Rot 13"] - [gnus-uu-decode-uu - gnus-uu-decode-uu t "Decode uuencoded articles"] - [gnus-summary-save-article-file - gnus-summary-save-article-file t "Save article in file"] - [gnus-summary-save-article - gnus-summary-save-article t "Save article"] - [gnus-uu-post-news - gnus-uu-post-news t "Post a uuencoded article"] - [gnus-summary-cancel-article - gnus-summary-cancel-article t "Cancel article"] - [gnus-summary-catchup - gnus-summary-catchup t "Catchup"] - [gnus-summary-catchup-and-exit - gnus-summary-catchup-and-exit t "Catchup and exit"] - [gnus-summary-exit gnus-summary-exit t "Exit this summary"]) - "The summary buffer toolbar.") - -(defvar gnus-summary-mail-toolbar - '( - [gnus-summary-prev-unread - gnus-summary-prev-unread-article t "Prev unread article"] - [gnus-summary-next-unread - gnus-summary-next-unread-article t "Next unread article"] - [gnus-summary-mail-reply gnus-summary-reply t "Reply"] - [gnus-summary-mail-originate gnus-summary-post-news t "Originate"] - [gnus-summary-mail-save gnus-summary-save-article t "Save"] - [gnus-summary-mail-copy gnus-summary-copy-article t "Copy message"] - [gnus-summary-mail-forward gnus-summary-mail-forward t "Forward message"] - [gnus-summary-caesar-message - gnus-summary-caesar-message t "Rot 13"] - [gnus-uu-decode-uu - gnus-uu-decode-uu t "Decode uuencoded articles"] - [gnus-summary-save-article-file - gnus-summary-save-article-file t "Save article in file"] - [gnus-summary-save-article - gnus-summary-save-article t "Save article"] - [gnus-summary-cancel-article ; usenet : cancellation :: mail : deletion. - gnus-summary-delete-article t "Delete message"] - [gnus-summary-catchup - gnus-summary-catchup t "Catchup"] - [gnus-summary-catchup-and-exit - gnus-summary-catchup-and-exit t "Catchup and exit"] - [gnus-summary-exit gnus-summary-exit t "Exit this summary"]) - "The summary buffer mail toolbar.") - -(defun gnus-xmas-setup-toolbar (toolbar) - (when (featurep 'toolbar) - (if (and gnus-use-toolbar - (message-xmas-setup-toolbar toolbar nil "gnus")) - (let ((bar (or (intern-soft (format "%s-toolbar" gnus-use-toolbar)) - 'default-toolbar)) - (height (car gnus-toolbar-thickness)) - (width (cdr gnus-toolbar-thickness)) - (cur (current-buffer)) - bars) - (set-specifier (symbol-value bar) toolbar cur) - (set-specifier default-toolbar-height height cur) - (set-specifier default-toolbar-width width cur) - (set-specifier top-toolbar-height height cur) - (set-specifier bottom-toolbar-height height cur) - (set-specifier right-toolbar-width width cur) - (set-specifier left-toolbar-width width cur) - (if (eq bar 'default-toolbar) - (progn - (remove-specifier default-toolbar-visible-p cur) - (remove-specifier top-toolbar cur) - (remove-specifier top-toolbar-visible-p cur) - (remove-specifier bottom-toolbar cur) - (remove-specifier bottom-toolbar-visible-p cur) - (remove-specifier right-toolbar cur) - (remove-specifier right-toolbar-visible-p cur) - (remove-specifier left-toolbar cur) - (remove-specifier left-toolbar-visible-p cur)) - (set-specifier (symbol-value (intern (format "%s-visible-p" bar))) - t cur) - (setq bars (delq bar (list 'default-toolbar - 'bottom-toolbar 'top-toolbar - 'right-toolbar 'left-toolbar))) - (while bars - (set-specifier (symbol-value (intern (format "%s-visible-p" - (pop bars)))) - nil cur)))) - (let ((cur (current-buffer))) - (set-specifier default-toolbar-visible-p nil cur) - (set-specifier top-toolbar-visible-p nil cur) - (set-specifier bottom-toolbar-visible-p nil cur) - (set-specifier right-toolbar-visible-p nil cur) - (set-specifier left-toolbar-visible-p nil cur))))) - -(defun gnus-xmas-setup-group-toolbar () - (gnus-xmas-setup-toolbar gnus-group-toolbar)) - -(defun gnus-xmas-setup-summary-toolbar () - (gnus-xmas-setup-toolbar (if (gnus-news-group-p gnus-newsgroup-name) - gnus-summary-toolbar - gnus-summary-mail-toolbar))) - -(defun gnus-xmas-mail-strip-quoted-names (address) - "Protect mail-strip-quoted-names from nil input. -XEmacs compatibility workaround." - (if (null address) - nil - (mail-strip-quoted-names address))) - -(defun gnus-xmas-call-region (command &rest args) - (apply - 'call-process-region (point-min) (point-max) command t '(t nil) nil - args)) - -(defvar gnus-xmas-modeline-left-extent - (let ((ext (copy-extent modeline-buffer-id-left-extent))) - ext)) - -(defvar gnus-xmas-modeline-right-extent - (let ((ext (copy-extent modeline-buffer-id-right-extent))) - ext)) - -(defvar gnus-xmas-modeline-glyph - (progn - (let* ((file-xpm (expand-file-name "gnus-pointer.xpm" - gnus-xmas-glyph-directory)) - (file-xbm (expand-file-name "gnus-pointer.xbm" - gnus-xmas-glyph-directory)) - (glyph (make-glyph - ;; Gag gag gag. - (cond ((featurep 'xpm) - ;; Let's try a nifty XPM - `[xpm :file ,file-xpm]) - ((featurep 'xbm) - ;; Then a not-so-nifty XBM - `[xbm :file ,file-xbm]) - ;; Then the simple string - (t [string :data "Gnus:"]))))) - (set-glyph-face glyph 'modeline-buffer-id) - glyph))) - -(defun gnus-xmas-mode-line-buffer-identification (line) - (let ((line (car line)) - chop) - (cond - ;; This is some weird type of id. - ((not (stringp line)) - (list line)) - ;; This is non-standard, so we just pass it through. - ((not (string-match "^Gnus:" line)) - (list line)) - ;; We have a standard line, so we colorize and glyphize it a bit. - (t - (setq chop (match-end 0)) - (list - (if gnus-xmas-modeline-glyph - (cons gnus-xmas-modeline-left-extent gnus-xmas-modeline-glyph) - (cons gnus-xmas-modeline-left-extent (substring line 0 chop))) - (cons gnus-xmas-modeline-right-extent (substring line chop))))))) - -(defun gnus-xmas-splash () - (when (eq (device-type) 'x) - (gnus-splash))) - -(defun gnus-xmas-annotation-in-region-p (b e) - (or (map-extents (lambda (e u) t) nil b e nil nil 'mm t) - (if (= b e) - (eq (cadr (memq 'gnus-undeletable (text-properties-at b))) t) - (text-property-any b e 'gnus-undeletable t)))) - -(defun gnus-xmas-mime-button-menu (event prefix) - "Construct a context-sensitive menu of MIME commands." - (interactive "e\nP") - (let ((response (get-popup-menu-response - `("MIME Part" - ,@(mapcar (lambda (c) `[,(caddr c) ,(car c) t]) - gnus-mime-button-commands))))) - (set-buffer (event-buffer event)) - (goto-char (event-point event)) - (funcall (event-function response) (event-object response)))) - -(defun gnus-group-add-icon () - "Add an icon to the current line according to `gnus-group-icon-list'." - (let* ((p (point)) - (end (gnus-point-at-eol)) - ;; now find out where the line starts and leave point there. - (beg (progn (beginning-of-line) (point)))) - (save-restriction - (narrow-to-region beg end) - (goto-char beg) - (when (search-forward "==&&==" nil t) - (let* ((group (gnus-group-group-name)) - (entry (gnus-group-entry group)) - (unread (if (numberp (car entry)) (car entry) 0)) - (active (gnus-active group)) - (total (if active (1+ (- (cdr active) (car active))) 0)) - (info (nth 2 entry)) - (method (gnus-server-get-method group (gnus-info-method info))) - (marked (gnus-info-marks info)) - (mailp (memq 'mail (assoc (symbol-name - (car (or method gnus-select-method))) - gnus-valid-select-methods))) - (level (or (gnus-info-level info) gnus-level-killed)) - (score (or (gnus-info-score info) 0)) - (ticked (gnus-range-length (cdr (assq 'tick marked)))) - (group-age (gnus-group-timestamp-delta group)) - (inhibit-read-only t) - (list gnus-group-icon-list) - (mystart (match-beginning 0)) - (myend (match-end 0))) - (goto-char (point-min)) - (while (and list - (not (eval (caar list)))) - (setq list (cdr list))) - (if list - (let* ((file (cdar list)) - (glyph (gnus-group-icon-create-glyph - (buffer-substring mystart myend) - file))) - (if glyph - (progn - (mapcar 'delete-annotation (annotations-at myend)) - (let ((ext (make-extent mystart myend)) - (ant (make-annotation glyph myend 'text))) - ;; set text extent params - (set-extent-property ext 'end-open t) - (set-extent-property ext 'start-open t) - (set-extent-property ext 'invisible t))) - (delete-region mystart myend))) - (delete-region mystart myend)))) - (widen)) - (goto-char p))) - -(defun gnus-group-icon-create-glyph (substring pixmap) - "Create a glyph for insertion into a group line." - (or - (cdr-safe (assoc pixmap gnus-group-icon-cache)) - (let* ((glyph (make-glyph - (list - (cons 'x - (expand-file-name pixmap gnus-xmas-glyph-directory)) - (cons 'mswindows - (expand-file-name pixmap gnus-xmas-glyph-directory)) - (cons 'tty substring))))) - (setq gnus-group-icon-cache - (cons (cons pixmap glyph) gnus-group-icon-cache)) - (set-glyph-face glyph 'default) - glyph))) - -(defun gnus-xmas-mailing-list-menu-add () - (gnus-xmas-menu-add mailing-list - gnus-mailing-list-menu)) - -(defun gnus-xmas-image-type-available-p (type) - (and (if (fboundp 'display-images-p) - (display-images-p) - window-system) - (featurep (if (eq type 'pbm) 'xbm type)))) - -(defun gnus-xmas-create-image (file &optional type data-p &rest props) - (let ((type (if type - (symbol-name type) - (car (last (split-string file "[.]"))))) - (face (plist-get props :face)) - glyph) - (when (equal type "pbm") - (with-temp-buffer - (if data-p - (insert file) - (insert-file-contents-literally file)) - (shell-command-on-region (point-min) (point-max) - "ppmtoxpm 2>/dev/null" t) - (setq file (buffer-string) - type "xpm" - data-p t))) - (setq glyph - (if (equal type "xbm") - (make-glyph (list (cons 'x file))) - (with-temp-buffer - (if data-p - (insert file) - (insert-file-contents-literally file)) - (make-glyph - (vector - (or (intern type) - (mm-image-type-from-buffer)) - :data (buffer-string)))))) - (when face - (set-glyph-face glyph face)) - glyph)) - -(defun gnus-xmas-put-image (glyph &optional string category) - "Insert STRING, but display GLYPH. -Warning: Don't insert text immediately after the image." - (let ((begin (point)) - extent) - (if (and (bobp) (not string)) - (setq string " ")) - (if string - (insert string) - (setq begin (1- begin))) - (setq extent (make-extent begin (point))) - (set-extent-property extent 'gnus-image category) - (set-extent-property extent 'duplicable t) - (if string - (set-extent-property extent 'invisible t)) - (set-extent-property extent 'end-glyph glyph)) - glyph) - -(defun gnus-xmas-remove-image (image &optional category) - (map-extents - (lambda (ext unused) - (when (equal (extent-end-glyph ext) image) - (set-extent-property ext 'invisible nil) - (set-extent-property ext 'end-glyph nil)) - nil) - nil nil nil nil nil 'gnus-image category)) - -(defun gnus-xmas-completing-read (prompt table &optional - predicate require-match history) - (when (and history - (not (boundp history))) - (set history nil)) - (completing-read - (if (symbol-value history) - (concat prompt " (" (car (symbol-value history)) "): ") - (concat prompt ": ")) - table - predicate - require-match - nil - history)) - -;; This macro is because XEmacs versions prior to 21.2 do not have the -;; PROTOCOL argument to `open-network-stream'. -(defmacro gnus-xmas-open-network-stream (name buffer host service &optional protocol) - "Like `open-network-stream' but take into account older XEmacs versions." - (if (and (featurep 'xemacs) - (fboundp 'open-network-stream) - (emacs-version>= 21 2)) - `(open-network-stream ,name ,buffer ,host ,service ,protocol) - `(open-network-stream ,name ,buffer ,host ,service))) - -(defun gnus-xmas-assq-delete-all (key alist) - (let ((elem nil)) - (while (setq elem (assq key alist)) - (setq alist (delq elem alist))) - alist)) - -(provide 'gnus-xmas) - -;;; arch-tag: 4e84de3f-ea0a-4ee3-bfeb-e03d46fcacef -;;; gnus-xmas.el ends here diff --git a/xemacs-packages/gnus/lisp/gnus.el b/xemacs-packages/gnus/lisp/gnus.el deleted file mode 100644 index 8cfefe61..00000000 --- a/xemacs-packages/gnus/lisp/gnus.el +++ /dev/null @@ -1,4306 +0,0 @@ -;;; gnus.el --- a newsreader for GNU Emacs - -;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, 1997, 1998, -;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Masanobu UMEDA -;; Lars Magne Ingebrigtsen -;; Keywords: news, mail - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval '(run-hooks 'gnus-load-hook)) - -(eval-when-compile (require 'cl)) -(require 'wid-edit) -(require 'mm-util) -(require 'nnheader) - -;; These are defined afterwards with gnus-define-group-parameter -(defvar gnus-ham-process-destinations) -(defvar gnus-parameter-ham-marks-alist) -(defvar gnus-parameter-spam-marks-alist) -(defvar gnus-spam-autodetect) -(defvar gnus-spam-autodetect-methods) -(defvar gnus-spam-newsgroup-contents) -(defvar gnus-spam-process-destinations) -(defvar gnus-spam-process-newsgroups) - - -(defgroup gnus nil - "The coffee-brewing, all singing, all dancing, kitchen sink newsreader." - :group 'news - :group 'mail) - -(defgroup gnus-start nil - "Starting your favorite newsreader." - :group 'gnus) - -(defgroup gnus-format nil - "Dealing with formatting issues." - :group 'gnus) - -(defgroup gnus-charset nil - "Group character set issues." - :link '(custom-manual "(gnus)Charsets") - :version "21.1" - :group 'gnus) - -(defgroup gnus-cache nil - "Cache interface." - :link '(custom-manual "(gnus)Article Caching") - :group 'gnus) - -(defgroup gnus-registry nil - "Article Registry." - :group 'gnus) - -(defgroup gnus-start-server nil - "Server options at startup." - :group 'gnus-start) - -;; These belong to gnus-group.el. -(defgroup gnus-group nil - "Group buffers." - :link '(custom-manual "(gnus)Group Buffer") - :group 'gnus) - -(defgroup gnus-group-foreign nil - "Foreign groups." - :link '(custom-manual "(gnus)Foreign Groups") - :group 'gnus-group) - -(defgroup gnus-group-new nil - "Automatic subscription of new groups." - :group 'gnus-group) - -(defgroup gnus-group-levels nil - "Group levels." - :link '(custom-manual "(gnus)Group Levels") - :group 'gnus-group) - -(defgroup gnus-group-select nil - "Selecting a Group." - :link '(custom-manual "(gnus)Selecting a Group") - :group 'gnus-group) - -(defgroup gnus-group-listing nil - "Showing slices of the group list." - :link '(custom-manual "(gnus)Listing Groups") - :group 'gnus-group) - -(defgroup gnus-group-visual nil - "Sorting the group buffer." - :link '(custom-manual "(gnus)Group Buffer Format") - :group 'gnus-group - :group 'gnus-visual) - -(defgroup gnus-group-various nil - "Various group options." - :link '(custom-manual "(gnus)Scanning New Messages") - :group 'gnus-group) - -;; These belong to gnus-sum.el. -(defgroup gnus-summary nil - "Summary buffers." - :link '(custom-manual "(gnus)Summary Buffer") - :group 'gnus) - -(defgroup gnus-summary-exit nil - "Leaving summary buffers." - :link '(custom-manual "(gnus)Exiting the Summary Buffer") - :group 'gnus-summary) - -(defgroup gnus-summary-marks nil - "Marks used in summary buffers." - :link '(custom-manual "(gnus)Marking Articles") - :group 'gnus-summary) - -(defgroup gnus-thread nil - "Ordering articles according to replies." - :link '(custom-manual "(gnus)Threading") - :group 'gnus-summary) - -(defgroup gnus-summary-format nil - "Formatting of the summary buffer." - :link '(custom-manual "(gnus)Summary Buffer Format") - :group 'gnus-summary) - -(defgroup gnus-summary-choose nil - "Choosing Articles." - :link '(custom-manual "(gnus)Choosing Articles") - :group 'gnus-summary) - -(defgroup gnus-summary-maneuvering nil - "Summary movement commands." - :link '(custom-manual "(gnus)Summary Maneuvering") - :group 'gnus-summary) - -(defgroup gnus-picon nil - "Show pictures of people, domains, and newsgroups." - :group 'gnus-visual) - -(defgroup gnus-summary-mail nil - "Mail group commands." - :link '(custom-manual "(gnus)Mail Group Commands") - :group 'gnus-summary) - -(defgroup gnus-summary-sort nil - "Sorting the summary buffer." - :link '(custom-manual "(gnus)Sorting the Summary Buffer") - :group 'gnus-summary) - -(defgroup gnus-summary-visual nil - "Highlighting and menus in the summary buffer." - :link '(custom-manual "(gnus)Summary Highlighting") - :group 'gnus-visual - :group 'gnus-summary) - -(defgroup gnus-summary-various nil - "Various summary buffer options." - :link '(custom-manual "(gnus)Various Summary Stuff") - :group 'gnus-summary) - -(defgroup gnus-summary-pick nil - "Pick mode in the summary buffer." - :link '(custom-manual "(gnus)Pick and Read") - :prefix "gnus-pick-" - :group 'gnus-summary) - -(defgroup gnus-summary-tree nil - "Tree display of threads in the summary buffer." - :link '(custom-manual "(gnus)Tree Display") - :prefix "gnus-tree-" - :group 'gnus-summary) - -;; Belongs to gnus-uu.el -(defgroup gnus-extract-view nil - "Viewing extracted files." - :link '(custom-manual "(gnus)Viewing Files") - :group 'gnus-extract) - -;; Belongs to gnus-score.el -(defgroup gnus-score nil - "Score and kill file handling." - :group 'gnus) - -(defgroup gnus-score-kill nil - "Kill files." - :group 'gnus-score) - -(defgroup gnus-score-adapt nil - "Adaptive score files." - :group 'gnus-score) - -(defgroup gnus-score-default nil - "Default values for score files." - :group 'gnus-score) - -(defgroup gnus-score-expire nil - "Expiring score rules." - :group 'gnus-score) - -(defgroup gnus-score-decay nil - "Decaying score rules." - :group 'gnus-score) - -(defgroup gnus-score-files nil - "Score and kill file names." - :group 'gnus-score - :group 'gnus-files) - -(defgroup gnus-score-various nil - "Various scoring and killing options." - :group 'gnus-score) - -;; Other -(defgroup gnus-visual nil - "Options controlling the visual fluff." - :group 'gnus - :group 'faces) - -(defgroup gnus-agent nil - "Offline support for Gnus." - :group 'gnus) - -(defgroup gnus-files nil - "Files used by Gnus." - :group 'gnus) - -(defgroup gnus-dribble-file nil - "Auto save file." - :link '(custom-manual "(gnus)Auto Save") - :group 'gnus-files) - -(defgroup gnus-newsrc nil - "Storing Gnus state." - :group 'gnus-files) - -(defgroup gnus-server nil - "Options related to newsservers and other servers used by Gnus." - :group 'gnus) - -(defgroup gnus-server-visual nil - "Highlighting and menus in the server buffer." - :group 'gnus-visual - :group 'gnus-server) - -(defgroup gnus-message '((message custom-group)) - "Composing replies and followups in Gnus." - :group 'gnus) - -(defgroup gnus-meta nil - "Meta variables controlling major portions of Gnus. -In general, modifying these variables does not take affect until Gnus -is restarted, and sometimes reloaded." - :group 'gnus) - -(defgroup gnus-various nil - "Other Gnus options." - :link '(custom-manual "(gnus)Various Various") - :group 'gnus) - -(defgroup gnus-exit nil - "Exiting Gnus." - :link '(custom-manual "(gnus)Exiting Gnus") - :group 'gnus) - -(defgroup gnus-fun nil - "Frivolous Gnus extensions." - :link '(custom-manual "(gnus)Exiting Gnus") - :group 'gnus) - -(defconst gnus-version-number "5.10.10" - "Version number for this version of Gnus.") - -(defconst gnus-version (format "Gnus v%s" gnus-version-number) - "Version string for this version of Gnus.") - -(defcustom gnus-inhibit-startup-message nil - "If non-nil, the startup message will not be displayed. -This variable is used before `.gnus.el' is loaded, so it should -be set in `.emacs' instead." - :group 'gnus-start - :type 'boolean) - -(defcustom gnus-play-startup-jingle nil - "If non-nil, play the Gnus jingle at startup." - :group 'gnus-start - :type 'boolean) - -(unless (fboundp 'gnus-group-remove-excess-properties) - (defalias 'gnus-group-remove-excess-properties 'ignore)) - -(unless (fboundp 'gnus-set-text-properties) - (defalias 'gnus-set-text-properties 'set-text-properties)) - -(unless (featurep 'gnus-xmas) - (defalias 'gnus-make-overlay 'make-overlay) - (defalias 'gnus-delete-overlay 'delete-overlay) - (defalias 'gnus-overlay-put 'overlay-put) - (defalias 'gnus-move-overlay 'move-overlay) - (defalias 'gnus-overlay-buffer 'overlay-buffer) - (defalias 'gnus-overlay-start 'overlay-start) - (defalias 'gnus-overlay-end 'overlay-end) - (defalias 'gnus-extent-detached-p 'ignore) - (defalias 'gnus-extent-start-open 'ignore) - (defalias 'gnus-appt-select-lowest-window 'appt-select-lowest-window) - (defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names) - (defalias 'gnus-character-to-event 'identity) - (defalias 'gnus-assq-delete-all 'assq-delete-all) - (defalias 'gnus-add-text-properties 'add-text-properties) - (defalias 'gnus-put-text-property 'put-text-property) - (defvar gnus-mode-line-image-cache t) - (if (fboundp 'find-image) - (defun gnus-mode-line-buffer-identification (line) - (let ((str (car-safe line)) - (load-path (mm-image-load-path))) - (if (and (stringp str) - (string-match "^Gnus:" str)) - (progn (add-text-properties - 0 5 - (list 'display - (if (eq t gnus-mode-line-image-cache) - (setq gnus-mode-line-image-cache - (find-image - '((:type xpm :file "gnus-pointer.xpm" - :ascent center) - (:type xbm :file "gnus-pointer.xbm" - :ascent center)))) - gnus-mode-line-image-cache) - 'help-echo (format - "This is %s, %s." - gnus-version (gnus-emacs-version))) - str) - (list str)) - line))) - (defalias 'gnus-mode-line-buffer-identification 'identity)) - (defalias 'gnus-characterp 'numberp) - (defalias 'gnus-deactivate-mark 'deactivate-mark) - (defalias 'gnus-window-edges 'window-edges) - (defalias 'gnus-key-press-event-p 'numberp) - ;;(defalias 'gnus-decode-rfc1522 'ignore) - ) - -;; We define these group faces here to avoid the display -;; update forced when creating new faces. - -(defface gnus-group-news-1 - '((((class color) - (background dark)) - (:foreground "PaleTurquoise" :bold t)) - (((class color) - (background light)) - (:foreground "ForestGreen" :bold t)) - (t - ())) - "Level 1 newsgroup face." - :group 'gnus-group) -;; backward-compatibility alias -(put 'gnus-group-news-1-face 'face-alias 'gnus-group-news-1) - -(defface gnus-group-news-1-empty - '((((class color) - (background dark)) - (:foreground "PaleTurquoise")) - (((class color) - (background light)) - (:foreground "ForestGreen")) - (t - ())) - "Level 1 empty newsgroup face." - :group 'gnus-group) -;; backward-compatibility alias -(put 'gnus-group-news-1-empty-face 'face-alias 'gnus-group-news-1-empty) - -(defface gnus-group-news-2 - '((((class color) - (background dark)) - (:foreground "turquoise" :bold t)) - (((class color) - (background light)) - (:foreground "CadetBlue4" :bold t)) - (t - ())) - "Level 2 newsgroup face." - :group 'gnus-group) -;; backward-compatibility alias -(put 'gnus-group-news-2-face 'face-alias 'gnus-group-news-2) - -(defface gnus-group-news-2-empty - '((((class color) - (background dark)) - (:foreground "turquoise")) - (((class color) - (background light)) - (:foreground "CadetBlue4")) - (t - ())) - "Level 2 empty newsgroup face." - :group 'gnus-group) -;; backward-compatibility alias -(put 'gnus-group-news-2-empty-face 'face-alias 'gnus-group-news-2-empty) - -(defface gnus-group-news-3 - '((((class color) - (background dark)) - (:bold t)) - (((class color) - (background light)) - (:bold t)) - (t - ())) - "Level 3 newsgroup face." - :group 'gnus-group) -;; backward-compatibility alias -(put 'gnus-group-news-3-face 'face-alias 'gnus-group-news-3) - -(defface gnus-group-news-3-empty - '((((class color) - (background dark)) - ()) - (((class color) - (background light)) - ()) - (t - ())) - "Level 3 empty newsgroup face." - :group 'gnus-group) -;; backward-compatibility alias -(put 'gnus-group-news-3-empty-face 'face-alias 'gnus-group-news-3-empty) - -(defface gnus-group-news-4 - '((((class color) - (background dark)) - (:bold t)) - (((class color) - (background light)) - (:bold t)) - (t - ())) - "Level 4 newsgroup face." - :group 'gnus-group) -;; backward-compatibility alias -(put 'gnus-group-news-4-face 'face-alias 'gnus-group-news-4) - -(defface gnus-group-news-4-empty - '((((class color) - (background dark)) - ()) - (((class color) - (background light)) - ()) - (t - ())) - "Level 4 empty newsgroup face." - :group 'gnus-group) -;; backward-compatibility alias -(put 'gnus-group-news-4-empty-face 'face-alias 'gnus-group-news-4-empty) - -(defface gnus-group-news-5 - '((((class color) - (background dark)) - (:bold t)) - (((class color) - (background light)) - (:bold t)) - (t - ())) - "Level 5 newsgroup face." - :group 'gnus-group) -;; backward-compatibility alias -(put 'gnus-group-news-5-face 'face-alias 'gnus-group-news-5) - -(defface gnus-group-news-5-empty - '((((class color) - (background dark)) - ()) - (((class color) - (background light)) - ()) - (t - ())) - "Level 5 empty newsgroup face." - :group 'gnus-group) -;; backward-compatibility alias -(put 'gnus-group-news-5-empty-face 'face-alias 'gnus-group-news-5-empty) - -(defface gnus-group-news-6 - '((((class color) - (background dark)) - (:bold t)) - (((class color) - (background light)) - (:bold t)) - (t - ())) - "Level 6 newsgroup face." - :group 'gnus-group) -;; backward-compatibility alias -(put 'gnus-group-news-6-face 'face-alias 'gnus-group-news-6) - -(defface gnus-group-news-6-empty - '((((class color) - (background dark)) - ()) - (((class color) - (background light)) - ()) - (t - ())) - "Level 6 empty newsgroup face." - :group 'gnus-group) -;; backward-compatibility alias -(put 'gnus-group-news-6-empty-face 'face-alias 'gnus-group-news-6-empty) - -(defface gnus-group-news-low - '((((class color) - (background dark)) - (:foreground "DarkTurquoise" :bold t)) - (((class color) - (background light)) - (:foreground "DarkGreen" :bold t)) - (t - ())) - "Low level newsgroup face." - :group 'gnus-group) -;; backward-compatibility alias -(put 'gnus-group-news-low-face 'face-alias 'gnus-group-news-low) - -(defface gnus-group-news-low-empty - '((((class color) - (background dark)) - (:foreground "DarkTurquoise")) - (((class color) - (background light)) - (:foreground "DarkGreen")) - (t - ())) - "Low level empty newsgroup face." - :group 'gnus-group) -;; backward-compatibility alias -(put 'gnus-group-news-low-empty-face 'face-alias 'gnus-group-news-low-empty) - -(defface gnus-group-mail-1 - '((((class color) - (background dark)) - (:foreground "aquamarine1" :bold t)) - (((class color) - (background light)) - (:foreground "DeepPink3" :bold t)) - (t - (:bold t))) - "Level 1 mailgroup face." - :group 'gnus-group) -;; backward-compatibility alias -(put 'gnus-group-mail-1-face 'face-alias 'gnus-group-mail-1) - -(defface gnus-group-mail-1-empty - '((((class color) - (background dark)) - (:foreground "aquamarine1")) - (((class color) - (background light)) - (:foreground "DeepPink3")) - (t - (:italic t :bold t))) - "Level 1 empty mailgroup face." - :group 'gnus-group) -;; backward-compatibility alias -(put 'gnus-group-mail-1-empty-face 'face-alias 'gnus-group-mail-1-empty) - -(defface gnus-group-mail-2 - '((((class color) - (background dark)) - (:foreground "aquamarine2" :bold t)) - (((class color) - (background light)) - (:foreground "HotPink3" :bold t)) - (t - (:bold t))) - "Level 2 mailgroup face." - :group 'gnus-group) -;; backward-compatibility alias -(put 'gnus-group-mail-2-face 'face-alias 'gnus-group-mail-2) - -(defface gnus-group-mail-2-empty - '((((class color) - (background dark)) - (:foreground "aquamarine2")) - (((class color) - (background light)) - (:foreground "HotPink3")) - (t - (:bold t))) - "Level 2 empty mailgroup face." - :group 'gnus-group) -;; backward-compatibility alias -(put 'gnus-group-mail-2-empty-face 'face-alias 'gnus-group-mail-2-empty) - -(defface gnus-group-mail-3 - '((((class color) - (background dark)) - (:foreground "aquamarine3" :bold t)) - (((class color) - (background light)) - (:foreground "magenta4" :bold t)) - (t - (:bold t))) - "Level 3 mailgroup face." - :group 'gnus-group) -;; backward-compatibility alias -(put 'gnus-group-mail-3-face 'face-alias 'gnus-group-mail-3) - -(defface gnus-group-mail-3-empty - '((((class color) - (background dark)) - (:foreground "aquamarine3")) - (((class color) - (background light)) - (:foreground "magenta4")) - (t - ())) - "Level 3 empty mailgroup face." - :group 'gnus-group) -;; backward-compatibility alias -(put 'gnus-group-mail-3-empty-face 'face-alias 'gnus-group-mail-3-empty) - -(defface gnus-group-mail-low - '((((class color) - (background dark)) - (:foreground "aquamarine4" :bold t)) - (((class color) - (background light)) - (:foreground "DeepPink4" :bold t)) - (t - (:bold t))) - "Low level mailgroup face." - :group 'gnus-group) -;; backward-compatibility alias -(put 'gnus-group-mail-low-face 'face-alias 'gnus-group-mail-low) - -(defface gnus-group-mail-low-empty - '((((class color) - (background dark)) - (:foreground "aquamarine4")) - (((class color) - (background light)) - (:foreground "DeepPink4")) - (t - (:bold t))) - "Low level empty mailgroup face." - :group 'gnus-group) -;; backward-compatibility alias -(put 'gnus-group-mail-low-empty-face 'face-alias 'gnus-group-mail-low-empty) - -;; Summary mode faces. - -(defface gnus-summary-selected '((t (:underline t))) - "Face used for selected articles." - :group 'gnus-summary) -;; backward-compatibility alias -(put 'gnus-summary-selected-face 'face-alias 'gnus-summary-selected) - -(defface gnus-summary-cancelled - '((((class color)) - (:foreground "yellow" :background "black"))) - "Face used for cancelled articles." - :group 'gnus-summary) -;; backward-compatibility alias -(put 'gnus-summary-cancelled-face 'face-alias 'gnus-summary-cancelled) - -(defface gnus-summary-high-ticked - '((((class color) - (background dark)) - (:foreground "pink" :bold t)) - (((class color) - (background light)) - (:foreground "firebrick" :bold t)) - (t - (:bold t))) - "Face used for high interest ticked articles." - :group 'gnus-summary) -;; backward-compatibility alias -(put 'gnus-summary-high-ticked-face 'face-alias 'gnus-summary-high-ticked) - -(defface gnus-summary-low-ticked - '((((class color) - (background dark)) - (:foreground "pink" :italic t)) - (((class color) - (background light)) - (:foreground "firebrick" :italic t)) - (t - (:italic t))) - "Face used for low interest ticked articles." - :group 'gnus-summary) -;; backward-compatibility alias -(put 'gnus-summary-low-ticked-face 'face-alias 'gnus-summary-low-ticked) - -(defface gnus-summary-normal-ticked - '((((class color) - (background dark)) - (:foreground "pink")) - (((class color) - (background light)) - (:foreground "firebrick")) - (t - ())) - "Face used for normal interest ticked articles." - :group 'gnus-summary) -;; backward-compatibility alias -(put 'gnus-summary-normal-ticked-face 'face-alias 'gnus-summary-normal-ticked) - -(defface gnus-summary-high-ancient - '((((class color) - (background dark)) - (:foreground "SkyBlue" :bold t)) - (((class color) - (background light)) - (:foreground "RoyalBlue" :bold t)) - (t - (:bold t))) - "Face used for high interest ancient articles." - :group 'gnus-summary) -;; backward-compatibility alias -(put 'gnus-summary-high-ancient-face 'face-alias 'gnus-summary-high-ancient) - -(defface gnus-summary-low-ancient - '((((class color) - (background dark)) - (:foreground "SkyBlue" :italic t)) - (((class color) - (background light)) - (:foreground "RoyalBlue" :italic t)) - (t - (:italic t))) - "Face used for low interest ancient articles." - :group 'gnus-summary) -;; backward-compatibility alias -(put 'gnus-summary-low-ancient-face 'face-alias 'gnus-summary-low-ancient) - -(defface gnus-summary-normal-ancient - '((((class color) - (background dark)) - (:foreground "SkyBlue")) - (((class color) - (background light)) - (:foreground "RoyalBlue")) - (t - ())) - "Face used for normal interest ancient articles." - :group 'gnus-summary) -;; backward-compatibility alias -(put 'gnus-summary-normal-ancient-face 'face-alias 'gnus-summary-normal-ancient) - -(defface gnus-summary-high-undownloaded - '((((class color) - (background light)) - (:bold t :foreground "cyan4")) - (((class color) (background dark)) - (:bold t :foreground "LightGray")) - (t (:inverse-video t :bold t))) - "Face used for high interest uncached articles." - :group 'gnus-summary) -;; backward-compatibility alias -(put 'gnus-summary-high-undownloaded-face 'face-alias 'gnus-summary-high-undownloaded) - -(defface gnus-summary-low-undownloaded - '((((class color) - (background light)) - (:italic t :foreground "cyan4" :bold nil)) - (((class color) (background dark)) - (:italic t :foreground "LightGray" :bold nil)) - (t (:inverse-video t :italic t))) - "Face used for low interest uncached articles." - :group 'gnus-summary) -;; backward-compatibility alias -(put 'gnus-summary-low-undownloaded-face 'face-alias 'gnus-summary-low-undownloaded) - -(defface gnus-summary-normal-undownloaded - '((((class color) - (background light)) - (:foreground "cyan4" :bold nil)) - (((class color) (background dark)) - (:foreground "LightGray" :bold nil)) - (t (:inverse-video t))) - "Face used for normal interest uncached articles." - :group 'gnus-summary) -;; backward-compatibility alias -(put 'gnus-summary-normal-undownloaded-face 'face-alias 'gnus-summary-normal-undownloaded) - -(defface gnus-summary-high-unread - '((t - (:bold t))) - "Face used for high interest unread articles." - :group 'gnus-summary) -;; backward-compatibility alias -(put 'gnus-summary-high-unread-face 'face-alias 'gnus-summary-high-unread) - -(defface gnus-summary-low-unread - '((t - (:italic t))) - "Face used for low interest unread articles." - :group 'gnus-summary) -;; backward-compatibility alias -(put 'gnus-summary-low-unread-face 'face-alias 'gnus-summary-low-unread) - -(defface gnus-summary-normal-unread - '((t - ())) - "Face used for normal interest unread articles." - :group 'gnus-summary) -;; backward-compatibility alias -(put 'gnus-summary-normal-unread-face 'face-alias 'gnus-summary-normal-unread) - -(defface gnus-summary-high-read - '((((class color) - (background dark)) - (:foreground "PaleGreen" - :bold t)) - (((class color) - (background light)) - (:foreground "DarkGreen" - :bold t)) - (t - (:bold t))) - "Face used for high interest read articles." - :group 'gnus-summary) -;; backward-compatibility alias -(put 'gnus-summary-high-read-face 'face-alias 'gnus-summary-high-read) - -(defface gnus-summary-low-read - '((((class color) - (background dark)) - (:foreground "PaleGreen" - :italic t)) - (((class color) - (background light)) - (:foreground "DarkGreen" - :italic t)) - (t - (:italic t))) - "Face used for low interest read articles." - :group 'gnus-summary) -;; backward-compatibility alias -(put 'gnus-summary-low-read-face 'face-alias 'gnus-summary-low-read) - -(defface gnus-summary-normal-read - '((((class color) - (background dark)) - (:foreground "PaleGreen")) - (((class color) - (background light)) - (:foreground "DarkGreen")) - (t - ())) - "Face used for normal interest read articles." - :group 'gnus-summary) -;; backward-compatibility alias -(put 'gnus-summary-normal-read-face 'face-alias 'gnus-summary-normal-read) - - -;;; -;;; Gnus buffers -;;; - -(defvar gnus-buffers nil) - -(defun gnus-get-buffer-create (name) - "Do the same as `get-buffer-create', but store the created buffer." - (or (get-buffer name) - (car (push (get-buffer-create name) gnus-buffers)))) - -(defun gnus-add-buffer () - "Add the current buffer to the list of Gnus buffers." - (push (current-buffer) gnus-buffers)) - -(defmacro gnus-kill-buffer (buffer) - "Kill BUFFER and remove from the list of Gnus buffers." - `(let ((buf ,buffer)) - (when (gnus-buffer-exists-p buf) - (setq gnus-buffers (delete (get-buffer buf) gnus-buffers)) - (kill-buffer buf)))) - -(defun gnus-buffers () - "Return a list of live Gnus buffers." - (while (and gnus-buffers - (not (buffer-name (car gnus-buffers)))) - (pop gnus-buffers)) - (let ((buffers gnus-buffers)) - (while (cdr buffers) - (if (buffer-name (cadr buffers)) - (pop buffers) - (setcdr buffers (cddr buffers))))) - gnus-buffers) - -;;; Splash screen. - -(defvar gnus-group-buffer "*Group*") - -(eval-and-compile - (autoload 'gnus-play-jingle "gnus-audio")) - -(defface gnus-splash - '((((class color) - (background dark)) - (:foreground "#888888")) - (((class color) - (background light)) - (:foreground "#888888")) - (t - ())) - "Face for the splash screen." - :group 'gnus-start) -;; backward-compatibility alias -(put 'gnus-splash-face 'face-alias 'gnus-splash) - -(defun gnus-splash () - (save-excursion - (switch-to-buffer (gnus-get-buffer-create gnus-group-buffer)) - (let ((buffer-read-only nil)) - (erase-buffer) - (unless gnus-inhibit-startup-message - (gnus-group-startup-message) - (sit-for 0) - (when gnus-play-startup-jingle - (gnus-play-jingle)))))) - -(defun gnus-indent-rigidly (start end arg) - "Indent rigidly using only spaces and no tabs." - (save-excursion - (save-restriction - (narrow-to-region start end) - (let ((tab-width 8)) - (indent-rigidly start end arg) - ;; We translate tabs into spaces -- not everybody uses - ;; an 8-character tab. - (goto-char (point-min)) - (while (search-forward "\t" nil t) - (replace-match " " t t)))))) - -(defvar gnus-simple-splash nil) - -;;(format "%02x%02x%02x" 114 66 20) "724214" - -(defvar gnus-logo-color-alist - '((flame "#cc3300" "#ff2200") - (pine "#c0cc93" "#f8ffb8") - (moss "#a1cc93" "#d2ffb8") - (irish "#04cc90" "#05ff97") - (sky "#049acc" "#05deff") - (tin "#6886cc" "#82b6ff") - (velvet "#7c68cc" "#8c82ff") - (grape "#b264cc" "#cf7df") - (labia "#cc64c2" "#fd7dff") - (berry "#cc6485" "#ff7db5") - (dino "#724214" "#1e3f03") - (oort "#cccccc" "#888888") - (storm "#666699" "#99ccff") - (pdino "#9999cc" "#99ccff") - (purp "#9999cc" "#666699") - (no "#000000" "#ff0000") - (neutral "#b4b4b4" "#878787") - (september "#bf9900" "#ffcc00")) - "Color alist used for the Gnus logo.") - -(defcustom gnus-logo-color-style 'oort - "*Color styles used for the Gnus logo." - :type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem))) - gnus-logo-color-alist)) - :group 'gnus-xmas) - -(defvar gnus-logo-colors - (cdr (assq gnus-logo-color-style gnus-logo-color-alist)) - "Colors used for the Gnus logo.") - -(defun gnus-group-startup-message (&optional x y) - "Insert startup message in current buffer." - ;; Insert the message. - (erase-buffer) - (cond - ((and - (fboundp 'find-image) - (display-graphic-p) - ;; Make sure the library defining `image-load-path' is loaded - ;; (`find-image' is autoloaded) (and discard the result). Else, we may - ;; get "defvar ignored because image-load-path is let-bound" when calling - ;; `find-image' below. - (or (find-image '(nil (:type xpm :file "gnus.xpm"))) t) - (let* ((data-directory (nnheader-find-etc-directory "images/gnus")) - (image-load-path (cond (data-directory - (list data-directory)) - ((boundp 'image-load-path) - (symbol-value 'image-load-path)) - (t load-path))) - (image (find-image - `((:type xpm :file "gnus.xpm" - :color-symbols - (("thing" . ,(car gnus-logo-colors)) - ("shadow" . ,(cadr gnus-logo-colors)) - ("oort" . "#eeeeee") - ("background" . ,(face-background 'default)))) - (:type pbm :file "gnus.pbm" - ;; Account for the pbm's blackground. - :background ,(face-foreground 'gnus-splash) - :foreground ,(face-background 'default)) - (:type xbm :file "gnus.xbm" - ;; Account for the xbm's blackground. - :background ,(face-foreground 'gnus-splash) - :foreground ,(face-background 'default)))))) - (when image - (let ((size (image-size image))) - (insert-char ?\n (max 0 (round (- (window-height) - (or y (cdr size)) 1) 2))) - (insert-char ?\ (max 0 (round (- (window-width) - (or x (car size))) 2))) - (insert-image image)) - (setq gnus-simple-splash nil) - t)))) - (t - (insert - (format " %s - _ ___ _ _ - _ ___ __ ___ __ _ ___ - __ _ ___ __ ___ - _ ___ _ - _ _ __ _ - ___ __ _ - __ _ - _ _ _ - _ _ _ - _ _ _ - __ ___ - _ _ _ _ - _ _ - _ _ - _ _ - _ - __ - -" - "")) - ;; And then hack it. - (gnus-indent-rigidly (point-min) (point-max) - (/ (max (- (window-width) (or x 46)) 0) 2)) - (goto-char (point-min)) - (forward-line 1) - (let* ((pheight (count-lines (point-min) (point-max))) - (wheight (window-height)) - (rest (- wheight pheight))) - (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n))) - ;; Fontify some. - (put-text-property (point-min) (point-max) 'face 'gnus-splash) - (setq gnus-simple-splash t))) - (goto-char (point-min)) - (setq mode-line-buffer-identification (concat " " gnus-version)) - (set-buffer-modified-p t)) - -(eval-when (load) - (let ((command (format "%s" this-command))) - (when (string-match "gnus" command) - (if (string-match "gnus-other-frame" command) - (gnus-get-buffer-create gnus-group-buffer) - (gnus-splash))))) - -;;; Do the rest. - -(require 'gnus-util) -(require 'nnheader) - -(defcustom gnus-parameters nil - "Alist of group parameters. - -For example: - ((\"mail\\\\..*\" (gnus-show-threads nil) - (gnus-use-scoring nil) - (gnus-summary-line-format - \"%U%R%z%I%(%[%d:%ub%-23,23f%]%) %s\\n\") - (gcc-self . t) - (display . all)) - (\"mail\\\\.me\" (gnus-use-scoring t)) - (\"list\\\\..*\" (total-expire . t) - (broken-reply-to . t)))" - :version "22.1" - :group 'gnus-group-various - :type '(repeat (cons regexp - (repeat sexp)))) - -(defcustom gnus-parameters-case-fold-search 'default - "If it is t, ignore case of group names specified in `gnus-parameters'. -If it is nil, don't ignore case. If it is `default', which is for the -backward compatibility, use the value of `case-fold-search'." - :version "22.1" - :group 'gnus-group-various - :type '(choice :format "%{%t%}:\n %[Value Menu%] %v" - (const :tag "Use `case-fold-search'" default) - (const nil) - (const t))) - -(defvar gnus-group-parameters-more nil) - -(defmacro gnus-define-group-parameter (param &rest rest) - "Define a group parameter PARAM. -REST is a plist of following: -:type One of `bool', `list' or nil. -:function The name of the function. -:function-document The documentation of the function. -:parameter-type The type for customizing the parameter. -:parameter-document The documentation for the parameter. -:variable The name of the variable. -:variable-document The documentation for the variable. -:variable-group The group for customizing the variable. -:variable-type The type for customizing the variable. -:variable-default The default value of the variable." - (let* ((type (plist-get rest :type)) - (parameter-type (plist-get rest :parameter-type)) - (parameter-document (plist-get rest :parameter-document)) - (function (or (plist-get rest :function) - (intern (format "gnus-parameter-%s" param)))) - (function-document (or (plist-get rest :function-document) "")) - (variable (or (plist-get rest :variable) - (intern (format "gnus-parameter-%s-alist" param)))) - (variable-document (or (plist-get rest :variable-document) "")) - (variable-group (plist-get rest :variable-group)) - (variable-type (or (plist-get rest :variable-type) - `(quote (repeat - (list (regexp :tag "Group") - ,(car (cdr parameter-type))))))) - (variable-default (plist-get rest :variable-default))) - (list - 'progn - `(defcustom ,variable ,variable-default - ,variable-document - :group 'gnus-group-parameter - :group ',variable-group - :type ,variable-type) - `(setq gnus-group-parameters-more - (delq (assq ',param gnus-group-parameters-more) - gnus-group-parameters-more)) - `(add-to-list 'gnus-group-parameters-more - (list ',param - ,parameter-type - ,parameter-document)) - (if (eq type 'bool) - `(defun ,function (name) - ,function-document - (let ((params (gnus-group-find-parameter name)) - val) - (cond - ((memq ',param params) - t) - ((setq val (assq ',param params)) - (cdr val)) - ((stringp ,variable) - (string-match ,variable name)) - (,variable - (let ((alist ,variable) - elem value) - (while (setq elem (pop alist)) - (when (and name - (string-match (car elem) name)) - (setq alist nil - value (cdr elem)))) - (if (consp value) (car value) value)))))) - `(defun ,function (name) - ,function-document - (and name - (or (gnus-group-find-parameter name ',param ,(and type t)) - (let ((alist ,variable) - elem value) - (while (setq elem (pop alist)) - (when (and name - (string-match (car elem) name)) - (setq alist nil - value (cdr elem)))) - ,(if type - 'value - '(if (consp value) (car value) value)))))))))) - -(defcustom gnus-home-directory "~/" - "Directory variable that specifies the \"home\" directory. -All other Gnus file and directory variables are initialized from this variable." - :group 'gnus-files - :type 'directory) - -(defcustom gnus-directory (or (getenv "SAVEDIR") - (nnheader-concat gnus-home-directory "News/")) - "*Directory variable from which all other Gnus file variables are derived. - -Note that Gnus is mostly loaded when the `.gnus.el' file is read. -This means that other directory variables that are initialized from -this variable won't be set properly if you set this variable in `.gnus.el'. -Set this variable in `.emacs' instead." - :group 'gnus-files - :type 'directory) - -(defcustom gnus-default-directory nil - "*Default directory for all Gnus buffers." - :group 'gnus-files - :type '(choice (const :tag "current" nil) - directory)) - -;; Site dependent variables. These variables should be defined in -;; paths.el. - -(defvar gnus-default-nntp-server nil - "Specify a default NNTP server. -This variable should be defined in paths.el, and should never be set -by the user. -If you want to change servers, you should use `gnus-select-method'. -See the documentation to that variable.") - -;; Don't touch this variable. -(defvar gnus-nntp-service "nntp" - "NNTP service name (\"nntp\" or 119). -This is an obsolete variable, which is scarcely used. If you use an -nntp server for your newsgroup and want to change the port number -used to 899, you would say something along these lines: - - (setq gnus-select-method '(nntp \"my.nntp.server\" (nntp-port-number 899)))") - -(defcustom gnus-nntpserver-file "/etc/nntpserver" - "A file with only the name of the nntp server in it." - :group 'gnus-files - :group 'gnus-server - :type 'file) - -(defun gnus-getenv-nntpserver () - "Find default nntp server. -Check the NNTPSERVER environment variable and the -`gnus-nntpserver-file' file." - (or (getenv "NNTPSERVER") - (and (file-readable-p gnus-nntpserver-file) - (with-temp-buffer - (insert-file-contents gnus-nntpserver-file) - (when (re-search-forward "[^ \t\n\r]+" nil t) - (match-string 0)))))) - -;; `M-x customize-variable RET gnus-select-method RET' should work without -;; starting or even loading Gnus. -;;;###autoload(when (fboundp 'custom-autoload) -;;;###autoload (custom-autoload 'gnus-select-method "gnus")) - -(defcustom gnus-select-method - (condition-case nil - (nconc - (list 'nntp (or (condition-case nil - (gnus-getenv-nntpserver) - (error nil)) - (when (and gnus-default-nntp-server - (not (string= gnus-default-nntp-server ""))) - gnus-default-nntp-server) - "news")) - (if (or (null gnus-nntp-service) - (equal gnus-nntp-service "nntp")) - nil - (list gnus-nntp-service))) - (error nil)) - "Default method for selecting a newsgroup. -This variable should be a list, where the first element is how the -news is to be fetched, the second is the address. - -For instance, if you want to get your news via \"flab.flab.edu\" using -NNTP, you could say: - -\(setq gnus-select-method '(nntp \"flab.flab.edu\")) - -If you want to use your local spool, say: - -\(setq gnus-select-method (list 'nnspool (system-name))) - -If you use this variable, you must set `gnus-nntp-server' to nil. - -There is a lot more to know about select methods and virtual servers - -see the manual for details." - :group 'gnus-server - :group 'gnus-start - :initialize 'custom-initialize-default - :type 'gnus-select-method) - -(defcustom gnus-message-archive-method "archive" - "*Method used for archiving messages you've sent. -This should be a mail method." - :group 'gnus-server - :group 'gnus-message - :type '(choice (const :tag "Default archive method" "archive") - gnus-select-method)) - -(defcustom gnus-message-archive-group nil - "*Name of the group in which to save the messages you've written. -This can either be a string; a list of strings; or an alist -of regexps/functions/forms to be evaluated to return a string (or a list -of strings). The functions are called with the name of the current -group (or nil) as a parameter. - -If you want to save your mail in one group and the news articles you -write in another group, you could say something like: - - \(setq gnus-message-archive-group - '((if (message-news-p) - \"misc-news\" - \"misc-mail\"))) - -Normally the group names returned by this variable should be -unprefixed -- which implicitly means \"store on the archive server\". -However, you may wish to store the message on some other server. In -that case, just return a fully prefixed name of the group -- -\"nnml+private:mail.misc\", for instance." - :group 'gnus-message - :type '(choice (const :tag "none" nil) - function - sexp - string)) - -(defcustom gnus-secondary-servers nil - "List of NNTP servers that the user can choose between interactively. -To make Gnus query you for a server, you have to give `gnus' a -non-numeric prefix - `C-u M-x gnus', in short." - :group 'gnus-server - :type '(repeat string)) - -(defcustom gnus-nntp-server nil - "*The name of the host running the NNTP server. -This variable is semi-obsolete. Use the `gnus-select-method' -variable instead." - :group 'gnus-server - :type '(choice (const :tag "disable" nil) - string)) - -(defcustom gnus-secondary-select-methods nil - "A list of secondary methods that will be used for reading news. -This is a list where each element is a complete select method (see -`gnus-select-method'). - -If, for instance, you want to read your mail with the nnml back end, -you could set this variable: - -\(setq gnus-secondary-select-methods '((nnml \"\")))" - :group 'gnus-server - :type '(repeat gnus-select-method)) - -(defvar gnus-backup-default-subscribed-newsgroups - '("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus") - "Default default new newsgroups the first time Gnus is run. -Should be set in paths.el, and shouldn't be touched by the user.") - -(defcustom gnus-local-domain nil - "Local domain name without a host name. -The DOMAINNAME environment variable is used instead if it is defined. -If the function `system-name' returns the full Internet name, there is -no need to set this variable." - :group 'gnus-message - :type '(choice (const :tag "default" nil) - string)) - -(defvar gnus-local-organization nil - "String with a description of what organization (if any) the user belongs to. -Obsolete variable; use `message-user-organization' instead.") - -;; Customization variables - -(defcustom gnus-refer-article-method nil - "Preferred method for fetching an article by Message-ID. -If you are reading news from the local spool (with nnspool), fetching -articles by Message-ID is painfully slow. By setting this method to an -nntp method, you might get acceptable results. - -The value of this variable must be a valid select method as discussed -in the documentation of `gnus-select-method'. - -It can also be a list of select methods, as well as the special symbol -`current', which means to use the current select method. If it is a -list, Gnus will try all the methods in the list until it finds a match." - :group 'gnus-server - :type '(choice (const :tag "default" nil) - (const current) - (const :tag "Google" (nnweb "refer" (nnweb-type google))) - gnus-select-method - (repeat :menu-tag "Try multiple" - :tag "Multiple" - :value (current (nnweb "refer" (nnweb-type google))) - (choice :tag "Method" - (const current) - (const :tag "Google" - (nnweb "refer" (nnweb-type google))) - gnus-select-method)))) - -(defcustom gnus-group-faq-directory - '("/ftp@mirrors.aol.com:/pub/rtfm/usenet/" - "/ftp@sunsite.doc.ic.ac.uk:/pub/usenet/news-faqs/" - "/ftp@src.doc.ic.ac.uk:/usenet/news-FAQS/" - "/ftp@ftp.seas.gwu.edu:/pub/rtfm/" - "/ftp@ftp.pasteur.fr:/pub/FAQ/" - "/ftp@rtfm.mit.edu:/pub/usenet/" - "/ftp@ftp.uni-paderborn.de:/pub/FAQ/" - "/ftp@ftp.sunet.se:/pub/usenet/" - "/ftp@nctuccca.nctu.edu.tw:/pub/Documents/rtfm/usenet-by-group/" - "/ftp@hwarang.postech.ac.kr:/pub/usenet/" - "/ftp@ftp.hk.super.net:/mirror/faqs/") - "*Directory where the group FAQs are stored. -This will most commonly be on a remote machine, and the file will be -fetched by ange-ftp. - -This variable can also be a list of directories. In that case, the -first element in the list will be used by default. The others can -be used when being prompted for a site. - -Note that Gnus uses an aol machine as the default directory. If this -feels fundamentally unclean, just think of it as a way to finally get -something of value back from them. - -If the default site is too slow, try one of these: - - North America: mirrors.aol.com /pub/rtfm/usenet - ftp.seas.gwu.edu /pub/rtfm - rtfm.mit.edu /pub/usenet - Europe: ftp.uni-paderborn.de /pub/FAQ - src.doc.ic.ac.uk /usenet/news-FAQS - ftp.sunet.se /pub/usenet - ftp.pasteur.fr /pub/FAQ - Asia: nctuccca.nctu.edu.tw /pub/Documents/rtfm/usenet-by-group/ - hwarang.postech.ac.kr /pub/usenet - ftp.hk.super.net /mirror/faqs" - :group 'gnus-group-various - :type '(choice directory - (repeat directory))) - -(defcustom gnus-group-charter-alist - '(("no" . (concat "http://no.news-admin.org/charter/" name ".txt")) - ("de" . (concat "http://purl.net/charta/" name ".html")) - ("dk" . (concat "http://www.usenet.dk/grupper.pl?get=" name)) - ("england" . (concat "http://england.news-admin.org/charters/" name)) - ("fr" . (concat "http://www.usenet-fr.net/fur/chartes/" name ".html")) - ("europa" . (concat "http://www.europa.usenet.eu.org/chartas/charta-en-" - (gnus-replace-in-string name "europa\\." "") ".html")) - ("nl" . (concat "http://www.xs4all.nl/~sister/usenet/charters/" name)) - ("aus" . (concat "http://aus.news-admin.org/groupinfo.cgi/" name)) - ("pl" . (concat "http://www.usenet.pl/opisy/" name)) - ("ch" . (concat "http://www.use-net.ch/Usenet/charter.html#" name)) - ("at" . (concat "http://www.usenet.at/chartas/" name "/charta")) - ("uk" . (concat "http://www.usenet.org.uk/" name ".html")) - ("dfw" . (concat "http://www.cirr.com/dfw/charters/" name ".html")) - ("se" . (concat "http://www.usenet-se.net/Reglementen/" - (gnus-replace-in-string name "\\." "_") ".html")) - ("milw" . (concat "http://usenet.mil.wi.us/" - (gnus-replace-in-string name "milw\\." "") "-charter")) - ("ca" . (concat "http://www.sbay.org/ca/charter-" name ".html")) - ("netins" . (concat "http://www.netins.net/usenet/charter/" - (gnus-replace-in-string name "\\." "-") "-charter.html"))) - "*An alist of (HIERARCHY . FORM) pairs used to construct the URL of a charter. -When FORM is evaluated `name' is bound to the name of the group." - :version "22.1" - :group 'gnus-group-various - :type '(repeat (cons (string :tag "Hierarchy") (sexp :tag "Form")))) -(put 'gnus-group-charter-alist 'risky-local-variable t) - -(defcustom gnus-group-fetch-control-use-browse-url nil - "*Non-nil means that control messages are displayed using `browse-url'. -Otherwise they are fetched with ange-ftp and displayed in an ephemeral -group." - :version "22.1" - :group 'gnus-group-various - :type 'boolean) - -(defcustom gnus-use-cross-reference t - "*Non-nil means that cross referenced articles will be marked as read. -If nil, ignore cross references. If t, mark articles as read in -subscribed newsgroups. If neither t nor nil, mark as read in all -newsgroups." - :group 'gnus-server - :type '(choice (const :tag "off" nil) - (const :tag "subscribed" t) - (sexp :format "all" - :value always))) - -(defcustom gnus-process-mark ?# - "*Process mark." - :group 'gnus-group-visual - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-large-newsgroup 200 - "*The number of articles which indicates a large newsgroup. -If the number of articles in a newsgroup is greater than this value, -confirmation is required for selecting the newsgroup. -If it is nil, no confirmation is required." - :group 'gnus-group-select - :type '(choice (const :tag "No limit" nil) - integer)) - -(defcustom gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix))) - "*Non-nil means that the default name of a file to save articles in is the group name. -If it's nil, the directory form of the group name is used instead. - -If this variable is a list, and the list contains the element -`not-score', long file names will not be used for score files; if it -contains the element `not-save', long file names will not be used for -saving; and if it contains the element `not-kill', long file names -will not be used for kill files. - -Note that the default for this variable varies according to what system -type you're using. On `usg-unix-v' and `xenix' this variable defaults -to nil while on all other systems it defaults to t." - :group 'gnus-start - :type '(radio (sexp :format "Non-nil\n" - :match (lambda (widget value) - (and value (not (listp value)))) - :value t) - (const nil) - (checklist (const :format "%v " not-score) - (const :format "%v " not-save) - (const not-kill)))) - -(defcustom gnus-kill-files-directory gnus-directory - "*Name of the directory where kill files will be stored (default \"~/News\")." - :group 'gnus-score-files - :group 'gnus-score-kill - :type 'directory) - -(defcustom gnus-save-score nil - "*If non-nil, save group scoring info." - :group 'gnus-score-various - :group 'gnus-start - :type 'boolean) - -(defcustom gnus-use-undo t - "*If non-nil, allow undoing in Gnus group mode buffers." - :group 'gnus-meta - :type 'boolean) - -(defcustom gnus-use-adaptive-scoring nil - "*If non-nil, use some adaptive scoring scheme. -If a list, then the values `word' and `line' are meaningful. The -former will perform adaption on individual words in the subject -header while `line' will perform adaption on several headers." - :group 'gnus-meta - :group 'gnus-score-adapt - :type '(set (const word) (const line))) - -(defcustom gnus-use-cache 'passive - "*If nil, Gnus will ignore the article cache. -If `passive', it will allow entering (and reading) articles -explicitly entered into the cache. If anything else, use the -cache to the full extent of the law." - :group 'gnus-meta - :group 'gnus-cache - :type '(choice (const :tag "off" nil) - (const :tag "passive" passive) - (const :tag "active" t))) - -(defcustom gnus-use-trees nil - "*If non-nil, display a thread tree buffer." - :group 'gnus-meta - :type 'boolean) - -(defcustom gnus-use-grouplens nil - "*If non-nil, use GroupLens ratings." - :group 'gnus-meta - :type 'boolean) - -(defcustom gnus-keep-backlog 20 - "*If non-nil, Gnus will keep read articles for later re-retrieval. -If it is a number N, then Gnus will only keep the last N articles -read. If it is neither nil nor a number, Gnus will keep all read -articles. This is not a good idea." - :group 'gnus-meta - :type '(choice (const :tag "off" nil) - integer - (sexp :format "all" - :value t))) - -(defcustom gnus-use-nocem nil - "*If non-nil, Gnus will read NoCeM cancel messages. -You can also set this variable to a positive number as a group level. -In that case, Gnus scans NoCeM messages when checking new news if this -value is not exceeding a group level that you specify as the prefix -argument to some commands, e.g. `gnus', `gnus-group-get-new-news', etc. -Otherwise, Gnus does not scan NoCeM messages if you specify a group -level to those commands." - :group 'gnus-meta - :type '(choice - (const :tag "off" nil) - (const :tag "on" t) - (list :convert-widget - (lambda (widget) - (list 'integer :tag "group level" - :value (if (boundp 'gnus-level-default-subscribed) - gnus-level-default-subscribed - 3)))))) - -(defcustom gnus-suppress-duplicates nil - "*If non-nil, Gnus will mark duplicate copies of the same article as read." - :group 'gnus-meta - :type 'boolean) - -(defcustom gnus-use-scoring t - "*If non-nil, enable scoring." - :group 'gnus-meta - :type 'boolean) - -(defcustom gnus-summary-prepare-exit-hook - '(gnus-summary-expire-articles) - "*A hook called when preparing to exit from the summary buffer. -It calls `gnus-summary-expire-articles' by default." - :group 'gnus-summary-exit - :type 'hook) - -(defcustom gnus-novice-user t - "*Non-nil means that you are a Usenet novice. -If non-nil, verbose messages may be displayed and confirmations may be -required." - :group 'gnus-meta - :type 'boolean) - -(defcustom gnus-expert-user nil - "*Non-nil means that you will never be asked for confirmation about anything. -That doesn't mean *anything* anything; particularly destructive -commands will still require prompting." - :group 'gnus-meta - :type 'boolean) - -(defcustom gnus-interactive-catchup t - "*If non-nil, require your confirmation when catching up a group." - :group 'gnus-group-select - :type 'boolean) - -(defcustom gnus-interactive-exit t - "*If non-nil, require your confirmation when exiting Gnus." - :group 'gnus-exit - :type 'boolean) - -(defcustom gnus-extract-address-components 'gnus-extract-address-components - "*Function for extracting address components from a From header. -Two pre-defined function exist: `gnus-extract-address-components', -which is the default, quite fast, and too simplistic solution, and -`mail-extract-address-components', which works much better, but is -slower." - :group 'gnus-summary-format - :type '(radio (function-item gnus-extract-address-components) - (function-item mail-extract-address-components) - (function :tag "Other"))) - -(defcustom gnus-carpal nil - "*If non-nil, display clickable icons." - :group 'gnus-meta - :type 'boolean) - -(defcustom gnus-shell-command-separator ";" - "String used to separate shell commands." - :group 'gnus-files - :type 'string) - -(defcustom gnus-valid-select-methods - '(("nntp" post address prompt-address physical-address) - ("nnspool" post address) - ("nnvirtual" post-mail virtual prompt-address) - ("nnmbox" mail respool address) - ("nnml" post-mail respool address) - ("nnmh" mail respool address) - ("nndir" post-mail prompt-address physical-address) - ("nneething" none address prompt-address physical-address) - ("nndoc" none address prompt-address) - ("nnbabyl" mail address respool) - ("nnkiboze" post virtual) - ("nnsoup" post-mail address) - ("nndraft" post-mail) - ("nnfolder" mail respool address) - ("nngateway" post-mail address prompt-address physical-address) - ("nnweb" none) - ("nngoogle" post) - ("nnslashdot" post) - ("nnultimate" none) - ("nnrss" none) - ("nnwfm" none) - ("nnwarchive" none) - ("nnlistserv" none) - ("nnagent" post-mail) - ("nnimap" post-mail address prompt-address physical-address) - ("nnmaildir" mail respool address) - ("nnnil" none)) - "*An alist of valid select methods. -The first element of each list lists should be a string with the name -of the select method. The other elements may be the category of -this method (i. e., `post', `mail', `none' or whatever) or other -properties that this method has (like being respoolable). -If you implement a new select method, all you should have to change is -this variable. I think." - :group 'gnus-server - :type '(repeat (group (string :tag "Name") - (radio-button-choice (const :format "%v " post) - (const :format "%v " mail) - (const :format "%v " none) - (const post-mail)) - (checklist :inline t - (const :format "%v " address) - (const :format "%v " prompt-address) - (const :format "%v " physical-address) - (const :format "%v " virtual) - (const respool))))) - -(defun gnus-redefine-select-method-widget () - "Recomputes the select-method widget based on the value of -`gnus-valid-select-methods'." - (define-widget 'gnus-select-method 'list - "Widget for entering a select method." - :value '(nntp "") - :tag "Select Method" - :args `((choice :tag "Method" - ,@(mapcar (lambda (entry) - (list 'const :format "%v\n" - (intern (car entry)))) - gnus-valid-select-methods) - (symbol :tag "other")) - (string :tag "Address") - (repeat :tag "Options" - :inline t - (list :format "%v" - variable - (sexp :tag "Value")))))) - -(gnus-redefine-select-method-widget) - -(defcustom gnus-updated-mode-lines '(group article summary tree) - "List of buffers that should update their mode lines. -The list may contain the symbols `group', `article', `tree' and -`summary'. If the corresponding symbol is present, Gnus will keep -that mode line updated with information that may be pertinent. -If this variable is nil, screen refresh may be quicker." - :group 'gnus-various - :type '(set (const group) - (const article) - (const summary) - (const tree))) - -;; Added by Keinonen Kari . -(defcustom gnus-mode-non-string-length nil - "*Max length of mode-line non-string contents. -If this is nil, Gnus will take space as is needed, leaving the rest -of the mode line intact. Note that the default of nil is unlikely -to be desirable; see the manual for further details." - :group 'gnus-various - :type '(choice (const nil) - integer)) - -;; There should be special validation for this. -(define-widget 'gnus-email-address 'string - "An email address.") - -(gnus-define-group-parameter - to-address - :function-document - "Return GROUP's to-address." - :variable-document - "*Alist of group regexps and correspondent to-addresses." - :variable-group gnus-group-parameter - :parameter-type '(gnus-email-address :tag "To Address") - :parameter-document "\ -This will be used when doing followups and posts. - -This is primarily useful in mail groups that represent closed -mailing lists--mailing lists where it's expected that everybody that -writes to the mailing list is subscribed to it. Since using this -parameter ensures that the mail only goes to the mailing list itself, -it means that members won't receive two copies of your followups. - -Using `to-address' will actually work whether the group is foreign or -not. Let's say there's a group on the server that is called -`fa.4ad-l'. This is a real newsgroup, but the server has gotten the -articles from a mail-to-news gateway. Posting directly to this group -is therefore impossible--you have to send mail to the mailing list -address instead. - -The gnus-group-split mail splitting mechanism will behave as if this -address was listed in gnus-group-split Addresses (see below).") - -(gnus-define-group-parameter - to-list - :function-document - "Return GROUP's to-list." - :variable-document - "*Alist of group regexps and correspondent to-lists." - :variable-group gnus-group-parameter - :parameter-type '(gnus-email-address :tag "To List") - :parameter-document "\ -This address will be used when doing a `a' in the group. - -It is totally ignored when doing a followup--except that if it is -present in a news group, you'll get mail group semantics when doing -`f'. - -The gnus-group-split mail splitting mechanism will behave as if this -address was listed in gnus-group-split Addresses (see below).") - -(gnus-define-group-parameter - subscribed - :type bool - :function-document - "Return GROUP's subscription status." - :variable-document - "*Groups which are automatically considered subscribed." - :variable-group gnus-group-parameter - :parameter-type '(const :tag "Subscribed" t) - :parameter-document "\ -Gnus assumed that you are subscribed to the To/List address. - -When constructing a list of subscribed groups using -`gnus-find-subscribed-addresses', Gnus includes the To address given -above, or the list address (if the To address has not been set).") - -(gnus-define-group-parameter - auto-expire - :type bool - :function gnus-group-auto-expirable-p - :function-document - "Check whether GROUP is auto-expirable or not." - :variable gnus-auto-expirable-newsgroups - :variable-default nil - :variable-document - "*Groups in which to automatically mark read articles as expirable. -If non-nil, this should be a regexp that should match all groups in -which to perform auto-expiry. This only makes sense for mail groups." - :variable-group nnmail-expire - :variable-type '(choice (const nil) - regexp) - :parameter-type '(const :tag "Automatic Expire" t) - :parameter-document - "All articles that are read will be marked as expirable.") - -(gnus-define-group-parameter - total-expire - :type bool - :function gnus-group-total-expirable-p - :function-document - "Check whether GROUP is total-expirable or not." - :variable gnus-total-expirable-newsgroups - :variable-default nil - :variable-document - "*Groups in which to perform expiry of all read articles. -Use with extreme caution. All groups that match this regexp will be -expiring - which means that all read articles will be deleted after -\(say) one week. (This only goes for mail groups and the like, of -course.)" - :variable-group nnmail-expire - :variable-type '(choice (const nil) - regexp) - :parameter-type '(const :tag "Total Expire" t) - :parameter-document - "All read articles will be put through the expiry process - -This happens even if they are not marked as expirable. -Use with caution.") - -(gnus-define-group-parameter - charset - :function-document - "Return the default charset of GROUP." - :variable gnus-group-charset-alist - :variable-default - '(("\\(^\\|:\\)hk\\>\\|\\(^\\|:\\)tw\\>\\|\\" cn-big5) - ("\\(^\\|:\\)cn\\>\\|\\" cn-gb-2312) - ("\\(^\\|:\\)fj\\>\\|\\(^\\|:\\)japan\\>" iso-2022-jp-2) - ("\\(^\\|:\\)tnn\\>\\|\\(^\\|:\\)pin\\>\\|\\(^\\|:\\)sci.lang.japan" iso-2022-7bit) - ("\\(^\\|:\\)relcom\\>" koi8-r) - ("\\(^\\|:\\)fido7\\>" koi8-r) - ("\\(^\\|:\\)\\(cz\\|hun\\|pl\\|sk\\|hr\\)\\>" iso-8859-2) - ("\\(^\\|:\\)israel\\>" iso-8859-1) - ("\\(^\\|:\\)han\\>" euc-kr) - ("\\(^\\|:\\)alt.chinese.text.big5\\>" chinese-big5) - ("\\(^\\|:\\)soc.culture.vietnamese\\>" vietnamese-viqr) - ("\\(^\\|:\\)\\(comp\\|rec\\|alt\\|sci\\|soc\\|news\\|gnu\\|bofh\\)\\>" iso-8859-1)) - :variable-document - "Alist of regexps (to match group names) and default charsets to be used when reading." - :variable-group gnus-charset - :variable-type '(repeat (list (regexp :tag "Group") - (symbol :tag "Charset"))) - :parameter-type '(symbol :tag "Charset") - :parameter-document "\ -The default charset to use in the group.") - -(gnus-define-group-parameter - post-method - :type list - :function-document - "Return a posting method for GROUP." - :variable gnus-post-method-alist - :variable-document - "Alist of regexps (to match group names) and method to be used when -posting an article." - :variable-group gnus-group-foreign - :parameter-type - '(choice :tag "Posting Method" - (const :tag "Use native server" native) - (const :tag "Use current server" current) - (list :convert-widget - (lambda (widget) - (list 'sexp :tag "Methods" - :value gnus-select-method)))) - :parameter-document - "Posting method for this group.") - -(gnus-define-group-parameter - large-newsgroup-initial - :type integer - :function-document - "Return GROUP's initial input of the number of articles." - :variable-document - "*Alist of group regexps and its initial input of the number of articles." - :variable-group gnus-group-parameter - :parameter-type '(choice :tag "Initial Input for Large Newsgroup" - (const :tag "All" nil) - (integer)) - :parameter-document "\ - -This number will be prompted as the initial value of the number of -articles to list when the group is a large newsgroup (see -`gnus-large-newsgroup'). If it is nil, the default value is the -total number of articles in the group.") - -;; The Gnus registry's ignored groups -(gnus-define-group-parameter - registry-ignore - :type list - :function-document - "Whether this group should be ignored by the registry." - :variable gnus-registry-ignored-groups - :variable-default nil - :variable-document - "*Groups in which the registry should be turned off." - :variable-group gnus-registry - :variable-type '(repeat - (list - (regexp :tag "Group Name Regular Expression") - (boolean :tag "Ignored"))) - - :parameter-type '(boolean :tag "Group Ignored by the Registry") - :parameter-document - "Whether the Gnus Registry should ignore this group.") - -;; group parameters for spam processing added by Ted Zlatanov -(defcustom gnus-install-group-spam-parameters t - "*Disable the group parameters for spam detection. -Enable if `G c' in XEmacs is giving you trouble, and make sure to submit a bug report." - :version "22.1" - :type 'boolean - :group 'gnus-start) - -(when gnus-install-group-spam-parameters - (defvar gnus-group-spam-classification-spam t - "Spam group classification (requires spam.el). -This group contains spam messages. On summary entry, unread messages -will be marked as spam. On summary exit, the specified spam -processors will be invoked on spam-marked messages, then those -messages will be expired, so the spam processor will only see a -spam-marked message once.") - - (defvar gnus-group-spam-classification-ham 'ask - "The ham value for the spam group parameter (requires spam.el). -On summary exit, the specified ham processors will be invoked on -ham-marked messages. Exercise caution, since the ham processor will -see the same message more than once because there is no ham message -registry.") - - (gnus-define-group-parameter - spam-contents - :type list - :function-document - "The spam type (spam, ham, or neither) of the group." - :variable gnus-spam-newsgroup-contents - :variable-default nil - :variable-document - "*Group classification (spam, ham, or neither). Only -meaningful when spam.el is loaded. If non-nil, this should be a -list of group name regexps associated with a classification for -each one. In spam groups, new articles are marked as spam on -summary entry. There is other behavior associated with ham and -no classification when spam.el is loaded - see the manual." - :variable-group spam - :variable-type '(repeat - (list :tag "Group contents spam/ham classification" - (regexp :tag "Group") - (choice - (variable-item gnus-group-spam-classification-spam) - (variable-item gnus-group-spam-classification-ham) - (const :tag "Unclassified" nil)))) - - :parameter-type '(list :tag "Group contents spam/ham classification" - (choice :tag "Group contents classification for spam sorting" - (variable-item gnus-group-spam-classification-spam) - (variable-item gnus-group-spam-classification-ham) - (const :tag "Unclassified" nil))) - :parameter-document - "The spam classification (spam, ham, or neither) of this group. -When a spam group is entered, all unread articles are marked as -spam. There is other behavior associated with ham and no -classification when spam.el is loaded - see the manual.") - - (defvar gnus-group-spam-exit-processor-ifile "ifile" - "OBSOLETE: The ifile summary exit spam processor.") - - (defvar gnus-group-spam-exit-processor-stat "stat" - "OBSOLETE: The spam-stat summary exit spam processor.") - - (defvar gnus-group-spam-exit-processor-bogofilter "bogofilter" - "OBSOLETE: The Bogofilter summary exit spam processor.") - - (defvar gnus-group-spam-exit-processor-blacklist "blacklist" - "OBSOLETE: The Blacklist summary exit spam processor.") - - (defvar gnus-group-spam-exit-processor-report-gmane "report-gmane" - "OBSOLETE: The Gmane reporting summary exit spam processor. -Only applicable to NNTP groups with articles from Gmane. See spam-report.el") - - (defvar gnus-group-spam-exit-processor-spamoracle "spamoracle-spam" - "OBSOLETE: The spamoracle summary exit spam processor.") - - (defvar gnus-group-ham-exit-processor-ifile "ifile-ham" - "OBSOLETE: The ifile summary exit ham processor. -Only applicable to non-spam (unclassified and ham) groups.") - - (defvar gnus-group-ham-exit-processor-bogofilter "bogofilter-ham" - "OBSOLETE: The Bogofilter summary exit ham processor. -Only applicable to non-spam (unclassified and ham) groups.") - - (defvar gnus-group-ham-exit-processor-stat "stat-ham" - "OBSOLETE: The spam-stat summary exit ham processor. -Only applicable to non-spam (unclassified and ham) groups.") - - (defvar gnus-group-ham-exit-processor-whitelist "whitelist" - "OBSOLETE: The whitelist summary exit ham processor. -Only applicable to non-spam (unclassified and ham) groups.") - - (defvar gnus-group-ham-exit-processor-BBDB "bbdb" - "OBSOLETE: The BBDB summary exit ham processor. -Only applicable to non-spam (unclassified and ham) groups.") - - (defvar gnus-group-ham-exit-processor-copy "copy" - "OBSOLETE: The ham copy exit ham processor. -Only applicable to non-spam (unclassified and ham) groups.") - - (defvar gnus-group-ham-exit-processor-spamoracle "spamoracle-ham" - "OBSOLETE: The spamoracle summary exit ham processor. -Only applicable to non-spam (unclassified and ham) groups.") - - (gnus-define-group-parameter - spam-process - :type list - :parameter-type - '(choice - :tag "Spam Summary Exit Processor" - :value nil - (list :tag "Spam Summary Exit Processor Choices" - (set - (variable-item gnus-group-spam-exit-processor-ifile) - (variable-item gnus-group-spam-exit-processor-stat) - (variable-item gnus-group-spam-exit-processor-bogofilter) - (variable-item gnus-group-spam-exit-processor-blacklist) - (variable-item gnus-group-spam-exit-processor-spamoracle) - (variable-item gnus-group-spam-exit-processor-report-gmane) - (variable-item gnus-group-ham-exit-processor-bogofilter) - (variable-item gnus-group-ham-exit-processor-ifile) - (variable-item gnus-group-ham-exit-processor-stat) - (variable-item gnus-group-ham-exit-processor-whitelist) - (variable-item gnus-group-ham-exit-processor-BBDB) - (variable-item gnus-group-ham-exit-processor-spamoracle) - (variable-item gnus-group-ham-exit-processor-copy) - (const :tag "Spam: Gmane Report" (spam spam-use-gmane)) - (const :tag "Spam: Bogofilter" (spam spam-use-bogofilter)) - (const :tag "Spam: Blacklist" (spam spam-use-blacklist)) - (const :tag "Spam: ifile" (spam spam-use-ifile)) - (const :tag "Spam: Spam-stat" (spam spam-use-stat)) - (const :tag "Spam: Spam Oracle" (spam spam-use-spamoracle)) - (const :tag "Ham: ifile" (ham spam-use-ifile)) - (const :tag "Ham: Bogofilter" (ham spam-use-bogofilter)) - (const :tag "Ham: Spam-stat" (ham spam-use-stat)) - (const :tag "Ham: Whitelist" (ham spam-use-whitelist)) - (const :tag "Ham: BBDB" (ham spam-use-BBDB)) - (const :tag "Ham: Copy" (ham spam-use-ham-copy)) - (const :tag "Ham: Spam Oracle" (ham spam-use-spamoracle))))) - :function-document - "Which spam or ham processors will be applied when the summary is exited." - :variable gnus-spam-process-newsgroups - :variable-default nil - :variable-document - "*Groups in which to automatically process spam or ham articles with -a backend on summary exit. If non-nil, this should be a list of group -name regexps that should match all groups in which to do automatic -spam processing, associated with the appropriate processor." - :variable-group spam - :variable-type - '(repeat :tag "Spam/Ham Processors" - (list :tag "Spam Summary Exit Processor Choices" - (regexp :tag "Group Regexp") - (set - :tag "Spam/Ham Summary Exit Processor" - (variable-item gnus-group-spam-exit-processor-ifile) - (variable-item gnus-group-spam-exit-processor-stat) - (variable-item gnus-group-spam-exit-processor-bogofilter) - (variable-item gnus-group-spam-exit-processor-blacklist) - (variable-item gnus-group-spam-exit-processor-spamoracle) - (variable-item gnus-group-spam-exit-processor-report-gmane) - (variable-item gnus-group-ham-exit-processor-bogofilter) - (variable-item gnus-group-ham-exit-processor-ifile) - (variable-item gnus-group-ham-exit-processor-stat) - (variable-item gnus-group-ham-exit-processor-whitelist) - (variable-item gnus-group-ham-exit-processor-BBDB) - (variable-item gnus-group-ham-exit-processor-spamoracle) - (variable-item gnus-group-ham-exit-processor-copy) - (const :tag "Spam: Gmane Report" (spam spam-use-gmane)) - (const :tag "Spam: Bogofilter" (spam spam-use-bogofilter)) - (const :tag "Spam: Blacklist" (spam spam-use-blacklist)) - (const :tag "Spam: ifile" (spam spam-use-ifile)) - (const :tag "Spam: Spam-stat" (spam spam-use-stat)) - (const :tag "Spam: Spam Oracle" (spam spam-use-spamoracle)) - (const :tag "Ham: ifile" (ham spam-use-ifile)) - (const :tag "Ham: Bogofilter" (ham spam-use-bogofilter)) - (const :tag "Ham: Spam-stat" (ham spam-use-stat)) - (const :tag "Ham: Whitelist" (ham spam-use-whitelist)) - (const :tag "Ham: BBDB" (ham spam-use-BBDB)) - (const :tag "Ham: Copy" (ham spam-use-ham-copy)) - (const :tag "Ham: Spam Oracle" (ham spam-use-spamoracle))))) - - :parameter-document - "Which spam or ham processors will be applied when the summary is exited.") - - (gnus-define-group-parameter - spam-autodetect - :type list - :parameter-type - '(boolean :tag "Spam autodetection") - :function-document - "Should spam be autodetected (with spam-split) in this group?" - :variable gnus-spam-autodetect - :variable-default nil - :variable-document - "*Groups in which spam should be autodetected when they are entered. - Only unseen articles will be examined, unless - spam-autodetect-recheck-messages is set." - :variable-group spam - :variable-type - '(repeat - :tag "Autodetection setting" - (list - (regexp :tag "Group Regexp") - boolean)) - :parameter-document - "Spam autodetection. -Only unseen articles will be examined, unless -spam-autodetect-recheck-messages is set.") - - (gnus-define-group-parameter - spam-autodetect-methods - :type list - :parameter-type - '(choice :tag "Spam autodetection-specific methods" - (const none) - (const default) - (set :tag "Use specific methods" - (variable-item spam-use-blacklist) - (variable-item spam-use-regex-headers) - (variable-item spam-use-regex-body) - (variable-item spam-use-whitelist) - (variable-item spam-use-BBDB) - (variable-item spam-use-ifile) - (variable-item spam-use-spamoracle) - (variable-item spam-use-stat) - (variable-item spam-use-blackholes) - (variable-item spam-use-hashcash) - (variable-item spam-use-bogofilter-headers) - (variable-item spam-use-bogofilter))) - :function-document - "Methods to be used for autodetection in each group" - :variable gnus-spam-autodetect-methods - :variable-default nil - :variable-document - "*Methods for autodetecting spam per group. -Requires the spam-autodetect parameter. Only unseen articles -will be examined, unless spam-autodetect-recheck-messages is -set." - :variable-group spam - :variable-type - '(repeat - :tag "Autodetection methods" - (list - (regexp :tag "Group Regexp") - (choice - (const none) - (const default) - (set :tag "Use specific methods" - (variable-item spam-use-blacklist) - (variable-item spam-use-regex-headers) - (variable-item spam-use-regex-body) - (variable-item spam-use-whitelist) - (variable-item spam-use-BBDB) - (variable-item spam-use-ifile) - (variable-item spam-use-spamoracle) - (variable-item spam-use-stat) - (variable-item spam-use-blackholes) - (variable-item spam-use-hashcash) - (variable-item spam-use-bogofilter-headers) - (variable-item spam-use-bogofilter))))) - :parameter-document - "Spam autodetection methods. -Requires the spam-autodetect parameter. Only unseen articles -will be examined, unless spam-autodetect-recheck-messages is -set.") - - (gnus-define-group-parameter - spam-process-destination - :type list - :parameter-type - '(choice :tag "Destination for spam-processed articles at summary exit" - (string :tag "Move to a group") - (repeat :tag "Move to multiple groups" - (string :tag "Destination group")) - (const :tag "Expire" nil)) - :function-document - "Where spam-processed articles will go at summary exit." - :variable gnus-spam-process-destinations - :variable-default nil - :variable-document - "*Groups in which to explicitly send spam-processed articles to -another group, or expire them (the default). If non-nil, this should -be a list of group name regexps that should match all groups in which -to do spam-processed article moving, associated with the destination -group or nil for explicit expiration. This only makes sense for -mail groups." - :variable-group spam - :variable-type - '(repeat - :tag "Spam-processed articles destination" - (list - (regexp :tag "Group Regexp") - (choice - :tag "Destination for spam-processed articles at summary exit" - (string :tag "Move to a group") - (repeat :tag "Move to multiple groups" - (string :tag "Destination group")) - (const :tag "Expire" nil)))) - :parameter-document - "Where spam-processed articles will go at summary exit.") - - (gnus-define-group-parameter - ham-process-destination - :type list - :parameter-type - '(choice - :tag "Destination for ham articles at summary exit from a spam group" - (string :tag "Move to a group") - (repeat :tag "Move to multiple groups" - (string :tag "Destination group")) - (const :tag "Respool" respool) - (const :tag "Do nothing" nil)) - :function-document - "Where ham articles will go at summary exit from a spam group." - :variable gnus-ham-process-destinations - :variable-default nil - :variable-document - "*Groups in which to explicitly send ham articles to -another group, or do nothing (the default). If non-nil, this should -be a list of group name regexps that should match all groups in which -to do ham article moving, associated with the destination -group or nil for explicit ignoring. This only makes sense for -mail groups, and only works in spam groups." - :variable-group spam - :variable-type - '(repeat - :tag "Ham articles destination" - (list - (regexp :tag "Group Regexp") - (choice - :tag "Destination for ham articles at summary exit from spam group" - (string :tag "Move to a group") - (repeat :tag "Move to multiple groups" - (string :tag "Destination group")) - (const :tag "Respool" respool) - (const :tag "Expire" nil)))) - :parameter-document - "Where ham articles will go at summary exit from a spam group.") - - (gnus-define-group-parameter - ham-marks - :type 'list - :parameter-type '(list :tag "Ham mark choices" - (set - (variable-item gnus-del-mark) - (variable-item gnus-read-mark) - (variable-item gnus-ticked-mark) - (variable-item gnus-killed-mark) - (variable-item gnus-kill-file-mark) - (variable-item gnus-low-score-mark))) - - :parameter-document - "Marks considered ham (positively not spam). Such articles will be -processed as ham (non-spam) on group exit. When nil, the global -spam-ham-marks variable takes precedence." - :variable-default '((".*" ((gnus-del-mark - gnus-read-mark - gnus-killed-mark - gnus-kill-file-mark - gnus-low-score-mark)))) - :variable-group spam - :variable-document - "*Groups in which to explicitly set the ham marks to some value.") - - (gnus-define-group-parameter - spam-marks - :type 'list - :parameter-type '(list :tag "Spam mark choices" - (set - (variable-item gnus-spam-mark) - (variable-item gnus-killed-mark) - (variable-item gnus-kill-file-mark) - (variable-item gnus-low-score-mark))) - - :parameter-document - "Marks considered spam. -Such articles will be processed as spam on group exit. When nil, the global -spam-spam-marks variable takes precedence." - :variable-default '((".*" ((gnus-spam-mark)))) - :variable-group spam - :variable-document - "*Groups in which to explicitly set the spam marks to some value.")) - -(defcustom gnus-group-uncollapsed-levels 1 - "Number of group name elements to leave alone when making a short group name." - :group 'gnus-group-visual - :type 'integer) - -(defcustom gnus-group-use-permanent-levels nil - "*If non-nil, once you set a level, Gnus will use this level." - :group 'gnus-group-levels - :type 'boolean) - -;; Hooks. - -(defcustom gnus-load-hook nil - "A hook run while Gnus is loaded." - :group 'gnus-start - :type 'hook) - -(defcustom gnus-apply-kill-hook '(gnus-apply-kill-file) - "A hook called to apply kill files to a group. -This hook is intended to apply a kill file to the selected newsgroup. -The function `gnus-apply-kill-file' is called by default. - -Since a general kill file is too heavy to use only for a few -newsgroups, I recommend you to use a lighter hook function. For -example, if you'd like to apply a kill file to articles which contains -a string `rmgroup' in subject in newsgroup `control', you can use the -following hook: - - (setq gnus-apply-kill-hook - (list - (lambda () - (cond ((string-match \"control\" gnus-newsgroup-name) - (gnus-kill \"Subject\" \"rmgroup\") - (gnus-expunge \"X\"))))))" - :group 'gnus-score-kill - :options '(gnus-apply-kill-file) - :type 'hook) - -(defcustom gnus-group-change-level-function nil - "Function run when a group level is changed. -It is called with three parameters -- GROUP, LEVEL and OLDLEVEL." - :group 'gnus-group-levels - :type '(choice (const nil) - function)) - -;;; Face thingies. - -(defcustom gnus-visual - '(summary-highlight group-highlight article-highlight - mouse-face - summary-menu group-menu article-menu - tree-highlight menu highlight - browse-menu server-menu - page-marker tree-menu binary-menu pick-menu - grouplens-menu) - "*Enable visual features. -If `visual' is disabled, there will be no menus and few faces. Most of -the visual customization options below will be ignored. Gnus will use -less space and be faster as a result. - -This variable can also be a list of visual elements to switch on. For -instance, to switch off all visual things except menus, you can say: - - (setq gnus-visual '(menu)) - -Valid elements include `summary-highlight', `group-highlight', -`article-highlight', `mouse-face', `summary-menu', `group-menu', -`article-menu', `tree-highlight', `menu', `highlight', `browse-menu', -`server-menu', `page-marker', `tree-menu', `binary-menu', `pick-menu', -and `grouplens-menu'." - :group 'gnus-meta - :group 'gnus-visual - :type '(set (const summary-highlight) - (const group-highlight) - (const article-highlight) - (const mouse-face) - (const summary-menu) - (const group-menu) - (const article-menu) - (const tree-highlight) - (const menu) - (const highlight) - (const browse-menu) - (const server-menu) - (const page-marker) - (const tree-menu) - (const binary-menu) - (const pick-menu) - (const grouplens-menu))) - -;; Byte-compiler warning. -(defvar gnus-visual) -;; Find out whether the gnus-visual TYPE is wanted. -(defun gnus-visual-p (&optional type class) - (and gnus-visual ; Has to be non-nil, at least. - (if (not type) ; We don't care about type. - gnus-visual - (if (listp gnus-visual) ; It's a list, so we check it. - (or (memq type gnus-visual) - (memq class gnus-visual)) - t)))) - -(defcustom gnus-mouse-face - (condition-case () - (if (gnus-visual-p 'mouse-face 'highlight) - (if (boundp 'gnus-mouse-face) - (or gnus-mouse-face 'highlight) - 'highlight) - 'default) - (error 'highlight)) - "*Face used for group or summary buffer mouse highlighting. -The line beneath the mouse pointer will be highlighted with this -face." - :group 'gnus-visual - :type 'face) - -(defcustom gnus-article-save-directory gnus-directory - "*Name of the directory articles will be saved in (default \"~/News\")." - :group 'gnus-article-saving - :type 'directory) - -(defvar gnus-plugged t - "Whether Gnus is plugged or not.") - -(defcustom gnus-agent-cache t - "Controls use of the agent cache while plugged. -When set, Gnus will prefer using the locally stored content rather -than re-fetching it from the server. You also need to enable -`gnus-agent' for this to have any affect." - :version "22.1" - :group 'gnus-agent - :type 'boolean) - -(defcustom gnus-default-charset 'undecided - "Default charset assumed to be used when viewing non-ASCII characters. -This variable is overridden on a group-to-group basis by the -`gnus-group-charset-alist' variable and is only used on groups not -covered by that variable." - :type 'symbol - :group 'gnus-charset) - -;; Fixme: Doc reference to agent. -(defcustom gnus-agent t - "Whether we want to use the Gnus agent or not. - -You may customize gnus-agent to disable its use. However, some -back ends have started to use the agent as a client-side cache. -Disabling the agent may result in noticeable loss of performance." - :version "22.1" - :group 'gnus-agent - :type 'boolean) - -(defcustom gnus-other-frame-function 'gnus - "Function called by the command `gnus-other-frame'." - :group 'gnus-start - :type '(choice (function-item gnus) - (function-item gnus-no-server) - (function-item gnus-slave) - (function-item gnus-slave-no-server))) - -(defcustom gnus-other-frame-parameters nil - "Frame parameters used by `gnus-other-frame' to create a Gnus frame. -This should be an alist for Emacs, or a plist for XEmacs." - :group 'gnus-start - :type (if (featurep 'xemacs) - '(repeat (list :inline t :format "%v" - (symbol :tag "Property") - (sexp :tag "Value"))) - '(repeat (cons :format "%v" - (symbol :tag "Parameter") - (sexp :tag "Value"))))) - -(defcustom gnus-user-agent '(emacs gnus type) - "Which information should be exposed in the User-Agent header. - -Can be a list of symbols or a string. Valid symbols are `gnus' -\(show Gnus version\) and `emacs' \(show Emacs version\). In -addition to the Emacs version, you can add `codename' \(show -\(S\)XEmacs codename\) or either `config' \(show system -configuration\) or `type' \(show system type\). If you set it to -a string, be sure to use a valid format, see RFC 2616." - - :version "22.1" - :group 'gnus-message - :type '(choice (list (set :inline t - (const gnus :tag "Gnus version") - (const emacs :tag "Emacs version") - (choice :tag "system" - (const type :tag "system type") - (const config :tag "system configuration")) - (const codename :tag "Emacs codename"))) - (string))) - -;; Convert old (No Gnus < 2005-01-10, v5-10 < 2005-09-05) symbol type values: -(when (symbolp gnus-user-agent) - (setq gnus-user-agent - (cond ((eq gnus-user-agent 'emacs-gnus-config) - '(emacs gnus config)) - ((eq gnus-user-agent 'emacs-gnus-type) - '(emacs gnus type)) - ((eq gnus-user-agent 'emacs-gnus) - '(emacs gnus)) - ((eq gnus-user-agent 'gnus) - '(gnus)) - (t gnus-user-agent))) - (gnus-message 1 "Converted `gnus-user-agent' to `%s'." gnus-user-agent) - (sit-for 1) - (if (get 'gnus-user-agent 'saved-value) - (customize-save-variable 'gnus-user-agent gnus-user-agent) - (gnus-message 1 "Edit your init file to make this change permanent.") - (sit-for 2))) - - -;;; Internal variables - -(defvar gnus-agent-gcc-header "X-Gnus-Agent-Gcc") -(defvar gnus-agent-meta-information-header "X-Gnus-Agent-Meta-Information") -(defvar gnus-agent-method-p-cache nil - ; Reset each time gnus-agent-covered-methods is changed else - ; gnus-agent-method-p may mis-report a methods status. - ) -(defvar gnus-agent-target-move-group-header "X-Gnus-Agent-Move-To") -(defvar gnus-draft-meta-information-header "X-Draft-From") -(defvar gnus-group-get-parameter-function 'gnus-group-get-parameter) -(defvar gnus-original-article-buffer " *Original Article*") -(defvar gnus-newsgroup-name nil) -(defvar gnus-ephemeral-servers nil) -(defvar gnus-server-method-cache nil) - -(defvar gnus-agent-fetching nil - "Whether Gnus agent is in fetching mode.") - -(defvar gnus-agent-covered-methods nil - "A list of servers, NOT methods, showing which servers are covered by the agent.") - -(defvar gnus-command-method nil - "Dynamically bound variable that says what the current back end is.") - -(defvar gnus-current-select-method nil - "The current method for selecting a newsgroup.") - -(defvar gnus-tree-buffer "*Tree*" - "Buffer where Gnus thread trees are displayed.") - -;; Dummy variable. -(defvar gnus-use-generic-from nil) - -;; Variable holding the user answers to all method prompts. -(defvar gnus-method-history nil) - -;; Variable holding the user answers to all mail method prompts. -(defvar gnus-mail-method-history nil) - -;; Variable holding the user answers to all group prompts. -(defvar gnus-group-history nil) - -(defvar gnus-server-alist nil - "List of available servers.") - -(defcustom gnus-cache-directory - (nnheader-concat gnus-directory "cache/") - "*The directory where cached articles will be stored." - :group 'gnus-cache - :type 'directory) - -(defvar gnus-predefined-server-alist - `(("cache" - nnspool "cache" - (nnspool-spool-directory ,gnus-cache-directory) - (nnspool-nov-directory ,gnus-cache-directory) - (nnspool-active-file - ,(nnheader-concat gnus-cache-directory "active")))) - "List of predefined (convenience) servers.") - -(defvar gnus-topic-indentation "") ;; Obsolete variable. - -(defconst gnus-article-mark-lists - '((marked . tick) (replied . reply) - (expirable . expire) (killed . killed) - (bookmarks . bookmark) (dormant . dormant) - (scored . score) (saved . save) - (cached . cache) (downloadable . download) - (unsendable . unsend) (forwarded . forward) - (recent . recent) (seen . seen))) - -(defconst gnus-article-special-mark-lists - '((seen range) - (killed range) - (bookmark tuple) - (score tuple))) - -;; Propagate flags to server, with the following exceptions: -;; `seen' is private to each gnus installation -;; `cache' is a internal gnus flag for each gnus installation -;; `download' is a agent flag private to each gnus installation -;; `unsend' are for nndraft groups only -;; `score' is not a proper mark -;; `bookmark': don't propagated it, or fix the bug in update-mark. -(defconst gnus-article-unpropagated-mark-lists - '(seen cache download unsend score bookmark) - "Marks that shouldn't be propagated to back ends. -Typical marks are those that make no sense in a standalone back end, -such as a mark that says whether an article is stored in the cache -\(which doesn't make sense in a standalone back end).") - -(defvar gnus-headers-retrieved-by nil) -(defvar gnus-article-reply nil) -(defvar gnus-override-method nil) -(defvar gnus-article-check-size nil) -(defvar gnus-opened-servers nil) - -(defvar gnus-current-kill-article nil) - -(defvar gnus-have-read-active-file nil) - -(defconst gnus-maintainer - "bugs@gnus.org (The Gnus Bugfixing Girls + Boys)" - "The mail address of the Gnus maintainers.") - -(defvar gnus-info-nodes - '((gnus-group-mode "(gnus)Group Buffer") - (gnus-summary-mode "(gnus)Summary Buffer") - (gnus-article-mode "(gnus)Article Buffer") - (gnus-server-mode "(gnus)Server Buffer") - (gnus-browse-mode "(gnus)Browse Foreign Server") - (gnus-tree-mode "(gnus)Tree Display")) - "Alist of major modes and related Info nodes.") - -(defvar gnus-group-buffer "*Group*") -(defvar gnus-summary-buffer "*Summary*") -(defvar gnus-article-buffer "*Article*") -(defvar gnus-server-buffer "*Server*") - -(defvar gnus-slave nil - "Whether this Gnus is a slave or not.") - -(defvar gnus-batch-mode nil - "Whether this Gnus is running in batch mode or not.") - -(defvar gnus-variable-list - '(gnus-newsrc-options gnus-newsrc-options-n - gnus-newsrc-last-checked-date - gnus-newsrc-alist gnus-server-alist - gnus-killed-list gnus-zombie-list - gnus-topic-topology gnus-topic-alist - gnus-format-specs) - "Gnus variables saved in the quick startup file.") - -(defvar gnus-newsrc-alist nil - "Assoc list of read articles. -`gnus-newsrc-hashtb' should be kept so that both hold the same information.") - -(defvar gnus-registry-alist nil - "Assoc list of registry data. -gnus-registry.el will populate this if it's loaded.") - -(defvar gnus-newsrc-hashtb nil - "Hashtable of `gnus-newsrc-alist'.") - -(defvar gnus-killed-list nil - "List of killed newsgroups.") - -(defvar gnus-killed-hashtb nil - "Hash table equivalent of `gnus-killed-list'.") - -(defvar gnus-zombie-list nil - "List of almost dead newsgroups.") - -(defvar gnus-description-hashtb nil - "Descriptions of newsgroups.") - -(defvar gnus-list-of-killed-groups nil - "List of newsgroups that have recently been killed by the user.") - -(defvar gnus-active-hashtb nil - "Hashtable of active articles.") - -(defvar gnus-moderated-hashtb nil - "Hashtable of moderated newsgroups.") - -;; Save window configuration. -(defvar gnus-prev-winconf nil) - -(defvar gnus-reffed-article-number nil) - -;;; Let the byte-compiler know that we know about this variable. -(defvar rmail-default-rmail-file) - -(defvar gnus-dead-summary nil) - -(defvar gnus-invalid-group-regexp "[: `'\"/]\\|^$" - "Regexp matching invalid groups.") - -(defvar gnus-other-frame-object nil - "A frame object which will be created by `gnus-other-frame'.") - -;;; End of variables. - -;; Define some autoload functions Gnus might use. -(eval-and-compile - - ;; This little mapcar goes through the list below and marks the - ;; symbols in question as autoloaded functions. - (mapcar - (lambda (package) - (let ((interactive (nth 1 (memq ':interactive package)))) - (mapcar - (lambda (function) - (let (keymap) - (when (consp function) - (setq keymap (car (memq 'keymap function))) - (setq function (car function))) - (unless (fboundp function) - (autoload function (car package) nil interactive keymap)))) - (if (eq (nth 1 package) ':interactive) - (nthcdr 3 package) - (cdr package))))) - '(("info" :interactive t Info-goto-node) - ("pp" pp-to-string) - ("qp" quoted-printable-decode-region quoted-printable-decode-string) - ("ps-print" ps-print-preprint) - ("message" :interactive t - message-send-and-exit message-yank-original) - ("babel" babel-as-string) - ("nnmail" nnmail-split-fancy nnmail-article-group) - ("nnvirtual" nnvirtual-catchup-group nnvirtual-convert-headers) - ("rmailout" rmail-output rmail-output-to-rmail-file) - ("rmail" rmail-insert-rmail-file-header rmail-count-new-messages - rmail-show-message rmail-summary-exists - rmail-select-summary rmail-update-summary) - ("gnus-audio" :interactive t gnus-audio-play) - ("gnus-xmas" gnus-xmas-splash) - ("gnus-soup" :interactive t - gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article - gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet) - ("nnsoup" nnsoup-pack-replies) - ("score-mode" :interactive t gnus-score-mode) - ("gnus-mh" gnus-summary-save-article-folder - gnus-Folder-save-name gnus-folder-save-name) - ("gnus-mh" :interactive t gnus-summary-save-in-folder) - ("gnus-demon" gnus-demon-add-nocem gnus-demon-add-scanmail - gnus-demon-add-rescan gnus-demon-add-scan-timestamps - gnus-demon-add-disconnection gnus-demon-add-handler - gnus-demon-remove-handler) - ("gnus-demon" :interactive t - gnus-demon-init gnus-demon-cancel) - ("gnus-fun" gnus-convert-gray-x-face-to-xpm gnus-display-x-face-in-from - gnus-convert-image-to-gray-x-face gnus-convert-face-to-png - gnus-face-from-file) - ("gnus-salt" gnus-highlight-selected-tree gnus-possibly-generate-tree - gnus-tree-open gnus-tree-close gnus-carpal-setup-buffer) - ("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close - gnus-nocem-unwanted-article-p) - ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info - gnus-server-server-name) - ("gnus-srvr" gnus-browse-foreign-server) - ("gnus-cite" :interactive t - gnus-article-highlight-citation gnus-article-hide-citation-maybe - gnus-article-hide-citation gnus-article-fill-cited-article - gnus-article-hide-citation-in-followups) - ("gnus-kill" gnus-kill gnus-apply-kill-file-internal - gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author - gnus-execute gnus-expunge gnus-batch-kill gnus-batch-score) - ("gnus-cache" gnus-cache-possibly-enter-article gnus-cache-save-buffers - gnus-cache-possibly-remove-articles gnus-cache-request-article - gnus-cache-retrieve-headers gnus-cache-possibly-alter-active - gnus-cache-enter-remove-article gnus-cached-article-p - gnus-cache-open gnus-cache-close gnus-cache-update-article - gnus-cache-articles-in-group) - ("gnus-cache" :interactive t gnus-jog-cache gnus-cache-enter-article - gnus-cache-remove-article gnus-summary-insert-cached-articles) - ("gnus-score" :interactive t - gnus-summary-increase-score gnus-summary-set-score - gnus-summary-raise-thread gnus-summary-raise-same-subject - gnus-summary-raise-score gnus-summary-raise-same-subject-and-select - gnus-summary-lower-thread gnus-summary-lower-same-subject - gnus-summary-lower-score gnus-summary-lower-same-subject-and-select - gnus-summary-current-score gnus-score-delta-default - gnus-score-flush-cache gnus-score-close - gnus-possibly-score-headers gnus-score-followup-article - gnus-score-followup-thread) - ("gnus-score" - (gnus-summary-score-map keymap) gnus-score-save gnus-score-headers - gnus-current-score-file-nondirectory gnus-score-adaptive - gnus-score-find-trace gnus-score-file-name) - ("gnus-cus" :interactive t gnus-group-customize gnus-score-customize) - ("gnus-topic" :interactive t gnus-topic-mode) - ("gnus-topic" gnus-topic-remove-group gnus-topic-set-parameters - gnus-subscribe-topics) - ("gnus-salt" :interactive t gnus-pick-mode gnus-binary-mode) - ("gnus-uu" (gnus-uu-extract-map keymap) (gnus-uu-mark-map keymap)) - ("gnus-uu" :interactive t - gnus-uu-digest-mail-forward gnus-uu-digest-post-forward - gnus-uu-mark-series gnus-uu-mark-region gnus-uu-mark-buffer - gnus-uu-mark-by-regexp gnus-uu-mark-all - gnus-uu-mark-sparse gnus-uu-mark-thread gnus-uu-decode-uu - gnus-uu-decode-uu-and-save gnus-uu-decode-unshar - gnus-uu-decode-unshar-and-save gnus-uu-decode-save - gnus-uu-decode-binhex gnus-uu-decode-uu-view - gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view - gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view - gnus-uu-decode-binhex-view gnus-uu-unmark-thread - gnus-uu-mark-over gnus-uu-post-news) - ("gnus-uu" gnus-uu-delete-work-dir gnus-uu-unmark-thread) - ("gnus-msg" (gnus-summary-send-map keymap) - gnus-article-mail gnus-copy-article-buffer gnus-extended-version) - ("gnus-msg" :interactive t - gnus-group-post-news gnus-group-mail gnus-group-news - gnus-summary-post-news gnus-summary-news-other-window - gnus-summary-followup gnus-summary-followup-with-original - gnus-summary-cancel-article gnus-summary-supersede-article - gnus-post-news gnus-summary-reply gnus-summary-reply-with-original - gnus-summary-mail-forward gnus-summary-mail-other-window - gnus-summary-resend-message gnus-summary-resend-bounced-mail - gnus-summary-wide-reply gnus-summary-followup-to-mail - gnus-summary-followup-to-mail-with-original gnus-bug - gnus-summary-wide-reply-with-original - gnus-summary-post-forward gnus-summary-wide-reply-with-original - gnus-summary-post-forward) - ("gnus-picon" :interactive t gnus-treat-from-picon) - ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p - gnus-grouplens-mode) - ("smiley" :interactive t smiley-region) - ("gnus-win" gnus-configure-windows gnus-add-configuration) - ("gnus-sum" gnus-summary-insert-line gnus-summary-read-group - gnus-list-of-unread-articles gnus-list-of-read-articles - gnus-offer-save-summaries gnus-make-thread-indent-array - gnus-summary-exit gnus-update-read-articles gnus-summary-last-subject - gnus-summary-skip-intangible gnus-summary-article-number - gnus-data-header gnus-data-find) - ("gnus-group" gnus-group-insert-group-line gnus-group-quit - gnus-group-list-groups gnus-group-first-unread-group - gnus-group-set-mode-line gnus-group-set-info gnus-group-save-newsrc - gnus-group-setup-buffer gnus-group-get-new-news - gnus-group-make-help-group gnus-group-update-group - gnus-group-iterate gnus-group-group-name) - ("gnus-bcklg" gnus-backlog-request-article gnus-backlog-enter-article - gnus-backlog-remove-article) - ("gnus-art" gnus-article-read-summary-keys gnus-article-save - gnus-article-prepare gnus-article-set-window-start - gnus-article-next-page gnus-article-prev-page - gnus-request-article-this-buffer gnus-article-mode - gnus-article-setup-buffer gnus-narrow-to-page - gnus-article-delete-invisible-text gnus-treat-article) - ("gnus-art" :interactive t - gnus-article-hide-headers gnus-article-hide-boring-headers - gnus-article-treat-overstrike - gnus-article-remove-cr gnus-article-remove-trailing-blank-lines - gnus-article-display-x-face gnus-article-de-quoted-unreadable - gnus-article-de-base64-unreadable - gnus-article-decode-HZ - gnus-article-wash-html - gnus-article-unsplit-urls - gnus-article-hide-pem gnus-article-hide-signature - gnus-article-strip-leading-blank-lines gnus-article-date-local - gnus-article-date-original gnus-article-date-lapsed -;; gnus-article-show-all-headers - gnus-article-edit-mode gnus-article-edit-article - gnus-article-edit-done gnus-article-decode-encoded-words - gnus-start-date-timer gnus-stop-date-timer - gnus-mime-view-all-parts) - ("gnus-int" gnus-request-type) - ("gnus-start" gnus-newsrc-parse-options gnus-1 gnus-no-server-1 - gnus-dribble-enter gnus-read-init-file gnus-dribble-touch) - ("gnus-dup" gnus-dup-suppress-articles gnus-dup-unsuppress-article - gnus-dup-enter-articles) - ("gnus-range" gnus-copy-sequence) - ("gnus-eform" gnus-edit-form) - ("gnus-move" :interactive t - gnus-group-move-group-to-server gnus-change-server) - ("gnus-logic" gnus-score-advanced) - ("gnus-undo" gnus-undo-mode gnus-undo-register) - ("gnus-async" gnus-async-request-fetched-article gnus-async-prefetch-next - gnus-async-prefetch-article gnus-async-prefetch-remove-group - gnus-async-halt-prefetch) - ("gnus-agent" gnus-open-agent gnus-agent-get-function - gnus-agent-save-active gnus-agent-method-p - gnus-agent-get-undownloaded-list gnus-agent-fetch-session - gnus-summary-set-agent-mark gnus-agent-save-group-info - gnus-agent-request-article gnus-agent-retrieve-headers) - ("gnus-agent" :interactive t - gnus-unplugged gnus-agentize gnus-agent-batch) - ("gnus-vm" :interactive t gnus-summary-save-in-vm - gnus-summary-save-article-vm) - ("compface" uncompface) - ("gnus-draft" :interactive t gnus-draft-mode gnus-group-send-queue) - ("gnus-mlspl" gnus-group-split gnus-group-split-fancy) - ("gnus-mlspl" :interactive t gnus-group-split-setup - gnus-group-split-update) - ("gnus-delay" gnus-delay-initialize)))) - -;;; gnus-sum.el thingies - - -(defcustom gnus-summary-line-format "%U%R%z%I%(%[%4L: %-23,23f%]%) %s\n" - "*The format specification of the lines in the summary buffer. - -It works along the same lines as a normal formatting string, -with some simple extensions. - -%N Article number, left padded with spaces (string) -%S Subject (string) -%s Subject if it is at the root of a thread, and \"\" otherwise (string) -%n Name of the poster (string) -%a Extracted name of the poster (string) -%A Extracted address of the poster (string) -%F Contents of the From: header (string) -%f Contents of the From: or To: headers (string) -%x Contents of the Xref: header (string) -%D Date of the article (string) -%d Date of the article (string) in DD-MMM format -%o Date of the article (string) in YYYYMMDD`T'HHMMSS format -%M Message-id of the article (string) -%r References of the article (string) -%c Number of characters in the article (integer) -%k Pretty-printed version of the above (string) - For example, \"1.2k\" or \"0.4M\". -%L Number of lines in the article (integer) -%I Indentation based on thread level (a string of spaces) -%B A complex trn-style thread tree (string) - The variables `gnus-sum-thread-*' can be used for customization. -%T A string with two possible values: 80 spaces if the article - is on thread level two or larger and 0 spaces on level one -%R \"A\" if this article has been replied to, \" \" otherwise (character) -%U Status of this article (character, \"R\", \"K\", \"-\" or \" \") -%[ Opening bracket (character, \"[\" or \"<\") -%] Closing bracket (character, \"]\" or \">\") -%> Spaces of length thread-level (string) -%< Spaces of length (- 20 thread-level) (string) -%i Article score (number) -%z Article zcore (character) -%t Number of articles under the current thread (number). -%e Whether the thread is empty or not (character). -%l GroupLens score (string). -%V Total thread score (number). -%P The line number (number). -%O Download mark (character). -%* If present, indicates desired cursor position - (instead of after first colon). -%u User defined specifier. The next character in the format string should - be a letter. Gnus will call the function gnus-user-format-function-X, - where X is the letter following %u. The function will be passed the - current header as argument. The function should return a string, which - will be inserted into the summary just like information from any other - summary specifier. - -The %U (status), %R (replied) and %z (zcore) specs have to be handled -with care. For reasons of efficiency, Gnus will compute what column -these characters will end up in, and \"hard-code\" that. This means that -it is invalid to have these specs after a variable-length spec. Well, -you might not be arrested, but your summary buffer will look strange, -which is bad enough. - -The smart choice is to have these specs as far to the left as -possible. - -This restriction may disappear in later versions of Gnus. - -General format specifiers can also be used. -See Info node `(gnus)Formatting Variables'." - :link '(custom-manual "(gnus)Formatting Variables") - :type 'string - :group 'gnus-summary-format) - -;;; -;;; Skeleton keymaps -;;; - -(defun gnus-suppress-keymap (keymap) - (suppress-keymap keymap) - (let ((keys `([backspace] [delete] "\177" "\M-u"))) ;gnus-mouse-2 - (while keys - (define-key keymap (pop keys) 'undefined)))) - -(defvar gnus-article-mode-map - (let ((keymap (make-sparse-keymap))) - (gnus-suppress-keymap keymap) - keymap)) -(defvar gnus-summary-mode-map - (let ((keymap (make-keymap))) - (gnus-suppress-keymap keymap) - keymap)) -(defvar gnus-group-mode-map - (let ((keymap (make-keymap))) - (gnus-suppress-keymap keymap) - keymap)) - - - -;; Fix by Hallvard B Furuseth . -;; If you want the cursor to go somewhere else, set these two -;; functions in some startup hook to whatever you want. -(defalias 'gnus-summary-position-point 'gnus-goto-colon) -(defalias 'gnus-group-position-point 'gnus-goto-colon) - -;;; Various macros and substs. - -(defun gnus-header-from (header) - (mail-header-from header)) - -(defmacro gnus-gethash (string hashtable) - "Get hash value of STRING in HASHTABLE." - `(symbol-value (intern-soft ,string ,hashtable))) - -(defmacro gnus-gethash-safe (string hashtable) - "Get hash value of STRING in HASHTABLE. -Return nil if not defined." - `(let ((sym (intern-soft ,string ,hashtable))) - (and (boundp sym) (symbol-value sym)))) - -(defmacro gnus-sethash (string value hashtable) - "Set hash value. Arguments are STRING, VALUE, and HASHTABLE." - `(set (intern ,string ,hashtable) ,value)) -(put 'gnus-sethash 'edebug-form-spec '(form form form)) - -(defmacro gnus-group-unread (group) - "Get the currently computed number of unread articles in GROUP." - `(car (gnus-gethash ,group gnus-newsrc-hashtb))) - -(defmacro gnus-group-entry (group) - "Get the newsrc entry for GROUP." - `(gnus-gethash ,group gnus-newsrc-hashtb)) - -(defmacro gnus-active (group) - "Get active info on GROUP." - `(gnus-gethash ,group gnus-active-hashtb)) - -(defmacro gnus-set-active (group active) - "Set GROUP's active info." - `(gnus-sethash ,group ,active gnus-active-hashtb)) - -;; Info access macros. - -(defmacro gnus-info-group (info) - `(nth 0 ,info)) -(defmacro gnus-info-rank (info) - `(nth 1 ,info)) -(defmacro gnus-info-read (info) - `(nth 2 ,info)) -(defmacro gnus-info-marks (info) - `(nth 3 ,info)) -(defmacro gnus-info-method (info) - `(nth 4 ,info)) -(defmacro gnus-info-params (info) - `(nth 5 ,info)) - -(defmacro gnus-info-level (info) - `(let ((rank (gnus-info-rank ,info))) - (if (consp rank) - (car rank) - rank))) -(defmacro gnus-info-score (info) - `(let ((rank (gnus-info-rank ,info))) - (or (and (consp rank) (cdr rank)) 0))) - -(defmacro gnus-info-set-group (info group) - `(setcar ,info ,group)) -(defmacro gnus-info-set-rank (info rank) - `(setcar (nthcdr 1 ,info) ,rank)) -(defmacro gnus-info-set-read (info read) - `(setcar (nthcdr 2 ,info) ,read)) -(defmacro gnus-info-set-marks (info marks &optional extend) - (if extend - `(gnus-info-set-entry ,info ,marks 3) - `(setcar (nthcdr 3 ,info) ,marks))) -(defmacro gnus-info-set-method (info method &optional extend) - (if extend - `(gnus-info-set-entry ,info ,method 4) - `(setcar (nthcdr 4 ,info) ,method))) -(defmacro gnus-info-set-params (info params &optional extend) - (if extend - `(gnus-info-set-entry ,info ,params 5) - `(setcar (nthcdr 5 ,info) ,params))) - -(defun gnus-info-set-entry (info entry number) - ;; Extend the info until we have enough elements. - (while (<= (length info) number) - (nconc info (list nil))) - ;; Set the entry. - (setcar (nthcdr number info) entry)) - -(defmacro gnus-info-set-level (info level) - `(let ((rank (cdr ,info))) - (if (consp (car rank)) - (setcar (car rank) ,level) - (setcar rank ,level)))) -(defmacro gnus-info-set-score (info score) - `(let ((rank (cdr ,info))) - (if (consp (car rank)) - (setcdr (car rank) ,score) - (setcar rank (cons (car rank) ,score))))) - -(defmacro gnus-get-info (group) - `(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb))) - -;;; Load the compatibility functions. - -(require 'gnus-ems) - - -;;; -;;; Shutdown -;;; - -(defvar gnus-shutdown-alist nil) - -(defun gnus-add-shutdown (function &rest symbols) - "Run FUNCTION whenever one of SYMBOLS is shut down." - (push (cons function symbols) gnus-shutdown-alist)) - -(defun gnus-shutdown (symbol) - "Shut down everything that waits for SYMBOL." - (let ((alist gnus-shutdown-alist) - entry) - (while (setq entry (pop alist)) - (when (memq symbol (cdr entry)) - (funcall (car entry)))))) - - -;;; -;;; Gnus Utility Functions -;;; - -(defun gnus-find-subscribed-addresses () - "Return a regexp matching the addresses of all subscribed mail groups. -It consists of the `to-address' or `to-list' parameter of all groups -with a `subscribed' parameter." - (let (group address addresses) - (dolist (entry (cdr gnus-newsrc-alist)) - (setq group (car entry)) - (when (gnus-parameter-subscribed group) - (setq address (mail-strip-quoted-names - (or (gnus-group-fast-parameter group 'to-address) - (gnus-group-fast-parameter group 'to-list)))) - (when address - (add-to-list 'addresses address)))) - (when addresses - (list (mapconcat 'regexp-quote addresses "\\|"))))) - -(defmacro gnus-string-or (&rest strings) - "Return the first element of STRINGS that is a non-blank string. -STRINGS will be evaluated in normal `or' order." - `(gnus-string-or-1 ',strings)) - -(defun gnus-string-or-1 (strings) - (let (string) - (while strings - (setq string (eval (pop strings))) - (if (string-match "^[ \t]*$" string) - (setq string nil) - (setq strings nil))) - string)) - -(defun gnus-version (&optional arg) - "Version number of this version of Gnus. -If ARG, insert string at point." - (interactive "P") - (if arg - (insert (message gnus-version)) - (message gnus-version))) - -(defun gnus-continuum-version (&optional version) - "Return VERSION as a floating point number." - (interactive) - (unless version - (setq version gnus-version)) - (when (or (string-match "^\\([^ ]+\\)? ?Gnus v?\\([0-9.]+\\)$" version) - (string-match "^\\(.?\\)gnus-\\([0-9.]+\\)$" version)) - (let ((alpha (and (match-beginning 1) (match-string 1 version))) - (number (match-string 2 version)) - major minor least) - (unless (string-match - "\\([0-9]\\)\\.\\([0-9]+\\)\\.?\\([0-9]+\\)?" number) - (error "Invalid version string: %s" version)) - (setq major (string-to-number (match-string 1 number)) - minor (string-to-number (match-string 2 number)) - least (if (match-beginning 3) - (string-to-number (match-string 3 number)) - 0)) - (string-to-number - (if (zerop major) - (format "%s00%02d%02d" - (if (member alpha '("(ding)" "d")) - "4.99" - (+ 5 (* 0.02 - (abs - (- (mm-char-int (aref (downcase alpha) 0)) - (mm-char-int ?t)))) - -0.01)) - minor least) - (format "%d.%02d%02d" major minor least)))))) - -(defun gnus-info-find-node (&optional nodename) - "Find Info documentation of Gnus." - (interactive) - ;; Enlarge info window if needed. - (let (gnus-info-buffer) - (Info-goto-node (or nodename (cadr (assq major-mode gnus-info-nodes)))) - (setq gnus-info-buffer (current-buffer)) - (gnus-configure-windows 'info))) - -;;; -;;; gnus-interactive -;;; - -(defvar gnus-current-prefix-symbol nil - "Current prefix symbol.") - -(defvar gnus-current-prefix-symbols nil - "List of current prefix symbols.") - -(defun gnus-interactive (string &optional params) - "Return a list that can be fed to `interactive'. -See `interactive' for full documentation. - -Adds the following specs: - -y -- The current symbolic prefix. -Y -- A list of the current symbolic prefix(es). -A -- Article number. -H -- Article header. -g -- Group name." - (let ((i 0) - out c prompt) - (while (< i (length string)) - (string-match ".\\([^\n]*\\)\n?" string i) - (setq c (aref string i)) - (when (match-end 1) - (setq prompt (match-string 1 string))) - (setq i (match-end 0)) - ;; We basically emulate just about everything that - ;; `interactive' does, but add the specs listed above. - (push - (cond - ((= c ?a) - (completing-read prompt obarray 'fboundp t)) - ((= c ?b) - (read-buffer prompt (current-buffer) t)) - ((= c ?B) - (read-buffer prompt (other-buffer (current-buffer)))) - ((= c ?c) - (read-char)) - ((= c ?C) - (completing-read prompt obarray 'commandp t)) - ((= c ?d) - (point)) - ((= c ?D) - (read-file-name prompt nil default-directory 'lambda)) - ((= c ?f) - (read-file-name prompt nil nil 'lambda)) - ((= c ?F) - (read-file-name prompt)) - ((= c ?k) - (read-key-sequence prompt)) - ((= c ?K) - (error "Not implemented spec")) - ((= c ?e) - (error "Not implemented spec")) - ((= c ?m) - (mark)) - ((= c ?N) - (error "Not implemented spec")) - ((= c ?n) - (string-to-number (read-from-minibuffer prompt))) - ((= c ?p) - (prefix-numeric-value current-prefix-arg)) - ((= c ?P) - current-prefix-arg) - ((= c ?r) - 'gnus-prefix-nil) - ((= c ?s) - (read-string prompt)) - ((= c ?S) - (intern (read-string prompt))) - ((= c ?v) - (read-variable prompt)) - ((= c ?x) - (read-minibuffer prompt)) - ((= c ?x) - (eval-minibuffer prompt)) - ;; And here the new specs come. - ((= c ?y) - gnus-current-prefix-symbol) - ((= c ?Y) - gnus-current-prefix-symbols) - ((= c ?g) - (gnus-group-group-name)) - ((= c ?A) - (gnus-summary-skip-intangible) - (or (get-text-property (point) 'gnus-number) - (gnus-summary-last-subject))) - ((= c ?H) - (gnus-data-header (gnus-data-find (gnus-summary-article-number)))) - (t - (error "Non-implemented spec"))) - out) - (cond - ((= c ?r) - (push (if (< (point) (mark)) (point) (mark)) out) - (push (if (> (point) (mark)) (point) (mark)) out)))) - (setq out (delq 'gnus-prefix-nil out)) - (nreverse out))) - -(defun gnus-symbolic-argument (&optional arg) - "Read a symbolic argument and a command, and then execute command." - (interactive "P") - (let* ((in-command (this-command-keys)) - (command in-command) - gnus-current-prefix-symbols - gnus-current-prefix-symbol - syms) - (while (equal in-command command) - (message "%s-" (key-description (this-command-keys))) - (push (intern (char-to-string (read-char))) syms) - (setq command (read-key-sequence nil t))) - (setq gnus-current-prefix-symbols (nreverse syms) - gnus-current-prefix-symbol (car gnus-current-prefix-symbols)) - (call-interactively (key-binding command t)))) - -;;; More various functions. - -(defsubst gnus-check-backend-function (func group) - "Check whether GROUP supports function FUNC. -GROUP can either be a string (a group name) or a select method." - (ignore-errors - (let ((method (if (stringp group) - (car (gnus-find-method-for-group group)) - group))) - (unless (featurep method) - (require method)) - (fboundp (intern (format "%s-%s" method func)))))) - -(defun gnus-group-read-only-p (&optional group) - "Check whether GROUP supports editing or not. -If GROUP is nil, `gnus-newsgroup-name' will be checked instead. Note -that that variable is buffer-local to the summary buffers." - (let ((group (or group gnus-newsgroup-name))) - (not (gnus-check-backend-function 'request-replace-article group)))) - -(defun gnus-virtual-group-p (group) - "Say whether GROUP is virtual or not." - (memq 'virtual (assoc (symbol-name (car (gnus-find-method-for-group group))) - gnus-valid-select-methods))) - -(defun gnus-news-group-p (group &optional article) - "Return non-nil if GROUP (and ARTICLE) come from a news server." - (cond ((gnus-member-of-valid 'post group) ;Ordinary news group - t) ;is news of course. - ((not (gnus-member-of-valid 'post-mail group)) ;Non-combined. - nil) ;must be mail then. - ((vectorp article) ;Has header info. - (eq (gnus-request-type group (mail-header-id article)) 'news)) - ((null article) ;Hasn't header info - (eq (gnus-request-type group) 'news)) ;(unknown ==> mail) - ((< article 0) ;Virtual message - nil) ;we don't know, guess mail. - (t ;Has positive number - (eq (gnus-request-type group article) 'news)))) ;use it. - -;; Returns a list of writable groups. -(defun gnus-writable-groups () - (let ((alist gnus-newsrc-alist) - groups group) - (while (setq group (car (pop alist))) - (unless (gnus-group-read-only-p group) - (push group groups))) - (nreverse groups))) - -;; Check whether to use long file names. -(defun gnus-use-long-file-name (symbol) - ;; The variable has to be set... - (and gnus-use-long-file-name - ;; If it isn't a list, then we return t. - (or (not (listp gnus-use-long-file-name)) - ;; If it is a list, and the list contains `symbol', we - ;; return nil. - (not (memq symbol gnus-use-long-file-name))))) - -;; Generate a unique new group name. -(defun gnus-generate-new-group-name (leaf) - (let ((name leaf) - (num 0)) - (while (gnus-gethash name gnus-newsrc-hashtb) - (setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">"))) - name)) - -(defun gnus-ephemeral-group-p (group) - "Say whether GROUP is ephemeral or not." - (gnus-group-get-parameter group 'quit-config t)) - -(defun gnus-group-quit-config (group) - "Return the quit-config of GROUP." - (gnus-group-get-parameter group 'quit-config t)) - -(defun gnus-kill-ephemeral-group (group) - "Remove ephemeral GROUP from relevant structures." - (gnus-sethash group nil gnus-newsrc-hashtb)) - -(defun gnus-simplify-mode-line () - "Make mode lines a bit simpler." - (setq mode-line-modified (cdr gnus-mode-line-modified)) - (when (listp mode-line-format) - (make-local-variable 'mode-line-format) - (setq mode-line-format (copy-sequence mode-line-format)) - (when (equal (nth 3 mode-line-format) " ") - (setcar (nthcdr 3 mode-line-format) " ")))) - -;;; Servers and groups. - -(defsubst gnus-server-add-address (method) - (let ((method-name (symbol-name (car method)))) - (if (and (memq 'address (assoc method-name gnus-valid-select-methods)) - (not (assq (intern (concat method-name "-address")) method)) - (memq 'physical-address (assq (car method) - gnus-valid-select-methods))) - (append method (list (list (intern (concat method-name "-address")) - (nth 1 method)))) - method))) - -(defsubst gnus-method-to-server (method) - (catch 'server-name - (setq method (or method gnus-select-method)) - - ;; Perhaps it is already in the cache. - (mapc (lambda (name-method) - (if (equal (cdr name-method) method) - (throw 'server-name (car name-method)))) - gnus-server-method-cache) - - (mapc - (lambda (server-alist) - (mapc (lambda (name-method) - (when (gnus-methods-equal-p (cdr name-method) method) - (unless (member name-method gnus-server-method-cache) - (push name-method gnus-server-method-cache)) - (throw 'server-name (car name-method)))) - server-alist)) - (let ((alists (list gnus-server-alist - gnus-predefined-server-alist))) - (if gnus-select-method - (push (list (cons "native" gnus-select-method)) alists)) - alists)) - - (let* ((name (if (member (cadr method) '(nil "")) - (format "%s" (car method)) - (format "%s:%s" (car method) (cadr method)))) - (name-method (cons name method))) - (unless (member name-method gnus-server-method-cache) - (push name-method gnus-server-method-cache)) - name))) - -(defsubst gnus-server-to-method (server) - "Map virtual server names to select methods." - (or (and server (listp server) server) - (cdr (assoc server gnus-server-method-cache)) - (let ((result - (or - ;; Perhaps this is the native server? - (and (equal server "native") gnus-select-method) - ;; It should be in the server alist. - (cdr (assoc server gnus-server-alist)) - ;; It could be in the predefined server alist. - (cdr (assoc server gnus-predefined-server-alist)) - ;; If not, we look through all the opened server - ;; to see whether we can find it there. - (let ((opened gnus-opened-servers)) - (while (and opened - (not (equal server (format "%s:%s" (caaar opened) - (cadaar opened))))) - (pop opened)) - (caar opened)) - ;; It could be a named method, search all servers - (let ((servers gnus-secondary-select-methods)) - (while (and servers - (not (equal server (format "%s:%s" (caar servers) - (cadar servers))))) - (pop servers)) - (car servers)) - ;; This could be some sort of foreign server that I - ;; simply haven't opened (yet). Do a brute-force scan - ;; of the entire gnus-newsrc-alist for the server name - ;; of every method. As a side-effect, loads the - ;; gnus-server-method-cache so this only happens once, - ;; if at all. - (let ((alist (cdr gnus-newsrc-alist)) - method match) - (while alist - (setq method (gnus-info-method (pop alist))) - (when (and (not (stringp method)) - (equal server (gnus-method-to-server method))) - (setq match method - alist nil))) - match)))) - (when result - (push (cons server result) gnus-server-method-cache)) - result))) - -(defsubst gnus-server-get-method (group method) - ;; Input either a server name, and extended server name, or a - ;; select method, and return a select method. - (cond ((stringp method) - (gnus-server-to-method method)) - ((equal method gnus-select-method) - gnus-select-method) - ((and (stringp (car method)) - group) - (gnus-server-extend-method group method)) - ((and method - (not group) - (equal (cadr method) "")) - method) - (t - (gnus-server-add-address method)))) - -(defmacro gnus-method-equal (ss1 ss2) - "Say whether two servers are equal." - `(let ((s1 ,ss1) - (s2 ,ss2)) - (or (equal s1 s2) - (and (= (length s1) (length s2)) - (progn - (while (and s1 (member (car s1) s2)) - (setq s1 (cdr s1))) - (null s1)))))) - -(defun gnus-methods-equal-p (m1 m2) - (let ((m1 (or m1 gnus-select-method)) - (m2 (or m2 gnus-select-method))) - (or (equal m1 m2) - (and (eq (car m1) (car m2)) - (or (not (memq 'address (assoc (symbol-name (car m1)) - gnus-valid-select-methods))) - (equal (nth 1 m1) (nth 1 m2))))))) - -(defun gnus-server-equal (m1 m2) - "Say whether two methods are equal." - (let ((m1 (cond ((null m1) gnus-select-method) - ((stringp m1) (gnus-server-to-method m1)) - (t m1))) - (m2 (cond ((null m2) gnus-select-method) - ((stringp m2) (gnus-server-to-method m2)) - (t m2)))) - (gnus-method-equal m1 m2))) - -(defun gnus-servers-using-backend (backend) - "Return a list of known servers using BACKEND." - (let ((opened gnus-opened-servers) - out) - (while opened - (when (eq backend (caaar opened)) - (push (caar opened) out)) - (pop opened)) - out)) - -(defun gnus-archive-server-wanted-p () - "Say whether the user wants to use the archive server." - (cond - ((or (not gnus-message-archive-method) - (not gnus-message-archive-group)) - nil) - ((and gnus-message-archive-method gnus-message-archive-group) - t) - (t - (let ((active (cadr (assq 'nnfolder-active-file - gnus-message-archive-method)))) - (and active - (file-exists-p active)))))) - -(defsubst gnus-method-to-server-name (method) - (concat - (format "%s" (car method)) - (when (and - (or (assoc (format "%s" (car method)) - (gnus-methods-using 'address)) - (gnus-server-equal method gnus-message-archive-method)) - (nth 1 method) - (not (string= (nth 1 method) ""))) - (concat "+" (nth 1 method))))) - -(defsubst gnus-method-to-full-server-name (method) - (format "%s+%s" (car method) (nth 1 method))) - -(defun gnus-group-prefixed-name (group method &optional full) - "Return the whole name from GROUP and METHOD. -Call with full set to get the fully qualified group name (even if the -server is native)." - (when (stringp method) - (setq method (gnus-server-to-method method))) - (if (or (not method) - (and (not full) (gnus-server-equal method "native")) - ;;;!!! This might not be right. We'll see... - ;(string-match ":" group) - ) - group - (concat (gnus-method-to-server-name method) ":" group))) - -(defun gnus-group-guess-prefixed-name (group) - "Guess the whole name from GROUP and METHOD." - (gnus-group-prefixed-name group (gnus-find-method-for-group - group))) - -(defun gnus-group-full-name (group method) - "Return the full name from GROUP and METHOD, even if the method is native." - (gnus-group-prefixed-name group method t)) - -(defun gnus-group-guess-full-name (group) - "Guess the full name from GROUP, even if the method is native." - (if (gnus-group-prefixed-p group) - group - (gnus-group-full-name group (gnus-find-method-for-group group)))) - -(defun gnus-group-guess-full-name-from-command-method (group) - "Guess the full name from GROUP, even if the method is native." - (if (gnus-group-prefixed-p group) - group - (gnus-group-full-name group gnus-command-method))) - -(defun gnus-group-real-prefix (group) - "Return the prefix of the current group name." - (if (stringp group) - (if (string-match "^[^:]+:" group) - (substring group 0 (match-end 0)) - "") - nil)) - -(defun gnus-group-short-name (group) - "Return the short group name." - (let ((prefix (gnus-group-real-prefix group))) - (if (< 0 (length prefix)) - (substring group (length prefix) nil) - group))) - -(defun gnus-group-prefixed-p (group) - "Return the prefix of the current group name." - (< 0 (length (gnus-group-real-prefix group)))) - -(defun gnus-summary-buffer-name (group) - "Return the summary buffer name of GROUP." - (concat "*Summary " (gnus-group-decoded-name group) "*")) - -(defun gnus-group-method (group) - "Return the server or method used for selecting GROUP. -You should probably use `gnus-find-method-for-group' instead." - (let ((prefix (gnus-group-real-prefix group))) - (if (equal prefix "") - gnus-select-method - (let ((servers gnus-opened-servers) - (server "") - backend possible found) - (if (string-match "^[^\\+]+\\+" prefix) - (setq backend (intern (substring prefix 0 (1- (match-end 0)))) - server (substring prefix (match-end 0) (1- (length prefix)))) - (setq backend (intern (substring prefix 0 (1- (length prefix)))))) - (while servers - (when (eq (caaar servers) backend) - (setq possible (caar servers)) - (when (equal (cadaar servers) server) - (setq found (caar servers)))) - (pop servers)) - (or (car (rassoc found gnus-server-alist)) - found - (car (rassoc possible gnus-server-alist)) - possible - (list backend server)))))) - -(defsubst gnus-native-method-p (method) - "Return whether METHOD is the native select method." - (gnus-method-equal method gnus-select-method)) - -(defsubst gnus-secondary-method-p (method) - "Return whether METHOD is a secondary select method." - (let ((methods gnus-secondary-select-methods) - (gmethod (inline (gnus-server-get-method nil method)))) - (while (and methods - (not (gnus-method-equal - (inline (gnus-server-get-method nil (car methods))) - gmethod))) - (setq methods (cdr methods))) - methods)) - -(defun gnus-method-simplify (method) - "Return the shortest uniquely identifying string or method for METHOD." - (cond ((stringp method) - method) - ((gnus-native-method-p method) - nil) - ((gnus-secondary-method-p method) - (format "%s:%s" (nth 0 method) (nth 1 method))) - (t - method))) - -(defun gnus-groups-from-server (server) - "Return a list of all groups that are fetched from SERVER." - (let ((alist (cdr gnus-newsrc-alist)) - info groups) - (while (setq info (pop alist)) - (when (gnus-server-equal (gnus-info-method info) server) - (push (gnus-info-group info) groups))) - (sort groups 'string<))) - -(defun gnus-group-foreign-p (group) - "Say whether a group is foreign or not." - (and (not (gnus-group-native-p group)) - (not (gnus-group-secondary-p group)))) - -(defun gnus-group-native-p (group) - "Say whether the group is native or not." - (not (string-match ":" group))) - -(defun gnus-group-secondary-p (group) - "Say whether the group is secondary or not." - (gnus-secondary-method-p (gnus-find-method-for-group group))) - -(defun gnus-parameters-get-parameter (group) - "Return the group parameters for GROUP from `gnus-parameters'." - (let ((case-fold-search (if (eq gnus-parameters-case-fold-search 'default) - case-fold-search - gnus-parameters-case-fold-search)) - params-list) - (dolist (elem gnus-parameters) - (when (string-match (car elem) group) - (setq params-list - (nconc (gnus-expand-group-parameters - (car elem) (cdr elem) group) - params-list)))) - params-list)) - -(defun gnus-expand-group-parameter (match value group) - "Use MATCH to expand VALUE in GROUP." - (with-temp-buffer - (insert group) - (goto-char (point-min)) - (while (re-search-forward match nil t) - (replace-match value)) - (buffer-string))) - -(defun gnus-expand-group-parameters (match parameters group) - "Go through PARAMETERS and expand them according to the match data." - (let (new) - (dolist (elem parameters) - (if (and (stringp (cdr elem)) - (string-match "\\\\[0-9&]" (cdr elem))) - (push (cons (car elem) - (gnus-expand-group-parameter match (cdr elem) group)) - new) - (push elem new))) - new)) - -(defun gnus-group-fast-parameter (group symbol &optional allow-list) - "For GROUP, return the value of SYMBOL. - -You should call this in the `gnus-group-buffer' buffer. -The function `gnus-group-find-parameter' will do that for you." - ;; The speed trick: No cons'ing and quit early. - (let* ((params (funcall gnus-group-get-parameter-function group)) - ;; Start easy, check the "real" group parameters. - (simple-results - (gnus-group-parameter-value params symbol allow-list t))) - (if simple-results - ;; Found results; return them. - (car simple-results) - ;; We didn't found it there, try `gnus-parameters'. - (let ((result nil) - (head nil) - (tail gnus-parameters)) - ;; A good old-fashioned non-cl loop. - (while tail - (setq head (car tail) - tail (cdr tail)) - ;; The car is regexp matching for matching the group name. - (when (string-match (car head) group) - ;; The cdr is the parameters. - (setq result (gnus-group-parameter-value (cdr head) - symbol allow-list)) - (when result - ;; Expand if necessary. - (if (and (stringp result) (string-match "\\\\[0-9&]" result)) - (setq result (gnus-expand-group-parameter (car head) - result group))) - ;; Exit the loop early. - (setq tail nil)))) - ;; Done. - result)))) - -(defun gnus-group-find-parameter (group &optional symbol allow-list) - "Return the group parameters for GROUP. -If SYMBOL, return the value of that symbol in the group parameters. - -If you call this function inside a loop, consider using the faster -`gnus-group-fast-parameter' instead." - (save-excursion - (set-buffer gnus-group-buffer) - (if symbol - (gnus-group-fast-parameter group symbol allow-list) - (nconc - (copy-sequence - (funcall gnus-group-get-parameter-function group)) - (gnus-parameters-get-parameter group))))) - -(defun gnus-group-get-parameter (group &optional symbol allow-list) - "Return the group parameters for GROUP. -If SYMBOL, return the value of that symbol in the group parameters. -If ALLOW-LIST, also allow list as a result. -Most functions should use `gnus-group-find-parameter', which -also examines the topic parameters." - (let ((params (gnus-info-params (gnus-get-info group)))) - (if symbol - (gnus-group-parameter-value params symbol allow-list) - params))) - -(defun gnus-group-parameter-value (params symbol &optional - allow-list present-p) - "Return the value of SYMBOL in group PARAMS. -If ALLOW-LIST, also allow list as a result." - ;; We only wish to return group parameters (dotted lists) and - ;; not local variables, which may have the same names. - ;; But first we handle single elements... - (or (car (memq symbol params)) - ;; Handle alist. - (let (elem) - (catch 'found - (while (setq elem (pop params)) - (when (and (consp elem) - (eq (car elem) symbol) - (or allow-list - (atom (cdr elem)))) - (throw 'found (if present-p (list (cdr elem)) - (cdr elem))))))))) - -(defun gnus-group-add-parameter (group param) - "Add parameter PARAM to GROUP." - (let ((info (gnus-get-info group))) - (when info - (gnus-group-remove-parameter group (if (consp param) (car param) param)) - ;; Cons the new param to the old one and update. - (gnus-group-set-info (cons param (gnus-info-params info)) - group 'params)))) - -(defun gnus-group-set-parameter (group name value) - "Set parameter NAME to VALUE in GROUP." - (let ((info (gnus-get-info group))) - (when info - (gnus-group-remove-parameter group name) - (let ((old-params (gnus-info-params info)) - (new-params (list (cons name value)))) - (while old-params - (when (or (not (listp (car old-params))) - (not (eq (caar old-params) name))) - (setq new-params (append new-params (list (car old-params))))) - (setq old-params (cdr old-params))) - (gnus-group-set-info new-params group 'params))))) - -(defun gnus-group-remove-parameter (group name) - "Remove parameter NAME from GROUP." - (let ((info (gnus-get-info group))) - (when info - (let ((params (gnus-info-params info))) - (when params - (setq params (delq name params)) - (while (assq name params) - (gnus-pull name params)) - (gnus-info-set-params info params)))))) - -(defun gnus-group-add-score (group &optional score) - "Add SCORE to the GROUP score. -If SCORE is nil, add 1 to the score of GROUP." - (let ((info (gnus-get-info group))) - (when info - (gnus-info-set-score info (+ (gnus-info-score info) (or score 1)))))) - -(defun gnus-short-group-name (group &optional levels) - "Collapse GROUP name LEVELS. -Select methods are stripped and any remote host name is stripped down to -just the host name." - (let* ((name "") - (foreign "") - (depth 0) - (skip 1) - (levels (or levels - gnus-group-uncollapsed-levels - (progn - (while (string-match "\\." group skip) - (setq skip (match-end 0) - depth (+ depth 1))) - depth)))) - ;; Separate foreign select method from group name and collapse. - ;; If method contains a server, collapse to non-domain server name, - ;; otherwise collapse to select method. - (let* ((colon (string-match ":" group)) - (server (and colon (substring group 0 colon))) - (plus (and server (string-match "+" server)))) - (when server - (if plus - (setq foreign (substring server (+ 1 plus) - (string-match "\\." server)) - group (substring group (+ 1 colon))) - (setq foreign server - group (substring group (+ 1 colon)))) - (setq foreign (concat foreign ":"))) - ;; Collapse group name leaving LEVELS uncollapsed elements - (let* ((slist (split-string group "/")) - (slen (length slist)) - (dlist (split-string group "\\.")) - (dlen (length dlist)) - glist - glen - gsep - res) - (if (> slen dlen) - (setq glist slist - glen slen - gsep "/") - (setq glist dlist - glen dlen - gsep ".")) - (setq levels (- glen levels)) - (dolist (g glist) - (push (if (>= (decf levels) 0) - (if (zerop (length g)) - "" - (substring g 0 1)) - g) - res)) - (concat foreign (mapconcat 'identity (nreverse res) gsep)))))) - -(defun gnus-narrow-to-body () - "Narrow to the body of an article." - (narrow-to-region - (progn - (goto-char (point-min)) - (or (search-forward "\n\n" nil t) - (point-max))) - (point-max))) - - -;;; -;;; Kill file handling. -;;; - -(defun gnus-apply-kill-file () - "Apply a kill file to the current newsgroup. -Returns the number of articles marked as read." - (if (or (file-exists-p (gnus-newsgroup-kill-file nil)) - (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name))) - (gnus-apply-kill-file-internal) - 0)) - -(defun gnus-kill-save-kill-buffer () - (let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name))) - (when (get-file-buffer file) - (save-excursion - (set-buffer (get-file-buffer file)) - (when (buffer-modified-p) - (save-buffer)) - (kill-buffer (current-buffer)))))) - -(defcustom gnus-kill-file-name "KILL" - "Suffix of the kill files." - :group 'gnus-score-kill - :group 'gnus-score-files - :type 'string) - -(defun gnus-newsgroup-kill-file (newsgroup) - "Return the name of a kill file name for NEWSGROUP. -If NEWSGROUP is nil, return the global kill file name instead." - (cond - ;; The global KILL file is placed at top of the directory. - ((or (null newsgroup) - (string-equal newsgroup "")) - (expand-file-name gnus-kill-file-name - gnus-kill-files-directory)) - ;; Append ".KILL" to newsgroup name. - ((gnus-use-long-file-name 'not-kill) - (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup) - "." gnus-kill-file-name) - gnus-kill-files-directory)) - ;; Place "KILL" under the hierarchical directory. - (t - (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup) - "/" gnus-kill-file-name) - gnus-kill-files-directory)))) - -;;; Server things. - -(defun gnus-member-of-valid (symbol group) - "Find out if GROUP has SYMBOL as part of its \"valid\" spec." - (memq symbol (assoc - (symbol-name (car (gnus-find-method-for-group group))) - gnus-valid-select-methods))) - -(defun gnus-method-option-p (method option) - "Return non-nil if select METHOD has OPTION as a parameter." - (when (stringp method) - (setq method (gnus-server-to-method method))) - (memq option (assoc (format "%s" (car method)) - gnus-valid-select-methods))) - -(defun gnus-similar-server-opened (method) - (let ((opened gnus-opened-servers)) - (while (and method opened) - (when (and (equal (cadr method) (cadaar opened)) - (equal (car method) (caaar opened)) - (not (equal method (caar opened)))) - (setq method nil)) - (pop opened)) - (not method))) - -(defun gnus-server-extend-method (group method) - ;; This function "extends" a virtual server. If the server is - ;; "hello", and the select method is ("hello" (my-var "something")) - ;; in the group "alt.alt", this will result in a new virtual server - ;; called "hello+alt.alt". - (if (or (not (inline (gnus-similar-server-opened method))) - (not (cddr method))) - method - `(,(car method) ,(concat (cadr method) "+" group) - (,(intern (format "%s-address" (car method))) ,(cadr method)) - ,@(cddr method)))) - -(defun gnus-server-status (method) - "Return the status of METHOD." - (nth 1 (assoc method gnus-opened-servers))) - -(defun gnus-group-name-to-method (group) - "Guess a select method based on GROUP." - (if (string-match ":" group) - (let ((server (substring group 0 (match-beginning 0)))) - (if (string-match "\\+" server) - (list (intern (substring server 0 (match-beginning 0))) - (substring server (match-end 0))) - (list (intern server) ""))) - gnus-select-method)) - -(defun gnus-server-string (server) - "Return a readable string that describes SERVER." - (let* ((server (gnus-server-to-method server)) - (address (nth 1 server))) - (if (and address - (not (zerop (length address)))) - (format "%s using %s" address (car server)) - (format "%s" (car server))))) - -(defun gnus-find-method-for-group (group &optional info) - "Find the select method that GROUP uses." - (or gnus-override-method - (and (not group) - gnus-select-method) - (and (not (gnus-group-entry group)) - ;; Killed or otherwise unknown group. - (or - ;; If we know a virtual server by that name, return its method. - (gnus-server-to-method (gnus-group-server group)) - ;; Guess a new method as last resort. - (gnus-group-name-to-method group))) - (let ((info (or info (gnus-get-info group))) - method) - (if (or (not info) - (not (setq method (gnus-info-method info))) - (equal method "native")) - gnus-select-method - (setq method - (cond ((stringp method) - (inline (gnus-server-to-method method))) - ((stringp (cadr method)) - (inline (gnus-server-extend-method group method))) - (t - method))) - (cond ((equal (cadr method) "") - method) - ((null (cadr method)) - (list (car method) "")) - (t - (gnus-server-add-address method))))))) - -(defun gnus-methods-using (feature) - "Find all methods that have FEATURE." - (let ((valids gnus-valid-select-methods) - outs) - (while valids - (when (memq feature (car valids)) - (push (car valids) outs)) - (setq valids (cdr valids))) - outs)) - -(eval-and-compile - (autoload 'message-y-or-n-p "message" nil nil 'macro)) - -(defun gnus-read-group (prompt &optional default) - "Prompt the user for a group name. -Disallow invalid group names." - (let ((prefix "") - group) - (while (not group) - (when (string-match - gnus-invalid-group-regexp - (setq group (read-string (concat prefix prompt) - (cons (or default "") 0) - 'gnus-group-history))) - (let ((match (match-string 0 group))) - ;; Might be okay (e.g. for nnimap), so ask the user: - (unless (and (not (string-match "^$\\|:" match)) - (message-y-or-n-p - "Proceed and create group anyway? " t -"The group name \"" group "\" contains a forbidden character: \"" match "\". - -Usually, it's dangerous to create a group with this name, because it's not -supported by all back ends and servers. On IMAP servers it should work, -though. If you are really sure, you can proceed anyway and create the group. - -You may customize the variable `gnus-invalid-group-regexp', which currently is -set to \"" gnus-invalid-group-regexp -"\", if you want to get rid of this query permanently.")) - (setq prefix (format "Invalid group name: \"%s\". " group) - group nil))))) - group)) - -(defun gnus-read-method (prompt) - "Prompt the user for a method. -Allow completion over sensible values." - (let* ((open-servers - (mapcar (lambda (i) (cons (format "%s:%s" (caar i) (cadar i)) i)) - gnus-opened-servers)) - (valid-methods - (let (methods) - (dolist (method gnus-valid-select-methods) - (if (or (memq 'prompt-address method) - (not (assoc (format "%s:" (car method)) open-servers))) - (push method methods))) - methods)) - (servers - (append valid-methods - open-servers - gnus-predefined-server-alist - gnus-server-alist)) - (method - (completing-read - prompt servers - nil t nil 'gnus-method-history))) - (cond - ((equal method "") - (setq method gnus-select-method)) - ((assoc method gnus-valid-select-methods) - (let ((address (if (memq 'prompt-address - (assoc method gnus-valid-select-methods)) - (read-string "Address: ") - ""))) - (or (cadr (assoc (format "%s:%s" method address) open-servers)) - (list (intern method) address)))) - ((assoc method servers) - method) - (t - (list (intern method) ""))))) - -;;; Agent functions - -(defun gnus-agent-method-p (method) - "Say whether METHOD is covered by the agent." - (or (eq (car gnus-agent-method-p-cache) method) - (setq gnus-agent-method-p-cache - (cons method - (member (if (stringp method) - method - (gnus-method-to-server method)) gnus-agent-covered-methods)))) - (cdr gnus-agent-method-p-cache)) - -(defun gnus-online (method) - (not - (if gnus-plugged - (eq (cadr (assoc method gnus-opened-servers)) 'offline) - (gnus-agent-method-p method)))) - -;;; User-level commands. - -;;;###autoload -(defun gnus-slave-no-server (&optional arg) - "Read network news as a slave, without connecting to the local server." - (interactive "P") - (gnus-no-server arg t)) - -;;;###autoload -(defun gnus-no-server (&optional arg slave) - "Read network news. -If ARG is a positive number, Gnus will use that as the startup -level. If ARG is nil, Gnus will be started at level 2. If ARG is -non-nil and not a positive number, Gnus will prompt the user for the -name of an NNTP server to use. -As opposed to `gnus', this command will not connect to the local -server." - (interactive "P") - (gnus-no-server-1 arg slave)) - -;;;###autoload -(defun gnus-slave (&optional arg) - "Read news as a slave." - (interactive "P") - (gnus arg nil 'slave)) - -;;;###autoload -(defun gnus-other-frame (&optional arg display) - "Pop up a frame to read news. -This will call one of the Gnus commands which is specified by the user -option `gnus-other-frame-function' (default `gnus') with the argument -ARG if Gnus is not running, otherwise just pop up a Gnus frame. The -optional second argument DISPLAY should be a standard display string -such as \"unix:0\" to specify where to pop up a frame. If DISPLAY is -omitted or the function `make-frame-on-display' is not available, the -current display is used." - (interactive "P") - (if (fboundp 'make-frame-on-display) - (unless display - (setq display (gnus-frame-or-window-display-name (selected-frame)))) - (setq display nil)) - (let ((alive (gnus-alive-p))) - (unless (and alive - (catch 'found - (walk-windows - (lambda (window) - (when (and (or (not display) - (equal display - (gnus-frame-or-window-display-name - window))) - (with-current-buffer (window-buffer window) - (string-match "\\`gnus-" - (symbol-name major-mode)))) - (gnus-select-frame-set-input-focus - (setq gnus-other-frame-object (window-frame window))) - (select-window window) - (throw 'found t))) - 'ignore t))) - (gnus-select-frame-set-input-focus - (setq gnus-other-frame-object - (if display - (make-frame-on-display display gnus-other-frame-parameters) - (make-frame gnus-other-frame-parameters)))) - (if alive - (switch-to-buffer gnus-group-buffer) - (funcall gnus-other-frame-function arg) - (add-hook 'gnus-exit-gnus-hook - '(lambda nil - (when (and (frame-live-p gnus-other-frame-object) - (cdr (frame-list))) - (delete-frame gnus-other-frame-object)) - (setq gnus-other-frame-object nil))))))) - -;;;###autoload -(defun gnus (&optional arg dont-connect slave) - "Read network news. -If ARG is non-nil and a positive number, Gnus will use that as the -startup level. If ARG is non-nil and not a positive number, Gnus will -prompt the user for the name of an NNTP server to use." - (interactive "P") - (unless (byte-code-function-p (symbol-function 'gnus)) - (message "You should byte-compile Gnus") - (sit-for 2)) - (gnus-1 arg dont-connect slave)) - -;; Allow redefinition of Gnus functions. - -(gnus-ems-redefine) - -(provide 'gnus) - -;;; arch-tag: acebeeab-f331-4f8f-a7ea-89c58c84f636 -;;; gnus.el ends here diff --git a/xemacs-packages/gnus/lisp/gpg-ring.el b/xemacs-packages/gnus/lisp/gpg-ring.el deleted file mode 100644 index f310c7ee..00000000 --- a/xemacs-packages/gnus/lisp/gpg-ring.el +++ /dev/null @@ -1,482 +0,0 @@ -;;; gpg-ring.el --- Major mode for editing GnuPG key rings. - -;; Copyright (C) 2000 RUS-CERT, University Of Stuttgart - -;; Author: Florian Weimer -;; Maintainer: Florian Weimer -;; Keywords: crypto -;; Created: 2000-04-28 - -;; This file is NOT (yet?) part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - - - -;;; Code: - -(require 'gpg) -(eval-when-compile (require 'cl)) - -;;;; Customization: - -;;; Customization: Groups: - -(defgroup gpg-ring nil - "GNU Privacy Guard user interface." - :tag "GnuPG user interface" - :group 'gpg) - -;;; Customization: Variables: - -(defface gpg-ring-key-invalid-face - '((((class color)) - (:foreground "yellow" :background "red")) - (t (:bold t :italic t :underline t))) - "Face for strings indicating key invalidity." - :group 'gpg-ring) - -(defface gpg-ring-uncertain-validity-face - '((((class color)) (:foreground "red")) - (t (:bold t))) - "Face for strings indicating uncertain validity." - :group 'gpg-ring) - -(defface gpg-ring-full-validity-face - '((((class color)) (:foreground "ForestGreen" :bold t)) - (t (:bold t))) - "Face for strings indicating key invalidity." - :group 'gpg-ring) - -(defvar gpg-ring-mode-hook nil - "Normal hook run when entering GnuPG ring mode.") - -;;; Constants - -(defconst gpg-ring-algo-alist - '((rsa . "RSA") - (rsa-encrypt-only . "RSA-E") - (rsa-sign-only . "RSA-S") - (elgamal-encrypt-only . "ELG-E") - (dsa . "DSA") - (elgamal . "ELG-E")) - "Alist mapping algorithm IDs to algorithm abbreviations.") - -(defconst gpg-ring-trust-alist - '((not-known "???" gpg-ring-uncertain-validity-face) - (disabled "DIS" gpg-ring-key-invalid-face) - (revoked "REV" gpg-ring-key-invalid-face) - (expired "EXP" gpg-ring-key-invalid-face) - (trust-undefined "QES" gpg-ring-uncertain-validity-face) - (trust-none "NON" gpg-ring-uncertain-validity-face) - (trust-marginal "MAR") - (trust-full "FUL" gpg-ring-full-validity-face) - (trust-ultimate "ULT" gpg-ring-full-validity-face)) - "Alist mapping trust IDs to trust abbrevs and faces.") - -(defvar gpg-ring-mode-map - (let ((map (make-keymap))) - (suppress-keymap map t) - map) - "Keymap for `gpg-ring-mode'.") - -(define-key gpg-ring-mode-map "0" 'delete-window) -(define-key gpg-ring-mode-map "1" 'delete-other-windows) -(define-key gpg-ring-mode-map "M" 'gpg-ring-mark-process-all) -(define-key gpg-ring-mode-map "U" 'gpg-ring-unmark-all) -(define-key gpg-ring-mode-map "a" 'gpg-ring-toggle-show-unusable) -(define-key gpg-ring-mode-map "d" 'gpg-ring-mark-delete) -(define-key gpg-ring-mode-map "f" 'gpg-ring-update-key) -(define-key gpg-ring-mode-map "g" 'gpg-ring-update) -(define-key gpg-ring-mode-map "i" 'gpg-ring-show-key) -(define-key gpg-ring-mode-map "l" 'gpg-ring-toggle-show-all-ids) -(define-key gpg-ring-mode-map "m" 'gpg-ring-mark-process) -(define-key gpg-ring-mode-map "n" 'gpg-ring-next-record) -(define-key gpg-ring-mode-map "p" 'gpg-ring-previous-record) -(define-key gpg-ring-mode-map "q" 'gpg-ring-quit) -(define-key gpg-ring-mode-map "u" 'gpg-ring-unmark) -(define-key gpg-ring-mode-map "x" 'gpg-ring-extract-keys) -(define-key gpg-ring-mode-map "X" 'gpg-ring-extract-keys-to-kill) - -(define-key gpg-ring-mode-map "\C-c\C-c" 'gpg-ring-action) - -;;; Internal functions: - -(defvar gpg-ring-key-list - nil - "List of keys in the key list buffer.") -(make-variable-buffer-local 'gpg-ring-key-list) - -(defvar gpg-ring-update-funcs - nil - "List of functions called to obtain the key list.") -(make-variable-buffer-local 'gpg-ring-update-funcs) - -(defvar gpg-ring-show-unusable - nil - "If t, show expired, revoked and disabled keys, too.") -(make-variable-buffer-local 'gpg-ring-show-unusable) - -(defvar gpg-ring-show-all-ids - nil - "If t, show all user IDs. If nil, show only the primary user ID.") -(make-variable-buffer-local 'gpg-ring-show-all-ids) - -(defvar gpg-ring-marks-alist - nil - "Alist of (UNIQUE-ID MARK KEY). -UNIQUE-ID is a unique key ID from GnuPG. MARK is either `?D' -(marked for deletion), or `?*' (marked for processing).") -(make-variable-buffer-local 'gpg-ring-marks-alist) - -(defvar gpg-ring-action - nil - "Function to call when `gpg-ring-action' is invoked. -A list of the keys which are marked for processing is passed as argument.") -(make-variable-buffer-local 'gpg-ring-action) - -(defun gpg-ring-mode () - "Mode for editing GnuPG key rings. -\\{gpg-ring-mode-map} -Turning on gpg-ring-mode runs `gpg-ring-mode-hook'." - (interactive) - (kill-all-local-variables) - (buffer-disable-undo) - (setq truncate-lines t) - (setq buffer-read-only t) - (use-local-map gpg-ring-mode-map) - (setq mode-name "Key Ring") - (setq major-mode 'gpg-ring-mode) - (run-hooks 'gpg-ring-mode-hook)) - - -(defmacro gpg-ring-record-start (&optional pos) - "Return buffer position of start of record containing POS." - `(get-text-property (or ,pos (point)) 'gpg-record-start)) - -(defun gpg-ring-current-key (&optional pos) - "Return GnuPG key at POS, or at point if ommitted." - (or (get-text-property (or pos (point)) 'gpg-key) - (error "No record on current line"))) - -(defun gpg-ring-goto-record (pos) - "Go to record starting at POS. -Position point after the marks at the beginning of a record." - (goto-char pos) - (forward-char 2)) - -(defun gpg-ring-next-record () - "Advances point to the start of the next record." - (interactive) - (let ((start (next-single-property-change - (point) 'gpg-record-start nil (point-max)))) - ;; Don't advance to the last line of the buffer. - (when (/= start (point-max)) - (gpg-ring-goto-record start)))) - -(defun gpg-ring-previous-record () - "Advances point to the start of the previous record." - (interactive) - ;; The last line of the buffer doesn't contain a record. - (let ((start (gpg-ring-record-start))) - (if start - (gpg-ring-goto-record (previous-single-property-change - start 'gpg-record-start nil (point-min))) - (gpg-ring-goto-record - (gpg-ring-record-start (1- (point-max))))))) - -(defun gpg-ring-set-mark (&optional pos mark) - "Set MARK on record at POS, or at point if POS is omitted. -If MARK is omitted, clear it." - (save-excursion - (let* ((start (gpg-ring-record-start pos)) - (key (gpg-ring-current-key start)) - (id (gpg-key-unique-id key)) - (entry (assoc id gpg-ring-marks-alist)) - buffer-read-only) - (goto-char start) - ;; Replace the mark character. - (subst-char-in-region (point) (1+ (point)) (char-after) - (or mark ? )) - ;; Store the mark in alist. - (if entry - (setcdr entry (if mark (list mark key))) - (when mark - (push (list id mark key) gpg-ring-marks-alist)))))) - -(defun gpg-ring-marked-keys (&optional only-marked mark) - "Return list of key specs which have MARK. -If no marks are present and ONLY-MARKED is not nil, return singleton -list with key of the current record. If MARK is omitted, `?*' is -used." - (let ((the-marker (or mark ?*)) - (marks gpg-ring-marks-alist) - key-list) - (while marks - (let ((mark (pop marks))) - ;; If this entry has got the right mark ... - (when (equal (nth 1 mark) the-marker) - ;; ... rember the key spec. - (push (nth 2 mark) key-list)))) - (or key-list (if (not only-marked) (list (gpg-ring-current-key)))))) - -(defun gpg-ring-mark-process () - "Mark record at point for processing." - (interactive) - (gpg-ring-set-mark nil ?*) - (gpg-ring-next-record)) - -(defun gpg-ring-mark-delete () - "Mark record at point for processing." - (interactive) - (gpg-ring-set-mark nil ?D) - (gpg-ring-next-record)) - -(defun gpg-ring-unmark () - "Mark record at point for processing." - (interactive) - (gpg-ring-set-mark) - (gpg-ring-next-record)) - -(defun gpg-ring-mark-process-all () - "Put process mark on all records." - (interactive) - (setq gpg-ring-marks-alist - (mapcar (lambda (key) - (list (gpg-key-unique-id key) ?* key)) - gpg-ring-key-list)) - (gpg-ring-regenerate)) - -(defun gpg-ring-unmark-all () - "Remove all record marks." - (interactive) - (setq gpg-ring-marks-alist nil) - (gpg-ring-regenerate)) - -(defun gpg-ring-toggle-show-unusable () - "Toggle value if `gpg-ring-show-unusable'." - (interactive) - (setq gpg-ring-show-unusable (not gpg-ring-show-unusable)) - (gpg-ring-regenerate)) - -(defun gpg-ring-toggle-show-all-ids () - "Toggle value of `gpg-ring-show-all-ids'." - (interactive) - (setq gpg-ring-show-all-ids (not gpg-ring-show-all-ids)) - (gpg-ring-regenerate)) - -(defvar gpg-ring-output-buffer-name "*GnuPG Output*" - "Name buffer to which output from GnuPG is sent.") - -(defmacro gpg-ring-with-output-buffer (&rest body) - "Erase GnuPG output buffer, evaluate BODY in it, and display it." - `(with-current-buffer (get-buffer-create gpg-ring-output-buffer-name) - (erase-buffer) - (setq truncate-lines t) - ,@body - (goto-char (point-min)) - (display-buffer gpg-ring-output-buffer-name))) - -(defun gpg-ring-quit () - "Bury key list buffer and kill GnuPG output buffer." - (interactive) - (let ((output (get-buffer gpg-ring-output-buffer-name))) - (when output - (kill-buffer output))) - (when (eq 'gpg-ring-mode major-mode) - (bury-buffer))) - -(defun gpg-ring-show-key () - "Show information for current key." - (interactive) - (let ((keys (gpg-ring-marked-keys))) - (gpg-ring-with-output-buffer - (gpg-key-insert-information (gpg-key-unique-id-list keys))))) - -(defun gpg-ring-extract-keys () - "Export currently selected public keys in ASCII armor." - (interactive) - (let ((keys (gpg-ring-marked-keys))) - (gpg-ring-with-output-buffer - (gpg-key-insert-public-key (gpg-key-unique-id-list keys))))) - -(defun gpg-ring-extract-keys-to-kill () - "Export currently selected public keys in ASCII armor to kill ring." - (interactive) - (let ((keys (gpg-ring-marked-keys))) - (with-temp-buffer - (gpg-key-insert-public-key (gpg-key-unique-id-list keys)) - (copy-region-as-kill (point-min) (point-max))))) - -(defun gpg-ring-update-key () - "Fetch key information from key server." - (interactive) - (let ((keys (gpg-ring-marked-keys))) - (gpg-ring-with-output-buffer - (gpg-key-retrieve (gpg-key-unique-id-list keys))))) - -(defun gpg-ring-insert-key-stat (key) - (let* ((validity (gpg-key-validity key)) - (validity-entry (assq validity gpg-ring-trust-alist)) - (trust (gpg-key-trust key)) - (trust-entry (assq trust gpg-ring-trust-alist))) - ;; Insert abbrev for key status. - (let ((start (point))) - (insert (nth 1 validity-entry)) - ;; Change face if necessary. - (when (nth 2 validity-entry) - (add-text-properties start (point) - (list 'face (nth 2 validity-entry))))) - ;; Trust, key ID, length, algorithm, creation date. - (insert (format "/%s %-8s/%4d/%-5s created %s" - (nth 1 trust-entry) - (gpg-short-key-id key) - (gpg-key-length key) - (cdr (assq (gpg-key-algorithm key) gpg-ring-algo-alist)) - (gpg-key-creation-date key))) - ;; Expire date. - (when (gpg-key-expire-date key) - (insert ", ") - (let ((start (point)) - (expired (eq 'expired validity)) - (notice (concat ))) - (insert (if expired "EXPIRED" "expires") - " " (gpg-key-expire-date key)) - (when expired - (add-text-properties start (point) - '(face gpg-ring-key-invalid-face))))))) - -(defun gpg-ring-insert-key (key &optional mark) - "Inserts description for KEY into current buffer before point." - (let ((start (point))) - (insert (if mark mark " ") - " " (gpg-key-primary-user-id key) "\n" - " ") - (gpg-ring-insert-key-stat key) - (insert "\n") - (when gpg-ring-show-all-ids - (let ((uids (gpg-key-user-ids key))) - (while uids - (insert " ID " (pop uids) "\n")))) - (add-text-properties start (point) - (list 'gpg-record-start start - 'gpg-key key)))) - -(defun gpg-ring-regenerate () - "Regenerate the key list buffer from stored data." - (interactive) - (let* ((key-list gpg-ring-key-list) - ;; Record position of point. - (old-record (if (eobp) ; No record on last line. - nil - (gpg-key-unique-id (gpg-ring-current-key)))) - (old-pos (if old-record (- (point) (gpg-ring-record-start)))) - found new-pos new-pos-offset buffer-read-only new-marks) - ;; Replace buffer contents with new data. - (erase-buffer) - (while key-list - (let* ((key (pop key-list)) - (id (gpg-key-unique-id key)) - (mark (assoc id gpg-ring-marks-alist))) - (when (or gpg-ring-show-unusable - (not (memq (gpg-key-validity key) - '(disabled revoked expired)))) - ;; Check if point was in this record. - (when (and old-record - (string-equal old-record id)) - (setq new-pos (point)) - (setq new-pos-offset (+ new-pos old-pos))) - ;; Check if this record was marked. - (if (nth 1 mark) - (progn - (push mark new-marks) - (gpg-ring-insert-key key (nth 1 mark))) - (gpg-ring-insert-key key))))) - ;; Replace mark alist with the new one (which does not contain - ;; marks for records which vanished during this update). - (setq gpg-ring-marks-alist new-marks) - ;; Restore point. - (if (not old-record) - ;; We were at the end of the buffer before. - (goto-char (point-max)) - (if new-pos - (if (and (< new-pos-offset (point-max)) - (equal old-record (gpg-key-unique-id - (gpg-ring-current-key new-pos-offset)))) - ;; Record is there, with offset. - (goto-char new-pos-offset) - ;; Record is there, but not offset. - (goto-char new-pos)) - ;; Record is not there. - (goto-char (point-min)))))) - -(defun gpg-ring-update () - "Update the key list buffer with new data." - (interactive) - (let ((funcs gpg-ring-update-funcs) - old) - ;; Merge the sorted lists obtained by calling elements of - ;; `gpg-ring-update-funcs'. - (while funcs - (let ((additional (funcall (pop funcs))) - new) - (while (and additional old) - (if (gpg-key-lessp (car additional) (car old)) - (push (pop additional) new) - (if (gpg-key-lessp (car old) (car additional)) - (push (pop old) new) - ;; Keys are perhaps equal. Always Add old key. - (push (pop old) new) - ;; If new key is equal, drop it, otherwise add it as well. - (if (string-equal (gpg-key-unique-id (car old)) - (gpg-key-unique-id (car additional))) - (pop additional) - (push (pop additional) new))))) - ;; Store new list as old one for next round. - (setq old (nconc (nreverse new) old additional)))) - ;; Store the list in the buffer. - (setq gpg-ring-key-list old)) - (gpg-ring-regenerate)) - -(defun gpg-ring-action () - "Perform the action associated with this buffer." - (interactive) - (if gpg-ring-action - (funcall gpg-ring-action (gpg-ring-marked-keys)) - (error "No action for this buffer specified"))) - -;;;###autoload -(defun gpg-ring-keys (&optional key-list-funcs action) - (interactive) - (let ((buffer (get-buffer-create "*GnuPG Key List*"))) - (with-current-buffer buffer - (gpg-ring-mode) - (setq gpg-ring-action action) - (setq gpg-ring-update-funcs key-list-funcs key-list-funcs) - (gpg-ring-update) - (goto-char (point-min))) - (switch-to-buffer buffer))) - -;;;###autoload -(defun gpg-ring-public (key-spec) - "List public keys matching keys KEY-SPEC." - (interactive "sList public keys containing: ") - (gpg-ring-keys `((lambda () (gpg-key-list-keys ,key-spec))))) - -(provide 'gpg-ring) - -;;; arch-tag: a4c5b2d1-aff0-4ab6-96e9-267727226c2d -;;; gpg-ring.el ends here diff --git a/xemacs-packages/gnus/lisp/gpg.el b/xemacs-packages/gnus/lisp/gpg.el deleted file mode 100644 index 80c5d8a8..00000000 --- a/xemacs-packages/gnus/lisp/gpg.el +++ /dev/null @@ -1,1340 +0,0 @@ -;;; gpg.el --- Interface to GNU Privacy Guard - -;; Copyright (C) 2000 RUS-CERT, University Of Stuttgart - -;; Author: Florian Weimer -;; Maintainer: Florian Weimer -;; Keywords: crypto -;; Created: 2000-04-15 - -;; This file is NOT (yet?) part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA -;; ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA -;; -;; This code is not well-tested. BE CAREFUL! -;; -;; ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA -;; ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA - -;; Implemented features which can be tested: -;; -;; * Customization for all flavors of PGP is possible. -;; * The main operations (verify, decrypt, sign, encrypt, sign & -;; encrypt) are implemented. -;; * Optionally, Gero Treuner's gpg-2comp script is supported, -;; to generate data which is compatible with PGP 2.6.3. - -;; Customizing external programs -;; ============================= - -;; The customization are very similar to those of others programs, -;; only the C-ish "%" constructs have been replaced by more Lisp-like -;; syntax. -;; -;; First, you have to adjust the default executable paths -;; (`gpg-command-default-alist', customization group `gpg-options', -;; "Controlling GnuPG invocation."). After that, you should -;; change the configuration options which control how specific -;; command line flags are built (`gpg-command-flag-sign-with-key', -;; (`gpg-command-flag-recipient'). The elements of these lists are -;; concatenated without spaces, and a new argument is only started -;; where indicated. The `gpg-command-flag-recipient' list is special: -;; it consists of two parts, the first one remains at the beginning -;; of the argument, the second one is repeated for each recipient. -;; Finally, `gpg-command-passphrase-env' has to be changed if there's -;; no command line flag to force the external program to read the data -;; from standard input before the message. -;; -;; In customization group `gpg-commands', "Controlling GnuPG -;; invocation.", you have to supply the actual syntax for external -;; program calls. Each variable consists of a pair of a program -;; specification (if a Lisp symbol is given here, it is translated -;; via `gpg-command-default-alist') and a list of program arguments -;; with placeholders. Please read the documentation of each variable -;; before making your adjustments and try to match the given -;; requirements as closely as possible! -;; -;; The `gpg-commands-key' group, "GnuPG Key Management Commands.", -;; specifies key management commands. The syntax of these variables -;; is like those in the `gpg-commands' group. Note that the output -;; format of some of these external programs has to match very close -;; that of GnuPG. Additional tools (Thomas Roessler's "pgpring.c") -;; are available if your favorite implementation of OpenPGP cannot -;; output the this format. - -;; Security considerations -;; ======================= - -;; On a typical multiuser UNIX system, the memory image of the -;; Emacs process is not locked, therefore it can be swapped to disk -;; at any time. As a result, the passphrase might show up in the -;; swap space (even if you don't use the passphrase cache, i.e. if -;; `gpg-passphrase-timeout' is 0). If someone is able to run `gdb' or -;; another debugger on your Emacs process, he might be able to recover -;; the passphrase as well. Unfortunately, nothing can be done in -;; order to prevent this at the moment. -;; -;; BE CAREFUL: If you use the passphrase cache feature, the passphrase -;; is stored in the variable `gpg-passphrase' -- and it is NOT -;; encrypted in any way. (This is a conceptual problem because the -;; nature of the passphrase cache requires that Emacs is able to -;; decrypt automatically, so only a very weak protection could be -;; applied anyway.) -;; -;; In addition, if you use an unpatched Emacs 20 (and earlier -;; versions), passwords show up in the output of the `view-lossage' -;; function (bound to `C-h l' by default). - - -;;; Code: - -(if (featurep 'xemacs) - (require 'timer-funcs) - (require 'timer)) -(eval-when-compile (require 'cl)) - -(eval-and-compile - (defalias 'gpg-point-at-eol - (if (fboundp 'point-at-eol) - 'point-at-eol - 'line-end-position))) - -;; itimer/timer compatibility -(eval-and-compile - (if (featurep 'xemacs) - (progn - (defalias 'gpg-cancel-timer 'delete-itimer) - (defalias 'gpg-timer-activate 'activate-itimer) - (defalias 'gpg-timer-create 'make-itimer) - (defalias 'gpg-timer-set-function 'set-itimer-function) - (defalias 'gpg-timer-set-time 'set-itimer-value)) - (defalias 'gpg-cancel-timer 'cancel-timer) - (defalias 'gpg-timer-activate 'timer-activate) - (defalias 'gpg-timer-create 'timer-create) - (defalias 'gpg-timer-set-function 'timer-set-function) - (defalias 'gpg-timer-set-time 'timer-set-time))) - -;;;; Customization: - -;;; Customization: Groups: - -(defgroup gpg nil - "GNU Privacy Guard interface." - :tag "GnuPG" - :group 'processes) - -(defgroup gpg-options nil - "Controlling GnuPG invocation." - :tag "GnuPG Options" - :group 'gpg) - -(defgroup gpg-commands nil - "Primary GnuPG Operations." - :tag "GnuPG Commands" - :group 'gpg) - -(defgroup gpg-commands-key nil - "Commands for GnuPG key management." - :tag "GnuPG Key Commands" - :group 'gpg-commands) - -;;; Customization: Widgets: - -(if (get 'alist 'widget-type) - (define-widget 'gpg-command-alist 'alist - "An association list for GnuPG command names." - :key-type '(symbol :tag "Abbreviation") - :value-type '(string :tag "Program name") - :convert-widget 'widget-alist-convert-widget - :tag "Alist") - (define-widget 'gpg-command-alist 'repeat - "An association list for GnuPG command names." - :args '((cons :format "%v" - (symbol :tag "Abbreviation") - (string :tag "Program name"))) - :tag "Alist")) - -(define-widget 'gpg-command-program 'choice - "Widget for entering the name of a program (mostly the GnuPG binary)." - :tag "Program" - :args '((const :tag "Default GnuPG program." - :value gpg) - (const :tag "GnuPG compatibility wrapper." - :value gpg-2comp) - (const :tag "Disabled" - :value nil) - (string :tag "Custom program" :format "%v"))) - -(define-widget 'gpg-command-sign-options 'cons - "Widget for entering signing options." - :args '(gpg-command-program - (repeat - :tag "Arguments" - (choice - :format "%[Type%] %v" - (const :tag "Insert armor option here if necessary." - :value armor) - (const :tag "Insert text mode option here if necessary." - :value textmode) - (const :tag "Insert the sign with key option here if necessary." - :value sign-with-key) - (string :format "%v"))))) - -(define-widget 'gpg-command-key-options 'cons - "Widget for entering key command options." - :args '(gpg-command-program - (repeat - :tag "Arguments" - (choice - :format "%[Type%] %v" - (const :tag "Insert key ID here." - :value key-id) - (string :format "%v"))))) - -;;; Customization: Variables: - -;;; Customization: Variables: Paths and Flags: - -(defcustom gpg-passphrase-timeout - 0 - "Timeout (in seconds) for the passphrase cache. -The passphrase cache is cleared after is hasn't been used for this -many seconds. The values 0 means that the passphrase is not cached at -all." - :tag "Passphrase Timeout" - :type 'number - :group 'gpg-options) - -(defcustom gpg-default-key-id - nil - "Default key/user ID used for signatures." - :tag "Default Key ID" - :type '(choice - (const :tag "Use GnuPG default." :value nil) - (string)) - :group 'gpg-options) - -(defcustom gpg-temp-directory - (expand-file-name "~/tmp") - "Directory for temporary files. -If you are running Emacs 20, this directory must have mode 0700." - :tag "Temp directory" - :type 'string - :group 'gpg-options) - -(defcustom gpg-command-default-alist - '((gpg . "gpg") - (gpg-2comp . "gpg")) - "Default paths for some GnuPG-related programs. -Modify this variable if you have to change the paths to the -executables required by the GnuPG interface. You can enter \"gpg-2comp\" -for `gpg-2comp' if you have obtained this script, in order to gain -PGP 2.6.x compatibility." - :tag "GnuPG programs" - :type 'gpg-command-alist - :group 'gpg-options) - -(defcustom gpg-command-all-arglist - nil - "List of arguments to add to all GPG commands." - :tag "All command args" - :group 'gpg-options) - -(defcustom gpg-command-flag-textmode "--textmode" - "The flag to indicate canonical text mode to GnuPG." - :tag "Text mode flag" - :type 'string - :group 'gpg-options) - -(defcustom gpg-command-flag-armor "--armor" - "The flag to request ASCII-armoring output from GnuPG." - :tag "Armor flag" - :type 'string - :group 'gpg-options) - -(defcustom gpg-command-flag-sign-with-key '("--local-user=" sign-with-key) - "String to include to specify the signing key ID. -The elements are concatenated (without spaces) to form a command line -option." - :tag "Sign with key flag" - :type '(repeat :tag "Argument parts" - (choice :format "%[Type%] %v" - (const :tag "Start next argument." :value next-argument) - (const :tag "Insert signing key ID here." :value sign-with-key) - (string))) - :group 'gpg-options) - -(defcustom gpg-command-flag-recipient - '(nil . ("-r" next-argument recipient next-argument)) - "Format of a recipient specification. -The elements are concatenated (without spaces) to form a command line -option. The second part is repeated for each recipient." - :tag "Recipients Flag" - :type '(cons - (repeat :tag "Common prefix" - (choice :format "%[Type%] %v" - (const :tag "Start next argument." :value next-argument) - (string))) - (repeat :tag "For each recipient" - (choice :format "%[Type%] %v" - (const :tag "Start next argument." :value next-argument) - (const :tag "Insert recipient key ID here." :value recipient) - (string)))) - :group 'gpg-options) - -(defcustom gpg-command-passphrase-env - nil - "Environment variable to set when a passphrase is required, or nil. -If an operation is invoked which requires a passphrase, this -environment variable is set before calling the external program to -indicate that it should read the passphrase from standard input." - :tag "Passphrase environment" - :type '(choice - (const :tag "Disabled" :value nil) - (cons - (string :tag "Variable") - (string :tag "Value"))) - :group 'gpg-options) - -;;; Customization: Variables: GnuPG Commands: - -(defcustom gpg-command-verify - '(gpg . ("--status-fd" "1" "--batch" "--verbose" "--verify" signature-file message-file)) - "Command to verify a detached signature. -The invoked program has to read the signed message and the signature -from the given files. It should write human-readable information to -standard output and/or standard error. The program shall not convert -charsets or line endings; the input data shall be treated as binary." - :tag "Verify Command" - :type '(cons - gpg-command-program - (repeat - :tag "Arguments" - (choice - :format "%[Type%] %v" - (const :tag "Insert name of file containing the message here." - :value message-file) - (const :tag "Insert name of file containing the signature here." - :value signature-file) - (string :format "%v")))) - :group 'gpg-commands) - -(defcustom gpg-command-verify-cleartext - '(gpg . ("--status-fd" "1" "--batch" "--verbose" "--verify" message-file)) - "Command to verify a message. -The invoked program has to read the signed message from the given -file. It should write human-readable information to standard output -and/or standard error. The program shall not convert charsets or line -endings; the input data shall be treated as binary." - :tag "Cleartext Verify Command" - :type '(cons - gpg-command-program - (repeat - :tag "Arguments" - (choice - :format "%[Type%] %v" - (const :tag "Insert name of file containing the message here." - :value message-file) - (string :format "%v")))) - :group 'gpg-commands) - -(defcustom gpg-command-decrypt - '(gpg . ("--status-fd" "2" "--decrypt" "--batch" "--passphrase-fd=0")) - "Command to decrypt a message. -The invoked program has to read the passphrase from standard -input, followed by the encrypted message. It writes the decrypted -message to standard output, and human-readable diagnostic messages to -standard error." - :tag "Decrypt Command" - :type '(cons - gpg-command-program - (repeat - :tag "Arguments" - (choice - :format "%[Type%] %v" - (const :tag "Insert name of file containing the message here." - :value message-file) - (string :format "%v")))) - :group 'gpg-commands) - -(defcustom gpg-command-sign-cleartext - '(gpg-2comp . ("--batch" "--passphrase-fd=0" "--output=-" - armor textmode "--clearsign" - sign-with-key)) - "Command to create a \"clearsign\" text file. -The invoked program has to read the passphrase from standard input, -followed by the message to sign. It should write the ASCII-amored -signed text message to standard output, and diagnostic messages to -standard error." - :tag "Clearsign Command" - :type 'gpg-command-sign-options - :group 'gpg-commands) - -(defcustom gpg-command-sign-detached - '(gpg-2comp . ("--batch" "--passphrase-fd=0" "--output=-" - armor textmode "--detach-sign" - sign-with-key)) - "Command to create a detached signature. -The invoked program has to read the passphrase from standard input, -followed by the message to sign. It should write the ASCII-amored -detached signature to standard output, and diagnostic messages to -standard error. The program shall not convert charsets or line -endings; the input data shall be treated as binary." - :tag "Sign Detached Command" - :type 'gpg-command-sign-options - :group 'gpg-commands) - -(defcustom gpg-command-sign-encrypt - '(gpg-2comp . ("--batch" "--passphrase-fd=0" "--output=-" - armor textmode "--always-trust" sign-with-key recipients - "--sign" "--encrypt" plaintext-file)) - "Command to sign and encrypt a file. -The invoked program has to read the passphrase from standard input, -followed by the message to sign and encrypt if there is no -`plaintext-file' placeholder. It should write the ASCII-amored -encrypted message to standard output, and diagnostic messages to -standard error." - :tag "Sign And Encrypt Command" - :type '(cons - gpg-command-program - (repeat - :tag "Arguments" - (choice - :format "%[Type%] %v" - (const :tag "Insert the `sign with key' option here if necessary." - :value sign-with-key) - (const :tag "Insert list of recipients here." - :value recipients) - (const :tag "Insert here name of file with plaintext." - :value plaintext-file) - (string :format "%v")))) - :group 'gpg-commands) - -(defcustom gpg-command-encrypt - '(gpg-2comp . ("--batch" "--output=-" armor textmode "--always-trust" - "--encrypt" recipients plaintext-file)) - "Command to encrypt a file. -The invoked program has to read the message to encrypt from standard -input or from the plaintext file (if the `plaintext-file' placeholder -is present). It should write the ASCII-amored encrypted message to -standard output, and diagnostic messages to standard error." - :type '(cons - gpg-command-program - (repeat - :tag "Arguments" - (choice - :format "%[Type%] %v" - (const :tag "Insert list of recipients here." - :value recipients) - (const :tag "Insert here name of file with plaintext." - :value plaintext-file) - (string :format "%v")))) - :group 'gpg-commands) - -;;; Customization: Variables: Key Management Commands: - -(defcustom gpg-command-key-import - '(gpg . ("--import" "--verbose" message-file)) - "Command to import a public key from a file." - :tag "Import Command" - :type '(cons - gpg-command-program - (repeat - :tag "Arguments" - (choice - :format "%[Type%] %v" - (const :tag "Insert name of file containing the key here." - :value message-file) - (string :format "%v")))) - :group 'gpg-commands-key) - -(defcustom gpg-command-key-export - '(gpg . ("--no-verbose" "--armor" "--export" key-id)) - "Command to export a public key from the key ring. -The key should be written to standard output using ASCII armor." - :tag "Export Command" - :type 'gpg-command-key-options - :group 'gpg-commands-key) - -(defcustom gpg-command-key-verify - '(gpg . ("--no-verbose" "--batch" "--fingerprint" "--check-sigs" key-id)) - "Command to verify a public key." - :tag "Verification Command" - :type 'gpg-command-key-options - :group 'gpg-commands-key) - -(defcustom gpg-command-key-public-ring - '(gpg . ("--no-verbose" "--batch" "--with-colons" "--list-keys" key-id)) - "Command to list the contents of the public key ring." - :tag "List Public Key Ring Command" - :type 'gpg-command-key-options - :group 'gpg-commands-key) - -(defcustom gpg-command-key-secret-ring - '(gpg . ("--no-verbose" "--batch" "--with-colons" - "--list-secret-keys" key-id)) - "Command to list the contents of the secret key ring." - :tag "List Secret Key Ring Command" - :type 'gpg-command-key-options - :group 'gpg-commands-key) - -(defcustom gpg-command-key-retrieve - '(gpg . ("--batch" "--recv-keys" key-id)) - "Command to retrieve public keys." - :tag "Retrieve Keys Command" - :type 'gpg-command-key-options - :group 'gpg-commands-key) - - -;;;; Helper functions for GnuPG invocation: - -;;; Build the GnuPG command line: - -(defun gpg-build-argument (template substitutions &optional pass-start) - "Build command line argument(s) by substituting placeholders. -TEMPLATE is a list of strings and symbols. The placeholder symbols in -it are replaced by SUBSTITUTIONS, the elements between -`next-argument' symbols are concatenated without spaces and are -returned in a list. - -SUBSTITIONS is a list of (SYMBOL . SEXP) pairs, where SEXP is either -a string (which is inserted literally), a list of strings (which are -inserted as well), or nil, which means to insert nothing. - -If PASS-START is t, `next-argument' is also inserted into the result, -and symbols without a proper substitution are retained in the output, -otherwise, an untranslated symbol results in an error. - -This function does not handle empty arguments reliably." - (let ((current-arg "") - (arglist nil)) - (while template - (let* ((templ (pop template)) - (repl (assoc templ substitutions)) - (new (if repl (cdr repl) templ))) - (cond - ((eq templ 'next-argument) - ;; If the current argument is not empty, start a new one. - (unless (equal current-arg "") - (setq arglist (nconc arglist - (if pass-start - (list current-arg 'next-argument) - (list current-arg)))) - (setq current-arg ""))) - ((null new) nil) ; Drop it. - ((and (not (stringp templ)) (null repl)) - ;; Retain an untranslated symbol in the output if - ;; `pass-start' is true. - (unless pass-start - (error "No replacement for `%s'" templ)) - (setq arglist (nconc arglist (list current-arg templ))) - (setq current-arg "")) - (t - (unless (listp new) - (setq new (list new))) - (setq current-arg (concat current-arg - (apply 'concat new))))))) - (unless (equal current-arg "") - (setq arglist (nconc arglist (list current-arg)))) - arglist)) - -(defun gpg-build-arg-list (template substitutions) - "Build command line by substituting placeholders. -TEMPLATE is a list of strings and symbols. The placeholder symbols in -it are replaced by SUBSTITUTIONS. - -SUBSTITIONS is a list of (SYMBOL . SEXP) pairs, where SEXP is either a -string (which is inserted literally), a list of strings (which are -inserted as well), or nil, which means to insert nothing." - (let ((arglist (copy-sequence gpg-command-all-arglist))) - (while template - (let* ((templ (pop template)) - (repl (assoc templ substitutions)) - (new (if repl (cdr repl) templ))) - (cond - ((and (symbolp templ) (null repl)) - (error "No replacement for `%s'" templ)) - ((null new) nil) ; Drop it. - (t - (unless (listp new) - (setq new (list new))) - (setq arglist (nconc arglist new)))))) - arglist)) - -(defun gpg-build-flag-recipients-one (recipient) - "Build argument for one RECIPIENT." - (gpg-build-argument (cdr gpg-command-flag-recipient) - `((recipient . ,recipient)) t)) - -(defun gpg-build-flag-recipients (recipients) - "Build list of RECIPIENTS using `gpg-command-flag-recipient'." - (gpg-build-argument - (apply 'append (car gpg-command-flag-recipient) - (mapcar 'gpg-build-flag-recipients-one - recipients)) - nil)) - -(defun gpg-read-recipients () - "Query the user for several recipients." - (let ((go t) - recipients r) - (while go - (setq r (read-string "Enter recipient ID [RET when no more]: ")) - (if (equal r "") - (setq go nil) - (setq recipients (nconc recipients (list r))))) - recipients)) - -(defun gpg-build-flag-sign-with-key (key) - "Build sign with key flag using `gpg-command-flag-sign-with-key'." - (let ((k (if key key - (if gpg-default-key-id gpg-default-key-id - nil)))) - (if k - (gpg-build-argument gpg-command-flag-sign-with-key - (list (cons 'sign-with-key k))) - nil))) - -(defmacro gpg-with-passphrase-env (&rest body) - "Adjust the process environment and evaluate BODY. -During the evaluation of the body forms, the process environment is -adjust according to `gpg-command-passphrase-env'." - (let ((env-value (make-symbol "env-value"))) - `(let ((,env-value)) - (unwind-protect - (progn - (when gpg-command-passphrase-env - (setq ,env-value (getenv (car gpg-command-passphrase-env))) - (setenv (car gpg-command-passphrase-env) - (cdr gpg-command-passphrase-env))) - ,@body) - (when gpg-command-passphrase-env - ;; This will clear the variable if it wasn't set before. - (setenv (car gpg-command-passphrase-env) ,env-value)))))) -(put 'gpg-with-passphrase-env 'lisp-indent-function 0) -(put 'gpg-with-passphrase-env 'edebug-form-spec '(body)) - -;;; Temporary files: - -(defun gpg-make-temp-file () - "Create a temporary file in a safe way" - (let ((name ;; User may use "~/" - (expand-file-name "gnupg" gpg-temp-directory))) - (if (fboundp 'make-temp-file) - ;; If we've got make-temp-file, we are on the save side. - (make-temp-file name) - ;; make-temp-name doesn't create the file, and an ordinary - ;; write-file operation is prone to nasty symlink attacks if the - ;; temporary file resides in a world-writable directory. - (unless (or (memq system-type '(windows-nt cygwin32 win32 w32 mswindows)) - (eq (file-modes gpg-temp-directory) 448)) ; mode 0700 - (error "Directory for temporary files (%s) must have mode 0700" gpg-temp-directory)) - (setq name (make-temp-name name)) - (let ((mode (default-file-modes))) - (unwind-protect - (progn - (set-default-file-modes 384) ; mode 0600 - (with-temp-file name)) - (set-default-file-modes mode))) - name))) - -(defvar gpg-temp-files nil - "List of temporary files used by the GnuPG interface. -Do not set this variable. Call `gpg-with-temp-files' if you need -temporary files.") - -(defun gpg-with-temp-files-create (count) - "Do not call this function. Used internally by `gpg-with-temp-files'." - (while (> count 0) - (setq gpg-temp-files (cons (gpg-make-temp-file) gpg-temp-files)) - (setq count (1- count)))) - -(defun gpg-with-temp-files-delete () - "Do not call this function. Used internally by `gpg-with-temp-files'." - (while gpg-temp-files - (let ((file (pop gpg-temp-files))) - (condition-case nil - (delete-file file) - (error nil))))) - -(defmacro gpg-with-temp-files (count &rest body) - "Create COUNT temporary files, USE them, and delete them. -The function USE is called with the names of all temporary files as -arguments." - `(let ((gpg-temp-files)) - (unwind-protect - (progn - ;; Create the temporary files. - (gpg-with-temp-files-create ,count) - ,@body) - (gpg-with-temp-files-delete)))) -(put 'gpg-with-temp-files 'lisp-indent-function 1) -(put 'gpg-with-temp-files 'edebug-form-spec '(body)) - -;;; Making subprocesses: - -(defun gpg-exec-path (option) - "Return the program name for OPTION. -OPTION is of the form (PROGRAM . ARGLIST). This functions returns -PROGRAM, but takes default values into account." - (let* ((prg (car option)) - (path (assq prg gpg-command-default-alist))) - (cond - (path (if (null (cdr path)) - (error "Command `%s' is not available" prg) - (cdr path))) - ((null prg) (error "Command is disabled")) - (t prg)))) - -(defun gpg-call-process (cmd args stdin stdout stderr &optional passphrase) - "Invoke external program CMD with ARGS on buffer STDIN. -Standard output is insert before point in STDOUT, standard error in -STDERR. If PASSPHRASE is given, send it before STDIN. PASSPHRASE -should not end with a line feed (\"\\n\"). - -If `stdin-file' is present in ARGS, it is replaced by the name of a -temporary file. Before invoking CMD, the contents of STDIN is written -to this file." - (gpg-with-temp-files 2 - (let* ((coding-system-for-read 'no-conversion) - (coding-system-for-write 'no-conversion) - (have-stdin-file (memq 'stdin-file args)) - (stdin-file (nth 0 gpg-temp-files)) - (stderr-file (nth 1 gpg-temp-files)) - (cpr-args `(,cmd - nil ; don't delete - (,stdout ,stderr-file) - nil ; don't display - ;; Replace `stdin-file'. - ,@(gpg-build-arg-list - args (list (cons 'stdin-file stdin-file))))) - res) - (when have-stdin-file - (with-temp-file stdin-file - (buffer-disable-undo) - (insert-buffer-substring stdin))) - (setq res - (if passphrase - (with-temp-buffer - (buffer-disable-undo) - (insert passphrase "\n") - (unless have-stdin-file - (apply 'insert-buffer-substring - (if (listp stdin) stdin (list stdin)))) - (apply 'call-process-region (point-min) (point-max) cpr-args) - ;; Wipe out passphrase. - (goto-char (point-min)) - (translate-region (point) (gpg-point-at-eol) - (make-string 256 ? ))) - (if (listp stdin) - (with-current-buffer (car stdin) - (apply 'call-process-region - (cadr stdin) - (if have-stdin-file (cadr stdin) (caddr stdin)) - cpr-args)) - (with-current-buffer stdin - (apply 'call-process-region - (point-min) - (if have-stdin-file (point-min) (point-max)) - cpr-args))))) - (with-current-buffer stderr - (insert-file-contents-literally stderr-file)) - (if (or (stringp res) (> res 0)) - ;; Signal or abnormal exit. - (with-current-buffer stderr - (goto-char (point-max)) - (insert (format "\nCommand exit status: %s\n" res)) - nil) - t)))) - -(defvar gpg-result-buffer nil - "The result of a GnuPG operation is stored in this buffer. -Never set this variable directly, use `gpg-show-result' instead.") - -(defun gpg-show-result-buffer (always-show result) - "Called by `gpg-show-results' to actually show the buffer." - (with-current-buffer gpg-result-buffer - ;; Only proceed if the buffer is non-empty. - (when (and (/= (point-min) (point-max)) - (or always-show (not result))) - (save-window-excursion - (display-buffer (current-buffer)) - (unless (y-or-n-p "Continue? ") - (error "GnuPG operation aborted")))))) - -(defmacro gpg-show-result (always-show &rest body) - "Show GnuPG result to user for confirmation. -This macro binds `gpg-result-buffer' to a temporary buffer and -evaluates BODY, like `progn'. If BODY evaluates to `nil' (or -`always-show' is not nil), the user is asked for confirmation." - `(let ((gpg-result-buffer (get-buffer-create - (generate-new-buffer-name "*GnuPG Output*")))) - (unwind-protect - (gpg-show-result-buffer ,always-show (progn ,@body)) - (kill-buffer gpg-result-buffer)))) -(put 'gpg-show-result 'lisp-indent-function 1) -(put 'gpg-show-result 'edebug-form-spec '(body)) - -;;; Passphrase handling: - -(defvar gpg-passphrase-timer - (gpg-timer-create) - "This timer will clear the passphrase cache periodically.") - -(defvar gpg-passphrase - nil - "The (unencrypted) passphrase cache.") - -(defun gpg-passphrase-clear-string (str) - "Erases STR by overwriting all characters." - (let ((pos 0) - (len (length str))) - (while (< pos len) - (aset str pos ? ) - (incf pos)))) - -;;;###autoload -(defun gpg-passphrase-forget () - "Forget stored passphrase." - (interactive) - (when gpg-passphrase - (gpg-cancel-timer gpg-passphrase-timer) - (setq gpg-passphrase-timer nil) - (gpg-passphrase-clear-string gpg-passphrase) - (setq gpg-passphrase nil))) - -(defun gpg-passphrase-store (passphrase) - "Store PASSPHRASE in cache. -Updates the timeout for clearing the cache to `gpg-passphrase-timeout'." - (unless (equal gpg-passphrase-timeout 0) - (if (null gpg-passphrase-timer) - (setq gpg-passphrase-timer (gpg-timer-create))) - (gpg-timer-set-time gpg-passphrase-timer - (timer-relative-time (current-time) - gpg-passphrase-timeout)) - (gpg-timer-set-function gpg-passphrase-timer 'gpg-passphrase-forget) - (unless (and (fboundp 'itimer-live-p) - (itimer-live-p gpg-passphrase-timer)) - (gpg-timer-activate gpg-passphrase-timer)) - (setq gpg-passphrase passphrase)) - passphrase) - -(defun gpg-passphrase-read () - "Read a passphrase and remember it for some time." - (interactive) - (if gpg-passphrase - ;; This reinitializes the timer. - (gpg-passphrase-store gpg-passphrase) - (let ((pp (read-passwd "Enter passphrase: "))) - (gpg-passphrase-store pp)))) - - -;;;; Main operations: - -;;;###autoload -(defun gpg-verify (message signature result) - "Verify buffer MESSAGE against detached SIGNATURE buffer. -Returns t if everything worked out well, nil otherwise. Consult -buffer RESULT for details." - (interactive "bBuffer containing message: \nbBuffer containing signature: \nbBuffor for result: ") - (gpg-with-temp-files 2 - (let* ((sig-file (nth 0 gpg-temp-files)) - (msg-file (nth 1 gpg-temp-files)) - (cmd (gpg-exec-path gpg-command-verify)) - (args (gpg-build-arg-list (cdr gpg-command-verify) - `((signature-file . ,sig-file) - (message-file . ,msg-file)))) - res) - (with-temp-file sig-file - (buffer-disable-undo) - (apply 'insert-buffer-substring (if (listp signature) - signature - (list signature)))) - (with-temp-file msg-file - (buffer-disable-undo) - (apply 'insert-buffer-substring (if (listp message) - message - (list message)))) - (setq res (apply 'call-process-region - (point-min) (point-min) ; no data - cmd - nil ; don't delete - result - nil ; don't display - args)) - (if (or (stringp res) (> res 0)) - ;; Signal or abnormal exit. - (with-current-buffer result - (insert (format "\nCommand exit status: %s\n" res)) - nil) - t)))) - -;;;###autoload -(defun gpg-verify-cleartext (message result) - "Verify message in buffer MESSAGE. -Returns t if everything worked out well, nil otherwise. Consult -buffer RESULT for details. - -NOTE: Use of this function is deprecated." - (interactive "bBuffer containing message: \nbBuffor for result: ") - (gpg-with-temp-files 1 - (let* ((msg-file (nth 0 gpg-temp-files)) - (cmd (gpg-exec-path gpg-command-verify-cleartext)) - (args (gpg-build-arg-list (cdr gpg-command-verify-cleartext) - `((message-file . ,msg-file)))) - res) - (with-temp-file msg-file - (buffer-disable-undo) - (apply 'insert-buffer-substring (if (listp message) - message - (list message)))) - (setq res (apply 'call-process-region - (point-min) (point-min) ; no data - cmd - nil ; don't delete - result - nil ; don't display - args)) - (if (or (stringp res) (> res 0)) - ;; Signal or abnormal exit. - (with-current-buffer result - (insert (format "\nCommand exit status: %s\n" res)) - nil) - t)))) - -;;;###autoload -(defun gpg-decrypt (ciphertext plaintext result &optional passphrase) - "Decrypt buffer CIPHERTEXT to buffer PLAINTEXT. -Returns t if everything worked out well, nil otherwise. Consult -buffer RESULT for details. Reads a missing PASSPHRASE using -`gpg-passphrase-read'." - (interactive "bBuffer containing ciphertext: \nbBuffer for plaintext: \nbBuffor for decryption status: ") - (gpg-call-process (gpg-exec-path gpg-command-decrypt) - (gpg-build-arg-list (cdr gpg-command-decrypt) nil) - ciphertext plaintext result - (if passphrase passphrase (gpg-passphrase-read))) - (when passphrase - (gpg-passphrase-clear-string passphrase))) - -;;;###autoload -(defun gpg-sign-cleartext - (plaintext signed-text result &optional passphrase sign-with-key) - "Sign buffer PLAINTEXT, and store PLAINTEXT with signature in -SIGNED-TEXT. -Reads a missing PASSPHRASE using `gpg-passphrase-read'. Uses key ID -SIGN-WITH-KEY if given, otherwise the default key ID. Returns t if -everything worked out well, nil otherwise. Consult buffer RESULT for -details. - -NOTE: Use of this function is deprecated." - (interactive "bBuffer containing plaintext: \nbBuffer for text with signature: \nbBuffer for status information: ") - (let ((subst (list (cons 'sign-with-key - (gpg-build-flag-sign-with-key sign-with-key)) - (cons 'armor gpg-command-flag-armor) - (cons 'textmode gpg-command-flag-textmode)))) - (gpg-call-process (gpg-exec-path gpg-command-sign-cleartext) - (gpg-build-arg-list (cdr gpg-command-sign-cleartext) - subst) - plaintext signed-text result - (if passphrase passphrase (gpg-passphrase-read)))) - (when passphrase - (gpg-passphrase-clear-string passphrase))) - -;;;###autoload -(defun gpg-sign-detached - (plaintext signature result &optional passphrase sign-with-key - armor textmode) - "Sign buffer PLAINTEXT, and store SIGNATURE in that buffer. -Reads a missing PASSPHRASE using `gpg-passphrase-read'. Uses key ID -SIGN-WITH-KEY if given, otherwise the default key ID. Returns t if -everything worked out well, nil otherwise. Consult buffer RESULT for -details. ARMOR the result and activate canonical TEXTMODE if -requested." - (interactive "bBuffer containing plaintext: \nbBuffer for text with signature: \nbBuffer for status information: ") - (let ((subst (list (cons 'sign-with-key - (gpg-build-flag-sign-with-key sign-with-key)) - (cons 'armor (if armor gpg-command-flag-armor)) - (cons 'textmode (if armor gpg-command-flag-textmode))))) - (gpg-call-process (gpg-exec-path gpg-command-sign-detached) - (gpg-build-arg-list (cdr gpg-command-sign-detached) - subst) - plaintext signature result - (if passphrase passphrase (gpg-passphrase-read)))) - (when passphrase - (gpg-passphrase-clear-string passphrase))) - - -;;;###autoload -(defun gpg-sign-encrypt - (plaintext ciphertext result recipients &optional passphrase sign-with-key - armor textmode) - "Sign buffer PLAINTEXT, and store SIGNATURE in that buffer. -RECIPIENTS is a list of key IDs used for encryption. This function -reads a missing PASSPHRASE using `gpg-passphrase-read', and uses key -ID SIGN-WITH-KEY for the signature if given, otherwise the default key -ID. Returns t if everything worked out well, nil otherwise. Consult -buffer RESULT for details. ARMOR the result and activate canonical -TEXTMODE if requested." - (interactive (list - (read-buffer "Buffer containing plaintext: " nil t) - (read-buffer "Buffer for ciphertext: " nil t) - (read-buffer "Buffer for status informationt: " nil t) - (gpg-read-recipients))) - (let ((subst `((sign-with-key . ,(gpg-build-flag-sign-with-key - sign-with-key)) - (plaintext-file . stdin-file) - (recipients . ,(gpg-build-flag-recipients recipients)) - (armor ,(if armor gpg-command-flag-armor)) - (textmode ,(if armor gpg-command-flag-textmode))))) - (gpg-call-process (gpg-exec-path gpg-command-sign-encrypt) - (gpg-build-arg-list (cdr gpg-command-sign-encrypt) - subst) - plaintext ciphertext result - (if passphrase passphrase (gpg-passphrase-read)))) - (when passphrase - (gpg-passphrase-clear-string passphrase))) - - -;;;###autoload -(defun gpg-encrypt - (plaintext ciphertext result recipients &optional passphrase armor textmode) - "Encrypt buffer PLAINTEXT, and store CIPHERTEXT in that buffer. -RECIPIENTS is a list of key IDs used for encryption. Returns t if -everything worked out well, nil otherwise. Consult buffer RESULT for -details. ARMOR the result and activate canonical -TEXTMODE if requested." - (interactive (list - (read-buffer "Buffer containing plaintext: " nil t) - (read-buffer "Buffer for ciphertext: " nil t) - (read-buffer "Buffer for status informationt: " nil t) - (gpg-read-recipients))) - (let ((subst `((plaintext-file . stdin-file) - (recipients . ,(gpg-build-flag-recipients recipients)) - (armor ,(if armor gpg-command-flag-armor)) - (textmode ,(if armor gpg-command-flag-textmode))))) - (gpg-call-process (gpg-exec-path gpg-command-encrypt) - (gpg-build-arg-list (cdr gpg-command-encrypt) subst) - plaintext ciphertext result nil)) - (when passphrase - (gpg-passphrase-clear-string passphrase))) - - -;;;; Key management - -;;; ADT: OpenPGP Key - -(defun gpg-key-make (user-id key-id unique-id length algorithm - creation-date expire-date validity trust) - "Create a new key object (for internal use only)." - (vector - ;; 0 1 2 3 4 - user-id key-id unique-id length algorithm - ;; 5 6 7 8 - creation-date expire-date validity trust)) - - -(defun gpg-key-p (key) - "Return t if KEY is a key specification." - (and (arrayp key) (equal (length key) 9) key)) - -(defmacro gpg-key-primary-user-id (key) - "The primary user ID for KEY (human-readable). -DO NOT USE this ID for selecting recipients. It is probably not -unique." - (list 'car (list 'aref key 0))) - -(defmacro gpg-key-user-ids (key) - "A list of additional user IDs for KEY (human-readable). -DO NOT USE these IDs for selecting recipients. They are probably not -unique." - (list 'cdr (list 'aref key 0))) - -(defmacro gpg-key-id (key) - "The key ID of KEY. -DO NOT USE this ID for selecting recipients. It is not guaranteed to -be unique." - (list 'aref key 1)) - -(defun gpg-short-key-id (key) - "The short key ID of KEY." - (let* ((id (gpg-key-id key)) - (len (length id))) - (if (> len 8) - (substring id (- len 8)) - id))) - -(defmacro gpg-key-unique-id (key) - "A non-standard ID of KEY which is only valid locally. -This ID can be used to specify recipients in a safe manner. Note, -even this ID might not be unique unless GnuPG is used." - (list 'aref key 2)) - -(defmacro gpg-key-unique-id-list (key-list) - "Like `gpg-key-unique-id', but operate on a list." - `(mapcar (lambda (key) (gpg-key-unique-id key)) - ,key-list)) - -(defmacro gpg-key-length (key) - "Returns the key length." - (list 'aref key 3)) - -(defmacro gpg-key-algorithm (key) - "The encryption algorithm used by KEY. -One of the symbols `rsa', `rsa-encrypt', `rsa-sign', `elgamal', -`elgamal-encrypt', `dsa'." - (list 'aref key 4)) - -(defmacro gpg-key-creation-date (key) - "A string with the creation date of KEY in ISO format." - (list 'aref key 5)) - -(defmacro gpg-key-expire-date (key) - "A string with the expiration date of KEY in ISO format." - (list 'aref key 6)) - -(defmacro gpg-key-validity (key) - "The calculated validity of KEY. -One of the symbols `not-known', `disabled', `revoked', `expired', -`undefined', `trust-none', `trust-marginal', `trust-full', -`trust-ultimate' (see the GnuPG documentation for details)." - (list 'aref key 7)) - -(defmacro gpg-key-trust (key) - "The assigned trust for KEY. -One of the symbols `not-known', `undefined', `trust-none', -`trust-marginal', `trust-full' (see the GnuPG -documentation for details)." - (list 'aref key 8)) - -(defun gpg-key-lessp (a b) - "Returns t if primary user ID of A is less than B." - (string-lessp (gpg-key-primary-user-id a) (gpg-key-primary-user-id b) )) - -;;; Accessing the key database: - -;; Internal functions: - -(defmacro gpg-key-list-keys-skip-field () - '(search-forward ":" eol 'move)) - -(defmacro gpg-key-list-keys-get-field () - '(buffer-substring (point) (if (gpg-key-list-keys-skip-field) - (1- (point)) - eol))) -(defmacro gpg-key-list-keys-string-field () - '(gpg-key-list-keys-get-field)) - -(defmacro gpg-key-list-keys-read-field () - (let ((field (make-symbol "field"))) - `(let ((,field (gpg-key-list-keys-get-field))) - (if (equal (length ,field) 0) - nil - (read ,field))))) - -(defun gpg-key-list-keys-parse-line () - "Parse the line in the current buffer and return a vector of fields." - (let* ((eol (gpg-point-at-eol)) - (v (if (eolp) - nil - (vector - (gpg-key-list-keys-read-field) ; type - (gpg-key-list-keys-get-field) ; trust - (gpg-key-list-keys-read-field) ; key length - (gpg-key-list-keys-read-field) ; algorithm - (gpg-key-list-keys-get-field) ; key ID - (gpg-key-list-keys-get-field) ; creation data - (gpg-key-list-keys-get-field) ; expire - (gpg-key-list-keys-get-field) ; unique (local) ID - (gpg-key-list-keys-get-field) ; ownertrust - (gpg-key-list-keys-string-field) ; user ID - )))) - (if (eolp) - (when v - (forward-char 1)) - (error "Too many fields in GnuPG key database")) - v)) - -(defconst gpg-pubkey-algo-alist - '((1 . rsa) - (2 . rsa-encrypt-only) - (3 . rsa-sign-only) - (16 . elgamal-encrypt-only) - (17 . dsa) - (20 . elgamal)) - "Alist mapping OpenPGP public key algorithm numbers to symbols.") - -(defconst gpg-trust-alist - '((?- . not-known) - (?o . not-known) - (?d . disabled) - (?r . revoked) - (?e . expired) - (?q . trust-undefined) - (?n . trust-none) - (?m . trust-marginal) - (?f . trust-full) - (?u . trust-ultimate)) - "Alist mapping GnuPG trust value short forms to long symbols.") - -(defconst gpg-unabbrev-trust-alist - '(("TRUST_UNDEFINED" . trust-undefined) - ("TRUST_NEVER" . trust-none) - ("TRUST_MARGINAL" . trust-marginal) - ("TRUST_FULLY" . trust-full) - ("TRUST_ULTIMATE" . trust-ultimate)) - "Alist mapping capitalized GnuPG trust values to long symbols.") - -(defmacro gpg-key-list-keys-in-buffer-store () - '(when primary-user-id - (sort user-id 'string-lessp) - (push (gpg-key-make (cons primary-user-id user-id) - key-id unique-id key-length - algorithm creation-date - expire-date validity trust) - key-list))) - -(defun gpg-key-list-keys-in-buffer (&optional buffer) - "Return a list of keys for BUFFER. -If BUFFER is omitted, use current buffer." - (with-current-buffer (if buffer buffer (current-buffer)) - (goto-char (point-min)) - ;; Skip key ring filename written by GnuPG. - (search-forward "\n---------------------------\n" nil t) - ;; Loop over all lines in buffer and analyze them. - (let (primary-user-id user-id key-id unique-id ; current key components - key-length algorithm creation-date expire-date validity trust - line ; fields in current line - key-list) ; keys gather so far - - (while (setq line (gpg-key-list-keys-parse-line)) - (cond - ;; Public or secret key. - ((memq (aref line 0) '(pub sec)) - ;; Store previous key, if any. - (gpg-key-list-keys-in-buffer-store) - ;; Record field values. - (setq primary-user-id (aref line 9)) - (setq user-id nil) - (setq key-id (aref line 4)) - ;; We use the key ID if no unique ID is available. - (setq unique-id (if (> (length (aref line 7)) 0) - (concat "#" (aref line 7)) - (concat "0x" key-id))) - (setq key-length (aref line 2)) - (setq algorithm (assq (aref line 3) gpg-pubkey-algo-alist)) - (if algorithm - (setq algorithm (cdr algorithm)) - (error "Unknown algorithm %s" (aref line 3))) - (setq creation-date (if (> (length (aref line 5)) 0) - (aref line 5))) - (setq expire-date (if (> (length (aref line 6)) 0) - (aref line 6))) - (setq validity (assq (aref (aref line 1) 0) gpg-trust-alist)) - (if validity - (setq validity (cdr validity)) - (error "Unknown validity specification %S" (aref line 1))) - (setq trust (assq (aref (aref line 8) 0) gpg-trust-alist)) - (if trust - (setq trust (cdr trust)) - (error "Unknown trust specification %S" (aref line 8)))) - - ;; Additional user ID - ((eq 'uid (aref line 0)) - (setq user-id (cons (aref line 9) user-id))) - - ;; Subkeys are ignored for now. - ((memq (aref line 0) '(sub ssb)) - t) - (t (error "Unknown record type %S" (aref line 0))))) - - ;; Store the key retrieved last. - (gpg-key-list-keys-in-buffer-store) - ;; Sort the keys according to the primary user ID. - (sort key-list 'gpg-key-lessp)))) - -(defun gpg-key-list-keyspec (command &optional keyspec stderr ignore-error) - "Insert the output of COMMAND before point in current buffer." - (let* ((cmd (gpg-exec-path command)) - (key (if (equal keyspec "") nil keyspec)) - (args (gpg-build-arg-list (cdr command) `((key-id . ,key)))) - exit-status) - (setq exit-status - (apply 'call-process-region - (point-min) (point-min) ; no data - cmd - nil ; don't delete - (if stderr t '(t nil)) - nil ; don't display - args)) - (unless (or ignore-error (equal exit-status 0)) - (error "GnuPG command exited unsuccessfully")))) - - -(defun gpg-key-list-keyspec-parse (command &optional keyspec) - "Return a list of keys matching KEYSPEC. -COMMAND is used to obtain the key list. The usual substring search -for keys is performed." - (with-temp-buffer - (buffer-disable-undo) - (gpg-key-list-keyspec command keyspec) - (gpg-key-list-keys-in-buffer))) - -;;;###autoload -(defun gpg-key-list-keys (&optional keyspec) - "A list of public keys matching KEYSPEC. -The usual substring search for keys is performed." - (gpg-key-list-keyspec-parse gpg-command-key-public-ring keyspec)) - -;;;###autoload -(defun gpg-key-list-secret-keys (&optional keyspec) - "A list of secret keys matching KEYSPEC. -The usual substring search for keys is performed." - (gpg-key-list-keyspec-parse gpg-command-key-secret-ring keyspec)) - -;;;###autoload -(defun gpg-key-insert-public-key (key) - "Inserts the public key(s) matching KEYSPEC. -The ASCII-armored key is inserted before point into current buffer." - (gpg-key-list-keyspec gpg-command-key-export key)) - -;;;###autoload -(defun gpg-key-insert-information (key) - "Insert human-readable information (including fingerprint) on KEY. -Insertion takes place in current buffer before point." - (gpg-key-list-keyspec gpg-command-key-verify key)) - -;;;###autoload -(defun gpg-key-retrieve (key) - "Fetch KEY from default key server. -KEY is a key ID or a list of key IDs. Status information about this -operation is inserted into the current buffer before point." - (gpg-key-list-keyspec gpg-command-key-retrieve key t t)) - -;;;###autoload -(defun gpg-key-add-to-ring (key result) - "Adds key in buffer KEY to the GnuPG key ring. -Human-readable information on the RESULT is stored in buffer RESULT -before point.") - -(provide 'gpg) - -;;; arch-tag: c972455d-9bc5-4de1-9dc7-4f494d63053b -;;; gpg.el ends here diff --git a/xemacs-packages/gnus/lisp/hashcash.el b/xemacs-packages/gnus/lisp/hashcash.el deleted file mode 100644 index 2a860705..00000000 --- a/xemacs-packages/gnus/lisp/hashcash.el +++ /dev/null @@ -1,220 +0,0 @@ -;;; hashcash.el --- Add hashcash payments to email - -;; Copyright (C) 2002, 2003, 2005 Free Software Foundation -;; Copyright (C) 1997--2002 Paul E. Foley - -;; Maintainer: Paul Foley -;; Keywords: mail, hashcash - -;; Released under the GNU General Public License -;; (http://www.gnu.org/licenses/gpl.html) - -;;; Commentary: - -;; The hashcash binary is at http://www.cypherspace.org/hashcash/ -;; -;; Call mail-add-payment to add a hashcash payment to a mail message -;; in the current buffer. -;; -;; To automatically add payments to all outgoing mail: -;; (add-hook 'message-send-hook 'mail-add-payment) - -;;; Code: - -(eval-and-compile - (autoload 'executable-find "executable")) - -(defgroup hashcash nil - "Hashcash configuration." - :group 'mail) - -(defcustom hashcash-default-payment 0 - "*The default number of bits to pay to unknown users. -If this is zero, no payment header will be generated. -See `hashcash-payment-alist'." - :type 'integer - :group 'hashcash) - -(defcustom hashcash-payment-alist '() - "*An association list mapping email addresses to payment amounts. -Elements may consist of (ADDR AMOUNT) or (ADDR STRING AMOUNT), where -ADDR is the email address of the intended recipient and AMOUNT is -the value of hashcash payment to be made to that user. STRING, if -present, is the string to be hashed; if not present ADDR will be used." - :group 'hashcash) - -(defcustom hashcash-default-accept-payment 10 - "*The default minimum number of bits to accept on incoming payments." - :type 'integer - :group 'hashcash) - -(defcustom hashcash-accept-resources `((,user-mail-address nil)) - "*An association list mapping hashcash resources to payment amounts. -Resources named here are to be accepted in incoming payments. If the -corresponding AMOUNT is NIL, the value of `hashcash-default-accept-payment' -is used instead." - :group 'hashcash) - -(defcustom hashcash-path (executable-find "hashcash") - "*The path to the hashcash binary." - :group 'hashcash) - -(defcustom hashcash-double-spend-database "hashcash.db" - "*The path to the double-spending database." - :group 'hashcash) - -(defcustom hashcash-in-news nil - "*Specifies whether or not hashcash payments should be made to newsgroups." - :type 'boolean - :group 'hashcash) - -(require 'mail-utils) - -(eval-and-compile - (if (fboundp 'point-at-bol) - (defalias 'hashcash-point-at-bol 'point-at-bol) - (defalias 'hashcash-point-at-bol 'line-beginning-position)) - - (if (fboundp 'point-at-eol) - (defalias 'hashcash-point-at-eol 'point-at-eol) - (defalias 'hashcash-point-at-eol 'line-end-position))) - -(defun hashcash-strip-quoted-names (addr) - (setq addr (mail-strip-quoted-names addr)) - (if (and addr (string-match "\\`\\([^+@]+\\)\\+[^@]*\\(@.+\\)" addr)) - (concat (match-string 1 addr) (match-string 2 addr)) - addr)) - -(defun hashcash-payment-required (addr) - "Return the hashcash payment value required for the given address." - (let ((val (assoc addr hashcash-payment-alist))) - (or (nth 2 val) (nth 1 val) hashcash-default-payment))) - -(defun hashcash-payment-to (addr) - "Return the string with which hashcash payments should collide." - (let ((val (assoc addr hashcash-payment-alist))) - (or (nth 1 val) (nth 0 val) addr))) - -(defun hashcash-generate-payment (str val) - "Generate a hashcash payment by finding a VAL-bit collison on STR." - (if (> val 0) - (save-excursion - (set-buffer (get-buffer-create " *hashcash*")) - (erase-buffer) - (call-process hashcash-path nil t nil - "-m" "-q" "-b" (number-to-string val) str) - (goto-char (point-min)) - (buffer-substring (hashcash-point-at-bol) (hashcash-point-at-eol))) - nil)) - -(defun hashcash-check-payment (token str val) - "Check the validity of a hashcash payment." - (zerop (call-process hashcash-path nil nil nil "-c" - "-d" "-f" hashcash-double-spend-database - "-b" (number-to-string val) - "-r" str - token))) - -(defun hashcash-version (token) - "Find the format version of a hashcash token." - ;; Version 1.2 looks like n:yymmdd:rrrrr:xxxxxxxxxxxxxxxx - ;; This carries its own version number embedded in the token, - ;; so no further format number changes should be necessary - ;; in the X-Payment header. - ;; - ;; Version 1.1 looks like yymmdd:rrrrr:xxxxxxxxxxxxxxxx - ;; You need to upgrade your hashcash binary. - ;; - ;; Version 1.0 looked like nnnnnrrrrrxxxxxxxxxxxxxxxx - ;; This is no longer supported. - (cond ((equal (aref token 1) ?:) 1.2) - ((equal (aref token 6) ?:) 1.1) - (t (error "Unknown hashcash format version")))) - -;;;###autoload -(defun hashcash-insert-payment (arg) - "Insert X-Payment and X-Hashcash headers with a payment for ARG" - (interactive "sPay to: ") - (let ((pay (hashcash-generate-payment (hashcash-payment-to arg) - (hashcash-payment-required arg)))) - (when pay -; (insert-before-markers "X-Payment: hashcash " -; (number-to-string (hashcash-version pay)) " " -; pay "\n") - (insert-before-markers "X-Hashcash: " pay "\n")))) - -;;;###autoload -(defun hashcash-verify-payment (token &optional resource amount) - "Verify a hashcash payment" - (let ((key (if (< (hashcash-version token) 1.2) - (nth 1 (split-string token ":")) - (nth 2 (split-string token ":"))))) - (cond ((null resource) - (let ((elt (assoc key hashcash-accept-resources))) - (and elt (hashcash-check-payment token (car elt) - (or (cadr elt) hashcash-default-accept-payment))))) - ((equal token key) - (hashcash-check-payment token resource - (or amount hashcash-default-accept-payment))) - (t nil)))) - -;;;###autoload -(defun mail-add-payment (&optional arg) - "Add X-Payment: and X-Hashcash: headers with a hashcash payment -for each recipient address. Prefix arg sets default payment temporarily." - (interactive "P") - (let ((hashcash-default-payment (if arg (prefix-numeric-value arg) - hashcash-default-payment)) - (addrlist nil)) - (save-excursion - (save-restriction - (goto-char (point-min)) - (search-forward mail-header-separator) - (beginning-of-line) - (narrow-to-region (point-min) (point)) - (let ((to (hashcash-strip-quoted-names (mail-fetch-field "To" nil t))) - (cc (hashcash-strip-quoted-names (mail-fetch-field "Cc" nil t))) - (ng (hashcash-strip-quoted-names (mail-fetch-field "Newsgroups" - nil t)))) - (when to - (setq addrlist (split-string to ",[ \t\n]*"))) - (when cc - (setq addrlist (nconc addrlist (split-string cc ",[ \t\n]*")))) - (when (and hashcash-in-news ng) - (setq addrlist (nconc addrlist (split-string ng ",[ \t\n]*"))))) - (when addrlist - (mapcar #'hashcash-insert-payment addrlist))))) ; mapc - t) - -;;;###autoload -(defun mail-check-payment (&optional arg) - "Look for a valid X-Payment: or X-Hashcash: header. -Prefix arg sets default accept amount temporarily." - (interactive "P") - (let ((hashcash-default-accept-payment (if arg (prefix-numeric-value arg) - hashcash-default-accept-payment)) - (version (hashcash-version (hashcash-generate-payment "x" 1)))) - (save-excursion - (goto-char (point-min)) - (search-forward "\n\n") - (beginning-of-line) - (let ((end (point)) - (ok nil)) - (goto-char (point-min)) - (while (and (not ok) (search-forward "X-Payment: hashcash " end t)) - (let ((value (split-string - (buffer-substring (point) (hashcash-point-at-eol)) - " "))) - (when (equal (car value) (number-to-string version)) - (setq ok (hashcash-verify-payment (cadr value)))))) - (goto-char (point-min)) - (while (and (not ok) (search-forward "X-Hashcash: " end t)) - (setq ok (hashcash-verify-payment - (buffer-substring (point) (hashcash-point-at-eol))))) - (when ok - (message "Payment valid")) - ok)))) - -(provide 'hashcash) - -;;; arch-tag: 0e7fe983-a124-4392-9788-0dbcbd2c4d62 diff --git a/xemacs-packages/gnus/lisp/html2text.el b/xemacs-packages/gnus/lisp/html2text.el deleted file mode 100644 index e08ffbc8..00000000 --- a/xemacs-packages/gnus/lisp/html2text.el +++ /dev/null @@ -1,481 +0,0 @@ -;;; html2text.el --- a simple html to plain text converter - -;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Joakim Hove - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; These functions provide a simple way to wash/clean html infected -;; mails. Definitely do not work in all cases, but some improvement -;; in readability is generally obtained. Formatting is only done in -;; the buffer, so the next time you enter the article it will be -;; "re-htmlized". -;; -;; The main function is `html2text'. - -;;; Code: - -;; -;; -;; - -(eval-when-compile - (require 'cl)) - -(defvar html2text-format-single-element-list '(("hr" . html2text-clean-hr))) - -(defvar html2text-replace-list - '((" " . " ") (">" . ">") ("<" . "<") (""" . "\"") - ("&" . "&") ("'" . "'")) - "The map of entity to text. - -This is an alist were each element is a dotted pair consisting of an -old string, and a replacement string. This replacement is done by the -function `html2text-substitute' which basically performs a -`replace-string' operation for every element in the list. This is -completely verbatim - without any use of REGEXP.") - -(defvar html2text-remove-tag-list - '("html" "body" "p" "img" "dir" "head" "div" "br" "font" "title" "meta") - "A list of removable tags. - -This is a list of tags which should be removed, without any -formatting. Note that tags in the list are presented *without* -any \"<\" or \">\". All occurrences of a tag appearing in this -list are removed, irrespective of whether it is a closing or -opening tag, or if the tag has additional attributes. The -deletion is done by the function `html2text-remove-tags'. - -For instance the text: - -\"Here comes something big .\" - -will be reduced to: - -\"Here comes something big.\" - -If this list contains the element \"font\".") - -(defvar html2text-format-tag-list - '(("b" . html2text-clean-bold) - ("strong" . html2text-clean-bold) - ("u" . html2text-clean-underline) - ("i" . html2text-clean-italic) - ("em" . html2text-clean-italic) - ("blockquote" . html2text-clean-blockquote) - ("a" . html2text-clean-anchor) - ("ul" . html2text-clean-ul) - ("ol" . html2text-clean-ol) - ("dl" . html2text-clean-dl) - ("center" . html2text-clean-center)) - "An alist of tags and processing functions. - -This is an alist where each dotted pair consists of a tag, and then -the name of a function to be called when this tag is found. The -function is called with the arguments p1, p2, p3 and p4. These are -demontrated below: - -\" This is bold text \" - ^ ^ ^ ^ - | | | | -p1 p2 p3 p4 - -Then the called function will typically format the text somewhat and -remove the tags.") - -(defvar html2text-remove-tag-list2 '("li" "dt" "dd" "meta") - "Another list of removable tags. - -This is a list of tags which are removed similarly to the list -`html2text-remove-tag-list' - but these tags are retained for the -formatting, and then moved afterward.") - -;; -;; -;; - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; -;; -;; - - -(defun html2text-replace-string (from-string to-string min max) - "Replace FROM-STRING with TO-STRING in region from MIN to MAX." - (goto-char min) - (let ((delta (- (string-width to-string) (string-width from-string))) - (change 0)) - (while (search-forward from-string max t) - (replace-match to-string) - (setq change (+ change delta))) - change)) - -;; -;; -;; - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; -;; i.e. -;; - -(defun html2text-attr-value (list attribute) - "Get value of ATTRIBUTE from LIST." - (nth 1 (assoc attribute list))) - -(defun html2text-get-attr (p1 p2) - (goto-char p1) - (re-search-forward " +[^ ]" p2 t) - (let* ((attr-string (buffer-substring-no-properties (1- (point)) (1- p2))) - (tmp-list (split-string attr-string)) - (attr-list) - (counter 0) - (prev (car tmp-list)) - (this (nth 1 tmp-list)) - (next (nth 2 tmp-list)) - (index 1)) - - (cond - ;; size=3 - ((string-match "[^ ]=[^ ]" prev) - (let ((attr (nth 0 (split-string prev "="))) - (value (nth 1 (split-string prev "=")))) - (setq attr-list (cons (list attr value) attr-list)))) - ;; size= 3 - ((string-match "[^ ]=\\'" prev) - (setq attr-list (cons (list (substring prev 0 -1) this) attr-list)))) - - (while (< index (length tmp-list)) - (cond - ;; size=3 - ((string-match "[^ ]=[^ ]" this) - (let ((attr (nth 0 (split-string this "="))) - (value (nth 1 (split-string this "=")))) - (setq attr-list (cons (list attr value) attr-list)))) - ;; size =3 - ((string-match "\\`=[^ ]" this) - (setq attr-list (cons (list prev (substring this 1)) attr-list))) - ;; size= 3 - ((string-match "[^ ]=\\'" this) - (setq attr-list (cons (list (substring this 0 -1) next) attr-list))) - ;; size = 3 - ((string= "=" this) - (setq attr-list (cons (list prev next) attr-list)))) - (setq index (1+ index)) - (setq prev this) - (setq this next) - (setq next (nth (1+ index) tmp-list))) - ;; - ;; Tags with no accompanying "=" i.e. value=nil - ;; - (setq prev (car tmp-list)) - (setq this (nth 1 tmp-list)) - (setq next (nth 2 tmp-list)) - (setq index 1) - - (when (and (not (string-match "=" prev)) - (not (string= (substring this 0 1) "="))) - (setq attr-list (cons (list prev nil) attr-list))) - (while (< index (1- (length tmp-list))) - (when (and (not (string-match "=" this)) - (not (or (string= (substring next 0 1) "=") - (string= (substring prev -1) "=")))) - (setq attr-list (cons (list this nil) attr-list))) - (setq index (1+ index)) - (setq prev this) - (setq this next) - (setq next (nth (1+ index) tmp-list))) - - (when (and this - (not (string-match "=" this)) - (not (string= (substring prev -1) "="))) - (setq attr-list (cons (list this nil) attr-list))) - ;; return - value - attr-list)) - -;; -;; -;; - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; -;; -;; -(defun html2text-clean-list-items (p1 p2 list-type) - (goto-char p1) - (let ((item-nr 0) - (items 0)) - (while (re-search-forward "
  • " p2 t) - (setq items (1+ items))) - (goto-char p1) - (while (< item-nr items) - (setq item-nr (1+ item-nr)) - (re-search-forward "
  • " (point-max) t) - (cond - ((string= list-type "ul") (insert " o ")) - ((string= list-type "ol") (insert (format " %s: " item-nr))) - (t (insert " x ")))))) - -(defun html2text-clean-dtdd (p1 p2) - (goto-char p1) - (let ((items 0) - (item-nr 0)) - (while (re-search-forward "
    " p2 t) - (setq items (1+ items))) - (goto-char p1) - (while (< item-nr items) - (setq item-nr (1+ item-nr)) - (re-search-forward "
    \\([ ]*\\)" (point-max) t) - (when (match-string 1) - (delete-region (point) (- (point) (string-width (match-string 1))))) - (let ((def-p1 (point)) - (def-p2 0)) - (re-search-forward "\\([ ]*\\)\\(
    \\|
    \\)" (point-max) t) - (if (match-string 1) - (progn - (let* ((mw1 (string-width (match-string 1))) - (mw2 (string-width (match-string 2))) - (mw (+ mw1 mw2))) - (goto-char (- (point) mw)) - (delete-region (point) (+ (point) mw1)) - (setq def-p2 (point)))) - (setq def-p2 (- (point) (string-width (match-string 2))))) - (put-text-property def-p1 def-p2 'face 'bold))))) - -(defun html2text-delete-tags (p1 p2 p3 p4) - (delete-region p1 p2) - (delete-region (- p3 (- p2 p1)) (- p4 (- p2 p1)))) - -(defun html2text-delete-single-tag (p1 p2) - (delete-region p1 p2)) - -(defun html2text-clean-hr (p1 p2) - (html2text-delete-single-tag p1 p2) - (goto-char p1) - (newline 1) - (insert (make-string fill-column ?-))) - -(defun html2text-clean-ul (p1 p2 p3 p4) - (html2text-delete-tags p1 p2 p3 p4) - (html2text-clean-list-items p1 (- p3 (- p1 p2)) "ul")) - -(defun html2text-clean-ol (p1 p2 p3 p4) - (html2text-delete-tags p1 p2 p3 p4) - (html2text-clean-list-items p1 (- p3 (- p1 p2)) "ol")) - -(defun html2text-clean-dl (p1 p2 p3 p4) - (html2text-delete-tags p1 p2 p3 p4) - (html2text-clean-dtdd p1 (- p3 (- p1 p2)))) - -(defun html2text-clean-center (p1 p2 p3 p4) - (html2text-delete-tags p1 p2 p3 p4) - (center-region p1 (- p3 (- p2 p1)))) - -(defun html2text-clean-bold (p1 p2 p3 p4) - (put-text-property p2 p3 'face 'bold) - (html2text-delete-tags p1 p2 p3 p4)) - -(defun html2text-clean-title (p1 p2 p3 p4) - (put-text-property p2 p3 'face 'bold) - (html2text-delete-tags p1 p2 p3 p4)) - -(defun html2text-clean-underline (p1 p2 p3 p4) - (put-text-property p2 p3 'face 'underline) - (html2text-delete-tags p1 p2 p3 p4)) - -(defun html2text-clean-italic (p1 p2 p3 p4) - (put-text-property p2 p3 'face 'italic) - (html2text-delete-tags p1 p2 p3 p4)) - -(defun html2text-clean-font (p1 p2 p3 p4) - (html2text-delete-tags p1 p2 p3 p4)) - -(defun html2text-clean-blockquote (p1 p2 p3 p4) - (html2text-delete-tags p1 p2 p3 p4)) - -(defun html2text-clean-anchor (p1 p2 p3 p4) - ;; If someone can explain how to make the URL clickable I will surely - ;; improve upon this. - ;; Maybe `goto-addr.el' can be used here. - (let* ((attr-list (html2text-get-attr p1 p2)) - (href (html2text-attr-value attr-list "href"))) - (delete-region p1 p4) - (when href - (goto-char p1) - (insert (substring href 1 -1 )) - (put-text-property p1 (point) 'face 'bold)))) - -;; -;; -;; - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; -;; -;; - -(defun html2text-fix-paragraph (p1 p2) - (goto-char p1) - (let ((has-br-line) - (refill-start) - (refill-stop)) - (when (re-search-forward "
    $" p2 t) - (goto-char p1) - (when (re-search-forward ".+[^<][^b][^r][^>]$" p2 t) - (beginning-of-line) - (setq refill-start (point)) - (goto-char p2) - (re-search-backward ".+[^<][^b][^r][^>]$" refill-start t) - (forward-line 1) - (end-of-line) - ;; refill-stop should ideally be adjusted to - ;; accomodate the "
    " strings which are removed - ;; between refill-start and refill-stop. Can simply - ;; be returned from my-replace-string - (setq refill-stop (+ (point) - (html2text-replace-string - "
    " "" - refill-start (point)))) - ;; (message "Point = %s refill-stop = %s" (point) refill-stop) - ;; (sleep-for 4) - (fill-region refill-start refill-stop)))) - (html2text-replace-string "
    " "" p1 p2)) - -;; -;; This one is interactive ... -;; -(defun html2text-fix-paragraphs () - "This _tries_ to fix up the paragraphs - this is done in quite a ad-hook -fashion, quite close to pure guess-work. It does work in some cases though." - (interactive) - (goto-char (point-min)) - (while (re-search-forward "^
    $" nil t) - (delete-region (match-beginning 0) (match-end 0))) - ;; Removing lonely
    on a single line, if they are left intact we - ;; dont have any paragraphs at all. - (goto-char (point-min)) - (while (not (eobp)) - (let ((p1 (point))) - (forward-paragraph 1) - ;;(message "Kaller fix med p1=%s p2=%s " p1 (1- (point))) (sleep-for 5) - (html2text-fix-paragraph p1 (1- (point))) - (goto-char p1) - (when (not (eobp)) - (forward-paragraph 1))))) - -;; -;;     -;; - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; -;; -;; - -(defun html2text-remove-tags (tag-list) - "Removes the tags listed in the list `html2text-remove-tag-list'. -See the documentation for that variable." - (interactive) - (dolist (tag tag-list) - (goto-char (point-min)) - (while (re-search-forward (format "\\(]*>\\)" tag) (point-max) t) - (delete-region (match-beginning 0) (match-end 0))))) - -(defun html2text-format-tags () - "See the variable `html2text-format-tag-list' for documentation." - (interactive) - (dolist (tag-and-function html2text-format-tag-list) - (let ((tag (car tag-and-function)) - (function (cdr tag-and-function))) - (goto-char (point-min)) - (while (re-search-forward (format "\\(<%s\\( [^>]*\\)?>\\)" tag) - (point-max) t) - (let ((p1) - (p2 (point)) - (p3) (p4)) - (search-backward "<" (point-min) t) - (setq p1 (point)) - (unless (search-forward (format "" tag) (point-max) t) - (goto-char p2) - (insert (format "" tag))) - (setq p4 (point)) - (search-backward "]*\\)?>\\)" tag) - (point-max) t) - (let ((p1) - (p2 (point))) - (search-backward "<" (point-min) t) - (setq p1 (point)) - (funcall function p1 p2)))))) - -;; -;; Main function -;; - -;;;###autoload -(defun html2text () - "Convert HTML to plain text in the current buffer." - (interactive) - (save-excursion - (let ((case-fold-search t) - (buffer-read-only)) - (html2text-remove-tags html2text-remove-tag-list) - (html2text-format-tags) - (html2text-remove-tags html2text-remove-tag-list2) - (html2text-substitute) - (html2text-format-single-elements) - (html2text-fix-paragraphs)))) - -;; -;; -;; -(provide 'html2text) -;;; arch-tag: e9e57b79-35d4-4de1-a647-e7e01fe56d1e -;;; html2text.el ends here diff --git a/xemacs-packages/gnus/lisp/ietf-drums.el b/xemacs-packages/gnus/lisp/ietf-drums.el deleted file mode 100644 index fb6efe41..00000000 --- a/xemacs-packages/gnus/lisp/ietf-drums.el +++ /dev/null @@ -1,280 +0,0 @@ -;;; ietf-drums.el --- Functions for parsing RFC822bis headers - -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; DRUMS is an IETF Working Group that works (or worked) on the -;; successor to RFC822, "Standard For The Format Of Arpa Internet Text -;; Messages". This library is based on -;; draft-ietf-drums-msg-fmt-05.txt, released on 1998-08-05. - -;; Pending a real regression self test suite, Simon Josefsson added -;; various self test expressions snipped from bug reports, and their -;; expected value, below. I you believe it could be useful, please -;; add your own test cases, or write a real self test suite, or just -;; remove this. - -;; -;; (ietf-drums-parse-address "'foo' ") -;; => ("foo@example.com" . "'foo'") - -;;; Code: - -(eval-when-compile (require 'cl)) -(require 'time-date) -(require 'mm-util) - -(defvar ietf-drums-no-ws-ctl-token "\001-\010\013\014\016-\037\177" - "US-ASCII control characters excluding CR, LF and white space.") -(defvar ietf-drums-text-token "\001-\011\013\014\016-\177" - "US-ASCII characters excluding CR and LF.") -(defvar ietf-drums-specials-token "()<>[]:;@\\,.\"" - "Special characters.") -(defvar ietf-drums-quote-token "\\" - "Quote character.") -(defvar ietf-drums-wsp-token " \t" - "White space.") -(defvar ietf-drums-fws-regexp - (concat "[" ietf-drums-wsp-token "]*\n[" ietf-drums-wsp-token "]+") - "Folding white space.") -(defvar ietf-drums-atext-token "-^a-zA-Z0-9!#$%&'*+/=?_`{|}~" - "Textual token.") -(defvar ietf-drums-dot-atext-token "-^a-zA-Z0-9!#$%&'*+/=?_`{|}~." - "Textual token including full stop.") -(defvar ietf-drums-qtext-token - (concat ietf-drums-no-ws-ctl-token "\041\043-\133\135-\177") - "Non-white-space control characters, plus the rest of ASCII excluding -backslash and doublequote.") -(defvar ietf-drums-tspecials "][()<>@,;:\\\"/?=" - "Tspecials.") - -(defvar ietf-drums-syntax-table - (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table))) - (modify-syntax-entry ?\\ "/" table) - (modify-syntax-entry ?< "(" table) - (modify-syntax-entry ?> ")" table) - (modify-syntax-entry ?@ "w" table) - (modify-syntax-entry ?/ "w" table) - (modify-syntax-entry ?* "_" table) - (modify-syntax-entry ?\; "_" table) - (modify-syntax-entry ?\' "_" table) - (if (featurep 'xemacs) - (let ((i 128)) - (while (< i 256) - (modify-syntax-entry i "w" table) - (setq i (1+ i))))) - table)) - -(defun ietf-drums-token-to-list (token) - "Translate TOKEN into a list of characters." - (let ((i 0) - b e c out range) - (while (< i (length token)) - (setq c (mm-char-int (aref token i))) - (incf i) - (cond - ((eq c (mm-char-int ?-)) - (if b - (setq range t) - (push c out))) - (range - (while (<= b c) - (push (mm-make-char 'ascii b) out) - (incf b)) - (setq range nil)) - ((= i (length token)) - (push (mm-make-char 'ascii c) out)) - (t - (when b - (push (mm-make-char 'ascii b) out)) - (setq b c)))) - (nreverse out))) - -(defsubst ietf-drums-init (string) - (set-syntax-table ietf-drums-syntax-table) - (insert string) - (ietf-drums-unfold-fws) - (goto-char (point-min))) - -(defun ietf-drums-remove-comments (string) - "Remove comments from STRING." - (with-temp-buffer - (let (c) - (ietf-drums-init string) - (while (not (eobp)) - (setq c (char-after)) - (cond - ((eq c ?\") - (forward-sexp 1)) - ((eq c ?\() - (delete-region (point) (progn (forward-sexp 1) (point)))) - (t - (forward-char 1)))) - (buffer-string)))) - -(defun ietf-drums-remove-whitespace (string) - "Remove whitespace from STRING." - (with-temp-buffer - (ietf-drums-init string) - (let (c) - (while (not (eobp)) - (setq c (char-after)) - (cond - ((eq c ?\") - (forward-sexp 1)) - ((eq c ?\() - (forward-sexp 1)) - ((memq c '(?\ ?\t ?\n)) - (delete-char 1)) - (t - (forward-char 1)))) - (buffer-string)))) - -(defun ietf-drums-get-comment (string) - "Return the first comment in STRING." - (with-temp-buffer - (ietf-drums-init string) - (let (result c) - (while (not (eobp)) - (setq c (char-after)) - (cond - ((eq c ?\") - (forward-sexp 1)) - ((eq c ?\() - (setq result - (buffer-substring - (1+ (point)) - (progn (forward-sexp 1) (1- (point)))))) - (t - (forward-char 1)))) - result))) - -(defun ietf-drums-strip (string) - "Remove comments and whitespace from STRING." - (ietf-drums-remove-whitespace (ietf-drums-remove-comments string))) - -(defun ietf-drums-parse-address (string) - "Parse STRING and return a MAILBOX / DISPLAY-NAME pair." - (with-temp-buffer - (let (display-name mailbox c display-string) - (ietf-drums-init string) - (while (not (eobp)) - (setq c (char-after)) - (cond - ((or (eq c ? ) - (eq c ?\t)) - (forward-char 1)) - ((eq c ?\() - (forward-sexp 1)) - ((eq c ?\") - (push (buffer-substring - (1+ (point)) (progn (forward-sexp 1) (1- (point)))) - display-name)) - ((looking-at (concat "[" ietf-drums-atext-token "@" "]")) - (push (buffer-substring (point) (progn (forward-sexp 1) (point))) - display-name)) - ((eq c ?<) - (setq mailbox - (ietf-drums-remove-whitespace - (ietf-drums-remove-comments - (buffer-substring - (1+ (point)) - (progn (forward-sexp 1) (1- (point)))))))) - (t (error "Unknown symbol: %c" c)))) - ;; If we found no display-name, then we look for comments. - (if display-name - (setq display-string - (mapconcat 'identity (reverse display-name) " ")) - (setq display-string (ietf-drums-get-comment string))) - (if (not mailbox) - (when (string-match "@" display-string) - (cons - (mapconcat 'identity (nreverse display-name) "") - (ietf-drums-get-comment string))) - (cons mailbox display-string))))) - -(defun ietf-drums-parse-addresses (string) - "Parse STRING and return a list of MAILBOX / DISPLAY-NAME pairs." - (if (null string) - nil - (with-temp-buffer - (ietf-drums-init string) - (let ((beg (point)) - pairs c address) - (while (not (eobp)) - (setq c (char-after)) - (cond - ((memq c '(?\" ?< ?\()) - (condition-case nil - (forward-sexp 1) - (error - (skip-chars-forward "^,")))) - ((eq c ?,) - (setq address - (condition-case nil - (ietf-drums-parse-address - (buffer-substring beg (point))) - (error nil))) - (if address (push address pairs)) - (forward-char 1) - (setq beg (point))) - (t - (forward-char 1)))) - (setq address - (condition-case nil - (ietf-drums-parse-address - (buffer-substring beg (point))) - (error nil))) - (if address (push address pairs)) - (nreverse pairs))))) - -(defun ietf-drums-unfold-fws () - "Unfold folding white space in the current buffer." - (goto-char (point-min)) - (while (re-search-forward ietf-drums-fws-regexp nil t) - (replace-match " " t t)) - (goto-char (point-min))) - -(defun ietf-drums-parse-date (string) - "Return an Emacs time spec from STRING." - (apply 'encode-time (parse-time-string string))) - -(defun ietf-drums-narrow-to-header () - "Narrow to the header section in the current buffer." - (narrow-to-region - (goto-char (point-min)) - (if (re-search-forward "^\r?$" nil 1) - (match-beginning 0) - (point-max))) - (goto-char (point-min))) - -(defun ietf-drums-quote-string (string) - "Quote string if it needs quoting to be displayed in a header." - (if (string-match (concat "[^" ietf-drums-atext-token "]") string) - (concat "\"" string "\"") - string)) - -(provide 'ietf-drums) - -;;; arch-tag: 379a0191-dbae-4ca6-a0f5-d4202c209ef9 -;;; ietf-drums.el ends here diff --git a/xemacs-packages/gnus/lisp/imap.el b/xemacs-packages/gnus/lisp/imap.el deleted file mode 100644 index 82cb6784..00000000 --- a/xemacs-packages/gnus/lisp/imap.el +++ /dev/null @@ -1,2840 +0,0 @@ -;;; imap.el --- imap library - -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Simon Josefsson -;; Keywords: mail - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; imap.el is a elisp library providing an interface for talking to -;; IMAP servers. -;; -;; imap.el is roughly divided in two parts, one that parses IMAP -;; responses from the server and storing data into buffer-local -;; variables, and one for utility functions which send commands to -;; server, waits for an answer, and return information. The latter -;; part is layered on top of the previous. -;; -;; The imap.el API consist of the following functions, other functions -;; in this file should not be called directly and the result of doing -;; so are at best undefined. -;; -;; Global commands: -;; -;; imap-open, imap-opened, imap-authenticate, imap-close, -;; imap-capability, imap-namespace, imap-error-text -;; -;; Mailbox commands: -;; -;; imap-mailbox-get, imap-mailbox-map, imap-current-mailbox, -;; imap-current-mailbox-p, imap-search, imap-mailbox-select, -;; imap-mailbox-examine, imap-mailbox-unselect, imap-mailbox-expunge -;; imap-mailbox-close, imap-mailbox-create, imap-mailbox-delete -;; imap-mailbox-rename, imap-mailbox-lsub, imap-mailbox-list -;; imap-mailbox-subscribe, imap-mailbox-unsubscribe, imap-mailbox-status -;; imap-mailbox-acl-get, imap-mailbox-acl-set, imap-mailbox-acl-delete -;; -;; Message commands: -;; -;; imap-fetch-asynch, imap-fetch, -;; imap-current-message, imap-list-to-message-set, -;; imap-message-get, imap-message-map -;; imap-message-envelope-date, imap-message-envelope-subject, -;; imap-message-envelope-from, imap-message-envelope-sender, -;; imap-message-envelope-reply-to, imap-message-envelope-to, -;; imap-message-envelope-cc, imap-message-envelope-bcc -;; imap-message-envelope-in-reply-to, imap-message-envelope-message-id -;; imap-message-body, imap-message-flag-permanent-p -;; imap-message-flags-set, imap-message-flags-del -;; imap-message-flags-add, imap-message-copyuid -;; imap-message-copy, imap-message-appenduid -;; imap-message-append, imap-envelope-from -;; imap-body-lines -;; -;; It is my hope that these commands should be pretty self -;; explanatory for someone that know IMAP. All functions have -;; additional documentation on how to invoke them. -;; -;; imap.el support RFC1730/2060 (IMAP4/IMAP4rev1), implemented IMAP -;; extensions are RFC2195 (CRAM-MD5), RFC2086 (ACL), RFC2342 -;; (NAMESPACE), RFC2359 (UIDPLUS), the IMAP-part of RFC2595 (STARTTLS, -;; LOGINDISABLED) (with use of external library starttls.el and -;; program starttls) and the GSSAPI / kerberos V4 sections of RFC1731 -;; (with use of external program `imtest'). It also takes advantage of -;; the UNSELECT extension in Cyrus IMAPD. -;; -;; Without the work of John McClary Prevost and Jim Radford this library -;; would not have seen the light of day. Many thanks. -;; -;; This is a transcript of short interactive session for demonstration -;; purposes. -;; -;; (imap-open "my.mail.server") -;; => " *imap* my.mail.server:0" -;; -;; The rest are invoked with current buffer as the buffer returned by -;; `imap-open'. It is possible to do all without this, but it would -;; look ugly here since `buffer' is always the last argument for all -;; imap.el API functions. -;; -;; (imap-authenticate "myusername" "mypassword") -;; => auth -;; -;; (imap-mailbox-lsub "*") -;; => ("INBOX.sentmail" "INBOX.private" "INBOX.draft" "INBOX.spam") -;; -;; (imap-mailbox-list "INBOX.n%") -;; => ("INBOX.namedroppers" "INBOX.nnimap" "INBOX.ntbugtraq") -;; -;; (imap-mailbox-select "INBOX.nnimap") -;; => "INBOX.nnimap" -;; -;; (imap-mailbox-get 'exists) -;; => 166 -;; -;; (imap-mailbox-get 'uidvalidity) -;; => "908992622" -;; -;; (imap-search "FLAGGED SINCE 18-DEC-98") -;; => (235 236) -;; -;; (imap-fetch 235 "RFC822.PEEK" 'RFC822) -;; => "X-Sieve: cmu-sieve 1.3^M\nX-Username: ^M\r...." -;; -;; Todo: -;; -;; o Parse UIDs as strings? We need to overcome the 28 bit limit somehow. -;; o Don't use `read' at all (important places already fixed) -;; o Accept list of articles instead of message set string in most -;; imap-message-* functions. -;; o Send strings as literal if they contain, e.g., ". -;; -;; Revision history: -;; -;; - 19991218 added starttls/digest-md5 patch, -;; by Daiki Ueno -;; NB! you need SLIM for starttls.el and digest-md5.el -;; - 19991023 commited to pgnus -;; - -;;; Code: - -(eval-when-compile (require 'cl)) -(eval-and-compile - (autoload 'base64-decode-string "base64") - (autoload 'base64-encode-string "base64") - (autoload 'starttls-open-stream "starttls") - (autoload 'starttls-negotiate "starttls") - (autoload 'digest-md5-parse-digest-challenge "digest-md5") - (autoload 'digest-md5-digest-response "digest-md5") - (autoload 'digest-md5-digest-uri "digest-md5") - (autoload 'digest-md5-challenge "digest-md5") - (autoload 'rfc2104-hash "rfc2104") - (autoload 'md5 "md5") - (autoload 'utf7-encode "utf7") - (autoload 'utf7-decode "utf7") - (autoload 'format-spec "format-spec") - (autoload 'format-spec-make "format-spec") - (autoload 'open-tls-stream "tls") - ;; Avoid use gnus-point-at-eol so we're independent of Gnus. These - ;; days we have point-at-eol anyhow. - (if (fboundp 'point-at-eol) - (defalias 'imap-point-at-eol 'point-at-eol) - (defun imap-point-at-eol () - (save-excursion - (end-of-line) - (point))))) - -;; User variables. - -(defgroup imap nil - "Low-level IMAP issues." - :version "21.1" - :group 'mail) - -(defcustom imap-kerberos4-program '("imtest -m kerberos_v4 -u %l -p %p %s" - "imtest -kp %s %p") - "List of strings containing commands for Kerberos 4 authentication. -%s is replaced with server hostname, %p with port to connect to, and -%l with the value of `imap-default-user'. The program should accept -IMAP commands on stdin and return responses to stdout. Each entry in -the list is tried until a successful connection is made." - :group 'imap - :type '(repeat string)) - -(defcustom imap-gssapi-program (list - (concat "gsasl %s %p " - "--mechanism GSSAPI " - "--authentication-id %l") - "imtest -m gssapi -u %l -p %p %s") - "List of strings containing commands for GSSAPI (krb5) authentication. -%s is replaced with server hostname, %p with port to connect to, and -%l with the value of `imap-default-user'. The program should accept -IMAP commands on stdin and return responses to stdout. Each entry in -the list is tried until a successful connection is made." - :group 'imap - :type '(repeat string)) - -(defcustom imap-ssl-program '("openssl s_client -quiet -ssl3 -connect %s:%p" - "openssl s_client -quiet -ssl2 -connect %s:%p" - "s_client -quiet -ssl3 -connect %s:%p" - "s_client -quiet -ssl2 -connect %s:%p") - "A string, or list of strings, containing commands for SSL connections. -Within a string, %s is replaced with the server address and %p with -port number on server. The program should accept IMAP commands on -stdin and return responses to stdout. Each entry in the list is tried -until a successful connection is made." - :group 'imap - :type '(choice string - (repeat string))) - -(defcustom imap-shell-program '("ssh %s imapd" - "rsh %s imapd" - "ssh %g ssh %s imapd" - "rsh %g rsh %s imapd") - "A list of strings, containing commands for IMAP connection. -Within a string, %s is replaced with the server address, %p with port -number on server, %g with `imap-shell-host', and %l with -`imap-default-user'. The program should read IMAP commands from stdin -and write IMAP response to stdout. Each entry in the list is tried -until a successful connection is made." - :group 'imap - :type '(repeat string)) - -(defcustom imap-process-connection-type nil - "*Value for `process-connection-type' to use for Kerberos4, GSSAPI and SSL. -The `process-connection-type' variable control type of device -used to communicate with subprocesses. Values are nil to use a -pipe, or t or `pty' to use a pty. The value has no effect if the -system has no ptys or if all ptys are busy: then a pipe is used -in any case. The value takes effect when a IMAP server is -opened, changing it after that has no effect." - :version "22.1" - :group 'imap - :type 'boolean) - -(defcustom imap-use-utf7 t - "If non-nil, do utf7 encoding/decoding of mailbox names. -Since the UTF7 decoding currently only decodes into ISO-8859-1 -characters, you may disable this decoding if you need to access UTF7 -encoded mailboxes which doesn't translate into ISO-8859-1." - :group 'imap - :type 'boolean) - -(defcustom imap-log nil - "If non-nil, a imap session trace is placed in *imap-log* buffer. -Note that username, passwords and other privacy sensitive -information (such as e-mail) may be stored in the *imap-log* -buffer. It is not written to disk, however. Do not enable this -variable unless you are comfortable with that." - :group 'imap - :type 'boolean) - -(defcustom imap-debug nil - "If non-nil, random debug spews are placed in *imap-debug* buffer. -Note that username, passwords and other privacy sensitive -information (such as e-mail) may be stored in the *imap-debug* -buffer. It is not written to disk, however. Do not enable this -variable unless you are comfortable with that." - :group 'imap - :type 'boolean) - -(defcustom imap-shell-host "gateway" - "Hostname of rlogin proxy." - :group 'imap - :type 'string) - -(defcustom imap-default-user (user-login-name) - "Default username to use." - :group 'imap - :type 'string) - -(defcustom imap-read-timeout (if (string-match - "windows-nt\\|os/2\\|emx\\|cygwin" - (symbol-name system-type)) - 1.0 - 0.1) - "*How long to wait between checking for the end of output. -Shorter values mean quicker response, but is more CPU intensive." - :type 'number - :group 'imap) - -(defcustom imap-store-password nil - "If non-nil, store session password without promting." - :group 'imap - :type 'boolean) - -;; Various variables. - -(defvar imap-fetch-data-hook nil - "Hooks called after receiving each FETCH response.") - -(defvar imap-streams '(gssapi kerberos4 starttls tls ssl network shell) - "Priority of streams to consider when opening connection to server.") - -(defvar imap-stream-alist - '((gssapi imap-gssapi-stream-p imap-gssapi-open) - (kerberos4 imap-kerberos4-stream-p imap-kerberos4-open) - (tls imap-tls-p imap-tls-open) - (ssl imap-ssl-p imap-ssl-open) - (network imap-network-p imap-network-open) - (shell imap-shell-p imap-shell-open) - (starttls imap-starttls-p imap-starttls-open)) - "Definition of network streams. - -\(NAME CHECK OPEN) - -NAME names the stream, CHECK is a function returning non-nil if the -server support the stream and OPEN is a function for opening the -stream.") - -(defvar imap-authenticators '(gssapi - kerberos4 - digest-md5 - cram-md5 - login - anonymous) - "Priority of authenticators to consider when authenticating to server.") - -(defvar imap-authenticator-alist - '((gssapi imap-gssapi-auth-p imap-gssapi-auth) - (kerberos4 imap-kerberos4-auth-p imap-kerberos4-auth) - (cram-md5 imap-cram-md5-p imap-cram-md5-auth) - (login imap-login-p imap-login-auth) - (anonymous imap-anonymous-p imap-anonymous-auth) - (digest-md5 imap-digest-md5-p imap-digest-md5-auth)) - "Definition of authenticators. - -\(NAME CHECK AUTHENTICATE) - -NAME names the authenticator. CHECK is a function returning non-nil if -the server support the authenticator and AUTHENTICATE is a function -for doing the actual authentication.") - -(defvar imap-error nil - "Error codes from the last command.") - -;; Internal constants. Change these and die. - -(defconst imap-default-port 143) -(defconst imap-default-ssl-port 993) -(defconst imap-default-tls-port 993) -(defconst imap-default-stream 'network) -(defconst imap-coding-system-for-read 'binary) -(defconst imap-coding-system-for-write 'binary) -(defconst imap-local-variables '(imap-server - imap-port - imap-client-eol - imap-server-eol - imap-auth - imap-stream - imap-username - imap-password - imap-current-mailbox - imap-current-target-mailbox - imap-message-data - imap-capability - imap-namespace - imap-state - imap-reached-tag - imap-failed-tags - imap-tag - imap-process - imap-calculate-literal-size-first - imap-mailbox-data)) -(defconst imap-log-buffer "*imap-log*") -(defconst imap-debug-buffer "*imap-debug*") - -;; Internal variables. - -(defvar imap-stream nil) -(defvar imap-auth nil) -(defvar imap-server nil) -(defvar imap-port nil) -(defvar imap-username nil) -(defvar imap-password nil) -(defvar imap-calculate-literal-size-first nil) -(defvar imap-state 'closed - "IMAP state. -Valid states are `closed', `initial', `nonauth', `auth', `selected' -and `examine'.") - -(defvar imap-server-eol "\r\n" - "The EOL string sent from the server.") - -(defvar imap-client-eol "\r\n" - "The EOL string we send to the server.") - -(defvar imap-current-mailbox nil - "Current mailbox name.") - -(defvar imap-current-target-mailbox nil - "Current target mailbox for COPY and APPEND commands.") - -(defvar imap-mailbox-data nil - "Obarray with mailbox data.") - -(defvar imap-mailbox-prime 997 - "Length of imap-mailbox-data.") - -(defvar imap-current-message nil - "Current message number.") - -(defvar imap-message-data nil - "Obarray with message data.") - -(defvar imap-message-prime 997 - "Length of imap-message-data.") - -(defvar imap-capability nil - "Capability for server.") - -(defvar imap-namespace nil - "Namespace for current server.") - -(defvar imap-reached-tag 0 - "Lower limit on command tags that have been parsed.") - -(defvar imap-failed-tags nil - "Alist of tags that failed. -Each element is a list with four elements; tag (a integer), response -state (a symbol, `OK', `NO' or `BAD'), response code (a string), and -human readable response text (a string).") - -(defvar imap-tag 0 - "Command tag number.") - -(defvar imap-process nil - "Process.") - -(defvar imap-continuation nil - "Non-nil indicates that the server emitted a continuation request. -The actual value is really the text on the continuation line.") - -(defvar imap-callbacks nil - "List of response tags and callbacks, on the form `(number . function)'. -The function should take two arguments, the first the IMAP tag and the -second the status (OK, NO, BAD etc) of the command.") - - -;; Utility functions: - -(defun imap-remassoc (key alist) - "Delete by side effect any elements of LIST whose car is `equal' to KEY. -The modified LIST is returned. If the first member -of LIST has a car that is `equal' to KEY, there is no way to remove it -by side effect; therefore, write `(setq foo (remassoc key foo))' to be -sure of changing the value of `foo'." - (when alist - (if (equal key (caar alist)) - (cdr alist) - (setcdr alist (imap-remassoc key (cdr alist))) - alist))) - -(defsubst imap-disable-multibyte () - "Enable multibyte in the current buffer." - (when (fboundp 'set-buffer-multibyte) - (set-buffer-multibyte nil))) - -(defsubst imap-utf7-encode (string) - (if imap-use-utf7 - (and string - (condition-case () - (utf7-encode string t) - (error (message - "imap: Could not UTF7 encode `%s', using it unencoded..." - string) - string))) - string)) - -(defsubst imap-utf7-decode (string) - (if imap-use-utf7 - (and string - (condition-case () - (utf7-decode string t) - (error (message - "imap: Could not UTF7 decode `%s', using it undecoded..." - string) - string))) - string)) - -(defsubst imap-ok-p (status) - (if (eq status 'OK) - t - (setq imap-error status) - nil)) - -(defun imap-error-text (&optional buffer) - (with-current-buffer (or buffer (current-buffer)) - (nth 3 (car imap-failed-tags)))) - - -;; Server functions; stream stuff: - -(defun imap-kerberos4-stream-p (buffer) - (imap-capability 'AUTH=KERBEROS_V4 buffer)) - -(defun imap-kerberos4-open (name buffer server port) - (let ((cmds imap-kerberos4-program) - cmd done) - (while (and (not done) (setq cmd (pop cmds))) - (message "Opening Kerberos 4 IMAP connection with `%s'..." cmd) - (erase-buffer) - (let* ((port (or port imap-default-port)) - (coding-system-for-read imap-coding-system-for-read) - (coding-system-for-write imap-coding-system-for-write) - (process-connection-type imap-process-connection-type) - (process (start-process - name buffer shell-file-name shell-command-switch - (format-spec - cmd - (format-spec-make - ?s server - ?p (number-to-string port) - ?l imap-default-user)))) - response) - (when process - (with-current-buffer buffer - (setq imap-client-eol "\n" - imap-calculate-literal-size-first t) - (while (and (memq (process-status process) '(open run)) - (set-buffer buffer) ;; XXX "blue moon" nntp.el bug - (goto-char (point-min)) - ;; Athena IMTEST can output SSL verify errors - (or (while (looking-at "^verify error:num=") - (forward-line)) - t) - (or (while (looking-at "^TLS connection established") - (forward-line)) - t) - ;; cyrus 1.6.x (13? < x <= 22) queries capabilities - (or (while (looking-at "^C:") - (forward-line)) - t) - ;; cyrus 1.6 imtest print "S: " before server greeting - (or (not (looking-at "S: ")) - (forward-char 3) - t) - (not (and (imap-parse-greeting) - ;; success in imtest < 1.6: - (or (re-search-forward - "^__\\(.*\\)__\n" nil t) - ;; success in imtest 1.6: - (re-search-forward - "^\\(Authenticat.*\\)" nil t)) - (setq response (match-string 1))))) - (accept-process-output process 1) - (sit-for 1)) - (and imap-log - (with-current-buffer (get-buffer-create imap-log-buffer) - (imap-disable-multibyte) - (buffer-disable-undo) - (goto-char (point-max)) - (insert-buffer-substring buffer))) - (erase-buffer) - (message "Opening Kerberos 4 IMAP connection with `%s'...%s" cmd - (if response (concat "done, " response) "failed")) - (if (and response (let ((case-fold-search nil)) - (not (string-match "failed" response)))) - (setq done process) - (if (memq (process-status process) '(open run)) - (imap-send-command "LOGOUT")) - (delete-process process) - nil))))) - done)) - -(defun imap-gssapi-stream-p (buffer) - (imap-capability 'AUTH=GSSAPI buffer)) - -(defun imap-gssapi-open (name buffer server port) - (let ((cmds imap-gssapi-program) - cmd done) - (while (and (not done) (setq cmd (pop cmds))) - (message "Opening GSSAPI IMAP connection with `%s'..." cmd) - (erase-buffer) - (let* ((port (or port imap-default-port)) - (coding-system-for-read imap-coding-system-for-read) - (coding-system-for-write imap-coding-system-for-write) - (process-connection-type imap-process-connection-type) - (process (start-process - name buffer shell-file-name shell-command-switch - (format-spec - cmd - (format-spec-make - ?s server - ?p (number-to-string port) - ?l imap-default-user)))) - response) - (when process - (with-current-buffer buffer - (setq imap-client-eol "\n" - imap-calculate-literal-size-first t) - (while (and (memq (process-status process) '(open run)) - (set-buffer buffer) ;; XXX "blue moon" nntp.el bug - (goto-char (point-min)) - ;; Athena IMTEST can output SSL verify errors - (or (while (looking-at "^verify error:num=") - (forward-line)) - t) - (or (while (looking-at "^TLS connection established") - (forward-line)) - t) - ;; cyrus 1.6.x (13? < x <= 22) queries capabilities - (or (while (looking-at "^C:") - (forward-line)) - t) - ;; cyrus 1.6 imtest print "S: " before server greeting - (or (not (looking-at "S: ")) - (forward-char 3) - t) - ;; GNU SASL may print 'Trying ...' first. - (or (not (looking-at "Trying ")) - (forward-line) - t) - (not (and (imap-parse-greeting) - ;; success in imtest 1.6: - (re-search-forward - (concat "^\\(\\(Authenticat.*\\)\\|\\(" - "Client authentication " - "finished.*\\)\\)") - nil t) - (setq response (match-string 1))))) - (accept-process-output process 1) - (sit-for 1)) - (and imap-log - (with-current-buffer (get-buffer-create imap-log-buffer) - (imap-disable-multibyte) - (buffer-disable-undo) - (goto-char (point-max)) - (insert-buffer-substring buffer))) - (erase-buffer) - (message "GSSAPI IMAP connection: %s" (or response "failed")) - (if (and response (let ((case-fold-search nil)) - (not (string-match "failed" response)))) - (setq done process) - (if (memq (process-status process) '(open run)) - (imap-send-command "LOGOUT")) - (delete-process process) - nil))))) - done)) - -(defun imap-ssl-p (buffer) - nil) - -(defun imap-ssl-open (name buffer server port) - "Open a SSL connection to server." - (let ((cmds (if (listp imap-ssl-program) imap-ssl-program - (list imap-ssl-program))) - cmd done) - (while (and (not done) (setq cmd (pop cmds))) - (message "imap: Opening SSL connection with `%s'..." cmd) - (erase-buffer) - (let* ((port (or port imap-default-ssl-port)) - (coding-system-for-read imap-coding-system-for-read) - (coding-system-for-write imap-coding-system-for-write) - (process-connection-type imap-process-connection-type) - (set-process-query-on-exit-flag - (if (fboundp 'set-process-query-on-exit-flag) - 'set-process-query-on-exit-flag - 'process-kill-without-query)) - process) - (when (progn - (setq process (start-process - name buffer shell-file-name - shell-command-switch - (format-spec cmd - (format-spec-make - ?s server - ?p (number-to-string port))))) - (funcall set-process-query-on-exit-flag process nil) - process) - (with-current-buffer buffer - (goto-char (point-min)) - (while (and (memq (process-status process) '(open run)) - (set-buffer buffer) ;; XXX "blue moon" nntp.el bug - (goto-char (point-max)) - (forward-line -1) - (not (imap-parse-greeting))) - (accept-process-output process 1) - (sit-for 1)) - (and imap-log - (with-current-buffer (get-buffer-create imap-log-buffer) - (imap-disable-multibyte) - (buffer-disable-undo) - (goto-char (point-max)) - (insert-buffer-substring buffer))) - (erase-buffer) - (when (memq (process-status process) '(open run)) - (setq done process)))))) - (if done - (progn - (message "imap: Opening SSL connection with `%s'...done" cmd) - done) - (message "imap: Opening SSL connection with `%s'...failed" cmd) - nil))) - -(defun imap-tls-p (buffer) - nil) - -(defun imap-tls-open (name buffer server port) - (let* ((port (or port imap-default-tls-port)) - (coding-system-for-read imap-coding-system-for-read) - (coding-system-for-write imap-coding-system-for-write) - (process (open-tls-stream name buffer server port))) - (when process - (while (and (memq (process-status process) '(open run)) - (set-buffer buffer) ;; XXX "blue moon" nntp.el bug - (goto-char (point-max)) - (forward-line -1) - (not (imap-parse-greeting))) - (accept-process-output process 1) - (sit-for 1)) - (and imap-log - (with-current-buffer (get-buffer-create imap-log-buffer) - (imap-disable-multibyte) - (buffer-disable-undo) - (goto-char (point-max)) - (insert-buffer-substring buffer))) - (when (memq (process-status process) '(open run)) - process)))) - -(defun imap-network-p (buffer) - t) - -(defun imap-network-open (name buffer server port) - (let* ((port (or port imap-default-port)) - (coding-system-for-read imap-coding-system-for-read) - (coding-system-for-write imap-coding-system-for-write) - (process (open-network-stream name buffer server port))) - (when process - (while (and (memq (process-status process) '(open run)) - (set-buffer buffer) ;; XXX "blue moon" nntp.el bug - (goto-char (point-min)) - (not (imap-parse-greeting))) - (accept-process-output process 1) - (sit-for 1)) - (and imap-log - (with-current-buffer (get-buffer-create imap-log-buffer) - (imap-disable-multibyte) - (buffer-disable-undo) - (goto-char (point-max)) - (insert-buffer-substring buffer))) - (when (memq (process-status process) '(open run)) - process)))) - -(defun imap-shell-p (buffer) - nil) - -(defun imap-shell-open (name buffer server port) - (let ((cmds (if (listp imap-shell-program) imap-shell-program - (list imap-shell-program))) - cmd done) - (while (and (not done) (setq cmd (pop cmds))) - (message "imap: Opening IMAP connection with `%s'..." cmd) - (setq imap-client-eol "\n") - (let* ((port (or port imap-default-port)) - (coding-system-for-read imap-coding-system-for-read) - (coding-system-for-write imap-coding-system-for-write) - (process (start-process - name buffer shell-file-name shell-command-switch - (format-spec - cmd - (format-spec-make - ?s server - ?g imap-shell-host - ?p (number-to-string port) - ?l imap-default-user))))) - (when process - (while (and (memq (process-status process) '(open run)) - (set-buffer buffer) ;; XXX "blue moon" nntp.el bug - (goto-char (point-max)) - (forward-line -1) - (not (imap-parse-greeting))) - (accept-process-output process 1) - (sit-for 1)) - (and imap-log - (with-current-buffer (get-buffer-create imap-log-buffer) - (imap-disable-multibyte) - (buffer-disable-undo) - (goto-char (point-max)) - (insert-buffer-substring buffer))) - (erase-buffer) - (when (memq (process-status process) '(open run)) - (setq done process))))) - (if done - (progn - (message "imap: Opening IMAP connection with `%s'...done" cmd) - done) - (message "imap: Opening IMAP connection with `%s'...failed" cmd) - nil))) - -(defun imap-starttls-p (buffer) - (imap-capability 'STARTTLS buffer)) - -(defun imap-starttls-open (name buffer server port) - (let* ((port (or port imap-default-port)) - (coding-system-for-read imap-coding-system-for-read) - (coding-system-for-write imap-coding-system-for-write) - (process (starttls-open-stream name buffer server port)) - done tls-info) - (message "imap: Connecting with STARTTLS...") - (when process - (while (and (memq (process-status process) '(open run)) - (set-buffer buffer) ;; XXX "blue moon" nntp.el bug - (goto-char (point-max)) - (forward-line -1) - (not (imap-parse-greeting))) - (accept-process-output process 1) - (sit-for 1)) - (imap-send-command "STARTTLS") - (while (and (memq (process-status process) '(open run)) - (set-buffer buffer) ;; XXX "blue moon" nntp.el bug - (goto-char (point-max)) - (forward-line -1) - (not (re-search-forward "[0-9]+ OK.*\r?\n" nil t))) - (accept-process-output process 1) - (sit-for 1)) - (and imap-log - (with-current-buffer (get-buffer-create imap-log-buffer) - (buffer-disable-undo) - (goto-char (point-max)) - (insert-buffer-substring buffer))) - (when (and (setq tls-info (starttls-negotiate process)) - (memq (process-status process) '(open run))) - (setq done process))) - (if (stringp tls-info) - (message "imap: STARTTLS info: %s" tls-info)) - (message "imap: Connecting with STARTTLS...%s" (if done "done" "failed")) - done)) - -;; Server functions; authenticator stuff: - -(defun imap-interactive-login (buffer loginfunc) - "Login to server in BUFFER. -LOGINFUNC is passed a username and a password, it should return t if -it where successful authenticating itself to the server, nil otherwise. -Returns t if login was successful, nil otherwise." - (with-current-buffer buffer - (make-local-variable 'imap-username) - (make-local-variable 'imap-password) - (let (user passwd ret) - ;; (condition-case () - (while (or (not user) (not passwd)) - (setq user (or imap-username - (read-from-minibuffer - (concat "IMAP username for " imap-server - " (using stream `" (symbol-name imap-stream) - "'): ") - (or user imap-default-user)))) - (setq passwd (or imap-password - (read-passwd - (concat "IMAP password for " user "@" - imap-server " (using authenticator `" - (symbol-name imap-auth) "'): ")))) - (when (and user passwd) - (if (funcall loginfunc user passwd) - (progn - (setq ret t - imap-username user) - (when (and (not imap-password) - (or imap-store-password - (y-or-n-p "Store password for this session? "))) - (setq imap-password passwd))) - (message "Login failed...") - (setq passwd nil) - (setq imap-password nil) - (sit-for 1)))) - ;; (quit (with-current-buffer buffer - ;; (setq user nil - ;; passwd nil))) - ;; (error (with-current-buffer buffer - ;; (setq user nil - ;; passwd nil)))) - ret))) - -(defun imap-gssapi-auth-p (buffer) - (eq imap-stream 'gssapi)) - -(defun imap-gssapi-auth (buffer) - (message "imap: Authenticating using GSSAPI...%s" - (if (eq imap-stream 'gssapi) "done" "failed")) - (eq imap-stream 'gssapi)) - -(defun imap-kerberos4-auth-p (buffer) - (and (imap-capability 'AUTH=KERBEROS_V4 buffer) - (eq imap-stream 'kerberos4))) - -(defun imap-kerberos4-auth (buffer) - (message "imap: Authenticating using Kerberos 4...%s" - (if (eq imap-stream 'kerberos4) "done" "failed")) - (eq imap-stream 'kerberos4)) - -(defun imap-cram-md5-p (buffer) - (imap-capability 'AUTH=CRAM-MD5 buffer)) - -(defun imap-cram-md5-auth (buffer) - "Login to server using the AUTH CRAM-MD5 method." - (message "imap: Authenticating using CRAM-MD5...") - (let ((done (imap-interactive-login - buffer - (lambda (user passwd) - (imap-ok-p - (imap-send-command-wait - (list - "AUTHENTICATE CRAM-MD5" - (lambda (challenge) - (let* ((decoded (base64-decode-string challenge)) - (hash (rfc2104-hash 'md5 64 16 passwd decoded)) - (response (concat user " " hash)) - (encoded (base64-encode-string response))) - encoded))))))))) - (if done - (message "imap: Authenticating using CRAM-MD5...done") - (message "imap: Authenticating using CRAM-MD5...failed")))) - -(defun imap-login-p (buffer) - (and (not (imap-capability 'LOGINDISABLED buffer)) - (not (imap-capability 'X-LOGIN-CMD-DISABLED buffer)))) - -(defun imap-login-auth (buffer) - "Login to server using the LOGIN command." - (message "imap: Plaintext authentication...") - (imap-interactive-login buffer - (lambda (user passwd) - (imap-ok-p (imap-send-command-wait - (concat "LOGIN \"" user "\" \"" - passwd "\"")))))) - -(defun imap-anonymous-p (buffer) - t) - -(defun imap-anonymous-auth (buffer) - (message "imap: Logging in anonymously...") - (with-current-buffer buffer - (imap-ok-p (imap-send-command-wait - (concat "LOGIN anonymous \"" (concat (user-login-name) "@" - (system-name)) "\""))))) - -(defun imap-digest-md5-p (buffer) - (and (imap-capability 'AUTH=DIGEST-MD5 buffer) - (condition-case () - (require 'digest-md5) - (error nil)))) - -(defun imap-digest-md5-auth (buffer) - "Login to server using the AUTH DIGEST-MD5 method." - (message "imap: Authenticating using DIGEST-MD5...") - (imap-interactive-login - buffer - (lambda (user passwd) - (let ((tag - (imap-send-command - (list - "AUTHENTICATE DIGEST-MD5" - (lambda (challenge) - (digest-md5-parse-digest-challenge - (base64-decode-string challenge)) - (let* ((digest-uri - (digest-md5-digest-uri - "imap" (digest-md5-challenge 'realm))) - (response - (digest-md5-digest-response - user passwd digest-uri))) - (base64-encode-string response 'no-line-break)))) - ))) - (if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE)) - nil - (setq imap-continuation nil) - (imap-send-command-1 "") - (imap-ok-p (imap-wait-for-tag tag))))))) - -;; Server functions: - -(defun imap-open-1 (buffer) - (with-current-buffer buffer - (erase-buffer) - (setq imap-current-mailbox nil - imap-current-message nil - imap-state 'initial - imap-process (condition-case () - (funcall (nth 2 (assq imap-stream - imap-stream-alist)) - "imap" buffer imap-server imap-port) - ((error quit) nil))) - (when imap-process - (set-process-filter imap-process 'imap-arrival-filter) - (set-process-sentinel imap-process 'imap-sentinel) - (while (and (eq imap-state 'initial) - (memq (process-status imap-process) '(open run))) - (message "Waiting for response from %s..." imap-server) - (accept-process-output imap-process 1)) - (message "Waiting for response from %s...done" imap-server) - (and (memq (process-status imap-process) '(open run)) - imap-process)))) - -(defun imap-open (server &optional port stream auth buffer) - "Open a IMAP connection to host SERVER at PORT returning a buffer. -If PORT is unspecified, a default value is used (143 except -for SSL which use 993). -STREAM indicates the stream to use, see `imap-streams' for available -streams. If nil, it choices the best stream the server is capable of. -AUTH indicates authenticator to use, see `imap-authenticators' for -available authenticators. If nil, it choices the best stream the -server is capable of. -BUFFER can be a buffer or a name of a buffer, which is created if -necessary. If nil, the buffer name is generated." - (setq buffer (or buffer (format " *imap* %s:%d" server (or port 0)))) - (with-current-buffer (get-buffer-create buffer) - (if (imap-opened buffer) - (imap-close buffer)) - (mapcar 'make-local-variable imap-local-variables) - (imap-disable-multibyte) - (buffer-disable-undo) - (setq imap-server (or server imap-server)) - (setq imap-port (or port imap-port)) - (setq imap-auth (or auth imap-auth)) - (setq imap-stream (or stream imap-stream)) - (message "imap: Connecting to %s..." imap-server) - (if (null (let ((imap-stream (or imap-stream imap-default-stream))) - (imap-open-1 buffer))) - (progn - (message "imap: Connecting to %s...failed" imap-server) - nil) - (when (null imap-stream) - ;; Need to choose stream. - (let ((streams imap-streams)) - (while (setq stream (pop streams)) - ;; OK to use this stream? - (when (funcall (nth 1 (assq stream imap-stream-alist)) buffer) - ;; Stream changed? - (if (not (eq imap-default-stream stream)) - (with-current-buffer (get-buffer-create - (generate-new-buffer-name " *temp*")) - (mapcar 'make-local-variable imap-local-variables) - (imap-disable-multibyte) - (buffer-disable-undo) - (setq imap-server (or server imap-server)) - (setq imap-port (or port imap-port)) - (setq imap-auth (or auth imap-auth)) - (message "imap: Reconnecting with stream `%s'..." stream) - (if (null (let ((imap-stream stream)) - (imap-open-1 (current-buffer)))) - (progn - (kill-buffer (current-buffer)) - (message - "imap: Reconnecting with stream `%s'...failed" - stream)) - ;; We're done, kill the first connection - (imap-close buffer) - (let ((name (if (stringp buffer) - buffer - (buffer-name buffer)))) - (kill-buffer buffer) - (rename-buffer name)) - (message "imap: Reconnecting with stream `%s'...done" - stream) - (setq imap-stream stream) - (setq imap-capability nil) - (setq streams nil))) - ;; We're done - (message "imap: Connecting to %s...done" imap-server) - (setq imap-stream stream) - (setq imap-capability nil) - (setq streams nil)))))) - (when (imap-opened buffer) - (setq imap-mailbox-data (make-vector imap-mailbox-prime 0))) - (when imap-stream - buffer)))) - -(defun imap-opened (&optional buffer) - "Return non-nil if connection to imap server in BUFFER is open. -If BUFFER is nil then the current buffer is used." - (and (setq buffer (get-buffer (or buffer (current-buffer)))) - (buffer-live-p buffer) - (with-current-buffer buffer - (and imap-process - (memq (process-status imap-process) '(open run)))))) - -(defun imap-authenticate (&optional user passwd buffer) - "Authenticate to server in BUFFER, using current buffer if nil. -It uses the authenticator specified when opening the server. If the -authenticator requires username/passwords, they are queried from the -user and optionally stored in the buffer. If USER and/or PASSWD is -specified, the user will not be questioned and the username and/or -password is remembered in the buffer." - (with-current-buffer (or buffer (current-buffer)) - (if (not (eq imap-state 'nonauth)) - (or (eq imap-state 'auth) - (eq imap-state 'select) - (eq imap-state 'examine)) - (make-local-variable 'imap-username) - (make-local-variable 'imap-password) - (if user (setq imap-username user)) - (if passwd (setq imap-password passwd)) - (if imap-auth - (and (funcall (nth 2 (assq imap-auth - imap-authenticator-alist)) buffer) - (setq imap-state 'auth)) - ;; Choose authenticator. - (let ((auths imap-authenticators) - auth) - (while (setq auth (pop auths)) - ;; OK to use authenticator? - (when (funcall (nth 1 (assq auth imap-authenticator-alist)) buffer) - (message "imap: Authenticating to `%s' using `%s'..." - imap-server auth) - (setq imap-auth auth) - (if (funcall (nth 2 (assq auth imap-authenticator-alist)) buffer) - (progn - (message "imap: Authenticating to `%s' using `%s'...done" - imap-server auth) - (setq auths nil)) - (message "imap: Authenticating to `%s' using `%s'...failed" - imap-server auth))))) - imap-state)))) - -(defun imap-close (&optional buffer) - "Close connection to server in BUFFER. -If BUFFER is nil, the current buffer is used." - (with-current-buffer (or buffer (current-buffer)) - (when (imap-opened) - (condition-case nil - (imap-send-command-wait "LOGOUT") - (quit nil))) - (when (and imap-process - (memq (process-status imap-process) '(open run))) - (delete-process imap-process)) - (setq imap-current-mailbox nil - imap-current-message nil - imap-process nil) - (erase-buffer) - t)) - -(defun imap-capability (&optional identifier buffer) - "Return a list of identifiers which server in BUFFER support. -If IDENTIFIER, return non-nil if it's among the servers capabilities. -If BUFFER is nil, the current buffer is assumed." - (with-current-buffer (or buffer (current-buffer)) - (unless imap-capability - (unless (imap-ok-p (imap-send-command-wait "CAPABILITY")) - (setq imap-capability '(IMAP2)))) - (if identifier - (memq (intern (upcase (symbol-name identifier))) imap-capability) - imap-capability))) - -(defun imap-namespace (&optional buffer) - "Return a namespace hierarchy at server in BUFFER. -If BUFFER is nil, the current buffer is assumed." - (with-current-buffer (or buffer (current-buffer)) - (unless imap-namespace - (when (imap-capability 'NAMESPACE) - (imap-send-command-wait "NAMESPACE"))) - imap-namespace)) - -(defun imap-send-command-wait (command &optional buffer) - (imap-wait-for-tag (imap-send-command command buffer) buffer)) - - -;; Mailbox functions: - -(defun imap-mailbox-put (propname value &optional mailbox buffer) - (with-current-buffer (or buffer (current-buffer)) - (if imap-mailbox-data - (put (intern (or mailbox imap-current-mailbox) imap-mailbox-data) - propname value) - (error "Imap-mailbox-data is nil, prop %s value %s mailbox %s buffer %s" - propname value mailbox (current-buffer))) - t)) - -(defsubst imap-mailbox-get-1 (propname &optional mailbox) - (get (intern-soft (or mailbox imap-current-mailbox) imap-mailbox-data) - propname)) - -(defun imap-mailbox-get (propname &optional mailbox buffer) - (let ((mailbox (imap-utf7-encode mailbox))) - (with-current-buffer (or buffer (current-buffer)) - (imap-mailbox-get-1 propname (or mailbox imap-current-mailbox))))) - -(defun imap-mailbox-map-1 (func &optional mailbox-decoder buffer) - (with-current-buffer (or buffer (current-buffer)) - (let (result) - (mapatoms - (lambda (s) - (push (funcall func (if mailbox-decoder - (funcall mailbox-decoder (symbol-name s)) - (symbol-name s))) result)) - imap-mailbox-data) - result))) - -(defun imap-mailbox-map (func &optional buffer) - "Map a function across each mailbox in `imap-mailbox-data', returning a list. -Function should take a mailbox name (a string) as -the only argument." - (imap-mailbox-map-1 func 'imap-utf7-decode buffer)) - -(defun imap-current-mailbox (&optional buffer) - (with-current-buffer (or buffer (current-buffer)) - (imap-utf7-decode imap-current-mailbox))) - -(defun imap-current-mailbox-p-1 (mailbox &optional examine) - (and (string= mailbox imap-current-mailbox) - (or (and examine - (eq imap-state 'examine)) - (and (not examine) - (eq imap-state 'selected))))) - -(defun imap-current-mailbox-p (mailbox &optional examine buffer) - (with-current-buffer (or buffer (current-buffer)) - (imap-current-mailbox-p-1 (imap-utf7-encode mailbox) examine))) - -(defun imap-mailbox-select-1 (mailbox &optional examine) - "Select MAILBOX on server in BUFFER. -If EXAMINE is non-nil, do a read-only select." - (if (imap-current-mailbox-p-1 mailbox examine) - imap-current-mailbox - (setq imap-current-mailbox mailbox) - (if (imap-ok-p (imap-send-command-wait - (concat (if examine "EXAMINE" "SELECT") " \"" - mailbox "\""))) - (progn - (setq imap-message-data (make-vector imap-message-prime 0) - imap-state (if examine 'examine 'selected)) - imap-current-mailbox) - ;; Failed SELECT/EXAMINE unselects current mailbox - (setq imap-current-mailbox nil)))) - -(defun imap-mailbox-select (mailbox &optional examine buffer) - (with-current-buffer (or buffer (current-buffer)) - (imap-utf7-decode - (imap-mailbox-select-1 (imap-utf7-encode mailbox) examine)))) - -(defun imap-mailbox-examine-1 (mailbox &optional buffer) - (with-current-buffer (or buffer (current-buffer)) - (imap-mailbox-select-1 mailbox 'examine))) - -(defun imap-mailbox-examine (mailbox &optional buffer) - "Examine MAILBOX on server in BUFFER." - (imap-mailbox-select mailbox 'examine buffer)) - -(defun imap-mailbox-unselect (&optional buffer) - "Close current folder in BUFFER, without expunging articles." - (with-current-buffer (or buffer (current-buffer)) - (when (or (eq imap-state 'auth) - (and (imap-capability 'UNSELECT) - (imap-ok-p (imap-send-command-wait "UNSELECT"))) - (and (imap-ok-p - (imap-send-command-wait (concat "EXAMINE \"" - imap-current-mailbox - "\""))) - (imap-ok-p (imap-send-command-wait "CLOSE")))) - (setq imap-current-mailbox nil - imap-message-data nil - imap-state 'auth) - t))) - -(defun imap-mailbox-expunge (&optional asynch buffer) - "Expunge articles in current folder in BUFFER. -If ASYNCH, do not wait for succesful completion of the command. -If BUFFER is nil the current buffer is assumed." - (with-current-buffer (or buffer (current-buffer)) - (when (and imap-current-mailbox (not (eq imap-state 'examine))) - (if asynch - (imap-send-command "EXPUNGE") - (imap-ok-p (imap-send-command-wait "EXPUNGE")))))) - -(defun imap-mailbox-close (&optional asynch buffer) - "Expunge articles and close current folder in BUFFER. -If ASYNCH, do not wait for succesful completion of the command. -If BUFFER is nil the current buffer is assumed." - (with-current-buffer (or buffer (current-buffer)) - (when imap-current-mailbox - (if asynch - (imap-add-callback (imap-send-command "CLOSE") - `(lambda (tag status) - (message "IMAP mailbox `%s' closed... %s" - imap-current-mailbox status) - (when (eq ,imap-current-mailbox - imap-current-mailbox) - ;; Don't wipe out data if another mailbox - ;; was selected... - (setq imap-current-mailbox nil - imap-message-data nil - imap-state 'auth)))) - (when (imap-ok-p (imap-send-command-wait "CLOSE")) - (setq imap-current-mailbox nil - imap-message-data nil - imap-state 'auth))) - t))) - -(defun imap-mailbox-create-1 (mailbox) - (imap-ok-p (imap-send-command-wait (list "CREATE \"" mailbox "\"")))) - -(defun imap-mailbox-create (mailbox &optional buffer) - "Create MAILBOX on server in BUFFER. -If BUFFER is nil the current buffer is assumed." - (with-current-buffer (or buffer (current-buffer)) - (imap-mailbox-create-1 (imap-utf7-encode mailbox)))) - -(defun imap-mailbox-delete (mailbox &optional buffer) - "Delete MAILBOX on server in BUFFER. -If BUFFER is nil the current buffer is assumed." - (let ((mailbox (imap-utf7-encode mailbox))) - (with-current-buffer (or buffer (current-buffer)) - (imap-ok-p - (imap-send-command-wait (list "DELETE \"" mailbox "\"")))))) - -(defun imap-mailbox-rename (oldname newname &optional buffer) - "Rename mailbox OLDNAME to NEWNAME on server in BUFFER. -If BUFFER is nil the current buffer is assumed." - (let ((oldname (imap-utf7-encode oldname)) - (newname (imap-utf7-encode newname))) - (with-current-buffer (or buffer (current-buffer)) - (imap-ok-p - (imap-send-command-wait (list "RENAME \"" oldname "\" " - "\"" newname "\"")))))) - -(defun imap-mailbox-lsub (&optional root reference add-delimiter buffer) - "Return a list of subscribed mailboxes on server in BUFFER. -If ROOT is non-nil, only list matching mailboxes. If ADD-DELIMITER is -non-nil, a hierarchy delimiter is added to root. REFERENCE is a -implementation-specific string that has to be passed to lsub command." - (with-current-buffer (or buffer (current-buffer)) - ;; Make sure we know the hierarchy separator for root's hierarchy - (when (and add-delimiter (null (imap-mailbox-get-1 'delimiter root))) - (imap-send-command-wait (concat "LIST \"" reference "\" \"" - (imap-utf7-encode root) "\""))) - ;; clear list data (NB not delimiter and other stuff) - (imap-mailbox-map-1 (lambda (mailbox) - (imap-mailbox-put 'lsub nil mailbox))) - (when (imap-ok-p - (imap-send-command-wait - (concat "LSUB \"" reference "\" \"" (imap-utf7-encode root) - (and add-delimiter (imap-mailbox-get-1 'delimiter root)) - "%\""))) - (let (out) - (imap-mailbox-map-1 (lambda (mailbox) - (when (imap-mailbox-get-1 'lsub mailbox) - (push (imap-utf7-decode mailbox) out)))) - (nreverse out))))) - -(defun imap-mailbox-list (root &optional reference add-delimiter buffer) - "Return a list of mailboxes matching ROOT on server in BUFFER. -If ADD-DELIMITER is non-nil, a hierarchy delimiter is added to -root. REFERENCE is a implementation-specific string that has to be -passed to list command." - (with-current-buffer (or buffer (current-buffer)) - ;; Make sure we know the hierarchy separator for root's hierarchy - (when (and add-delimiter (null (imap-mailbox-get-1 'delimiter root))) - (imap-send-command-wait (concat "LIST \"" reference "\" \"" - (imap-utf7-encode root) "\""))) - ;; clear list data (NB not delimiter and other stuff) - (imap-mailbox-map-1 (lambda (mailbox) - (imap-mailbox-put 'list nil mailbox))) - (when (imap-ok-p - (imap-send-command-wait - (concat "LIST \"" reference "\" \"" (imap-utf7-encode root) - (and add-delimiter (imap-mailbox-get-1 'delimiter root)) - "%\""))) - (let (out) - (imap-mailbox-map-1 (lambda (mailbox) - (when (imap-mailbox-get-1 'list mailbox) - (push (imap-utf7-decode mailbox) out)))) - (nreverse out))))) - -(defun imap-mailbox-subscribe (mailbox &optional buffer) - "Send the SUBSCRIBE command on the mailbox to server in BUFFER. -Returns non-nil if successful." - (with-current-buffer (or buffer (current-buffer)) - (imap-ok-p (imap-send-command-wait (concat "SUBSCRIBE \"" - (imap-utf7-encode mailbox) - "\""))))) - -(defun imap-mailbox-unsubscribe (mailbox &optional buffer) - "Send the SUBSCRIBE command on the mailbox to server in BUFFER. -Returns non-nil if successful." - (with-current-buffer (or buffer (current-buffer)) - (imap-ok-p (imap-send-command-wait (concat "UNSUBSCRIBE " - (imap-utf7-encode mailbox) - "\""))))) - -(defun imap-mailbox-status (mailbox items &optional buffer) - "Get status items ITEM in MAILBOX from server in BUFFER. -ITEMS can be a symbol or a list of symbols, valid symbols are one of -the STATUS data items -- ie 'messages, 'recent, 'uidnext, 'uidvalidity -or 'unseen. If ITEMS is a list of symbols, a list of values is -returned, if ITEMS is a symbol only its value is returned." - (with-current-buffer (or buffer (current-buffer)) - (when (imap-ok-p - (imap-send-command-wait (list "STATUS \"" - (imap-utf7-encode mailbox) - "\" " - (upcase - (format "%s" - (if (listp items) - items - (list items))))))) - (if (listp items) - (mapcar (lambda (item) - (imap-mailbox-get item mailbox)) - items) - (imap-mailbox-get items mailbox))))) - -(defun imap-mailbox-status-asynch (mailbox items &optional buffer) - "Send status item request ITEM on MAILBOX to server in BUFFER. -ITEMS can be a symbol or a list of symbols, valid symbols are one of -the STATUS data items -- ie 'messages, 'recent, 'uidnext, 'uidvalidity -or 'unseen. The IMAP command tag is returned." - (with-current-buffer (or buffer (current-buffer)) - (imap-send-command (list "STATUS \"" - (imap-utf7-encode mailbox) - "\" " - (format "%s" - (if (listp items) - items - (list items))))))) - -(defun imap-mailbox-acl-get (&optional mailbox buffer) - "Get ACL on mailbox from server in BUFFER." - (let ((mailbox (imap-utf7-encode mailbox))) - (with-current-buffer (or buffer (current-buffer)) - (when (imap-ok-p - (imap-send-command-wait (list "GETACL \"" - (or mailbox imap-current-mailbox) - "\""))) - (imap-mailbox-get-1 'acl (or mailbox imap-current-mailbox)))))) - -(defun imap-mailbox-acl-set (identifier rights &optional mailbox buffer) - "Change/set ACL for IDENTIFIER to RIGHTS in MAILBOX from server in BUFFER." - (let ((mailbox (imap-utf7-encode mailbox))) - (with-current-buffer (or buffer (current-buffer)) - (imap-ok-p - (imap-send-command-wait (list "SETACL \"" - (or mailbox imap-current-mailbox) - "\" " - identifier - " " - rights)))))) - -(defun imap-mailbox-acl-delete (identifier &optional mailbox buffer) - "Removes any pair for IDENTIFIER in MAILBOX from server in BUFFER." - (let ((mailbox (imap-utf7-encode mailbox))) - (with-current-buffer (or buffer (current-buffer)) - (imap-ok-p - (imap-send-command-wait (list "DELETEACL \"" - (or mailbox imap-current-mailbox) - "\" " - identifier)))))) - - -;; Message functions: - -(defun imap-current-message (&optional buffer) - (with-current-buffer (or buffer (current-buffer)) - imap-current-message)) - -(defun imap-list-to-message-set (list) - (mapconcat (lambda (item) - (number-to-string item)) - (if (listp list) - list - (list list)) - ",")) - -(defun imap-range-to-message-set (range) - (mapconcat - (lambda (item) - (if (consp item) - (format "%d:%d" - (car item) (cdr item)) - (format "%d" item))) - (if (and (listp range) (not (listp (cdr range)))) - (list range) ;; make (1 . 2) into ((1 . 2)) - range) - ",")) - -(defun imap-fetch-asynch (uids props &optional nouidfetch buffer) - (with-current-buffer (or buffer (current-buffer)) - (imap-send-command (format "%sFETCH %s %s" (if nouidfetch "" "UID ") - (if (listp uids) - (imap-list-to-message-set uids) - uids) - props)))) - -(defun imap-fetch (uids props &optional receive nouidfetch buffer) - "Fetch properties PROPS from message set UIDS from server in BUFFER. -UIDS can be a string, number or a list of numbers. If RECEIVE -is non-nil return these properties." - (with-current-buffer (or buffer (current-buffer)) - (when (imap-ok-p (imap-send-command-wait - (format "%sFETCH %s %s" (if nouidfetch "" "UID ") - (if (listp uids) - (imap-list-to-message-set uids) - uids) - props))) - (if (or (null receive) (stringp uids)) - t - (if (listp uids) - (mapcar (lambda (uid) - (if (listp receive) - (mapcar (lambda (prop) - (imap-message-get uid prop)) - receive) - (imap-message-get uid receive))) - uids) - (imap-message-get uids receive)))))) - -(defun imap-message-put (uid propname value &optional buffer) - (with-current-buffer (or buffer (current-buffer)) - (if imap-message-data - (put (intern (number-to-string uid) imap-message-data) - propname value) - (error "Imap-message-data is nil, uid %s prop %s value %s buffer %s" - uid propname value (current-buffer))) - t)) - -(defun imap-message-get (uid propname &optional buffer) - (with-current-buffer (or buffer (current-buffer)) - (get (intern-soft (number-to-string uid) imap-message-data) - propname))) - -(defun imap-message-map (func propname &optional buffer) - "Map a function across each mailbox in `imap-message-data', returning a list." - (with-current-buffer (or buffer (current-buffer)) - (let (result) - (mapatoms - (lambda (s) - (push (funcall func (get s 'UID) (get s propname)) result)) - imap-message-data) - result))) - -(defmacro imap-message-envelope-date (uid &optional buffer) - `(with-current-buffer (or ,buffer (current-buffer)) - (elt (imap-message-get ,uid 'ENVELOPE) 0))) - -(defmacro imap-message-envelope-subject (uid &optional buffer) - `(with-current-buffer (or ,buffer (current-buffer)) - (elt (imap-message-get ,uid 'ENVELOPE) 1))) - -(defmacro imap-message-envelope-from (uid &optional buffer) - `(with-current-buffer (or ,buffer (current-buffer)) - (elt (imap-message-get ,uid 'ENVELOPE) 2))) - -(defmacro imap-message-envelope-sender (uid &optional buffer) - `(with-current-buffer (or ,buffer (current-buffer)) - (elt (imap-message-get ,uid 'ENVELOPE) 3))) - -(defmacro imap-message-envelope-reply-to (uid &optional buffer) - `(with-current-buffer (or ,buffer (current-buffer)) - (elt (imap-message-get ,uid 'ENVELOPE) 4))) - -(defmacro imap-message-envelope-to (uid &optional buffer) - `(with-current-buffer (or ,buffer (current-buffer)) - (elt (imap-message-get ,uid 'ENVELOPE) 5))) - -(defmacro imap-message-envelope-cc (uid &optional buffer) - `(with-current-buffer (or ,buffer (current-buffer)) - (elt (imap-message-get ,uid 'ENVELOPE) 6))) - -(defmacro imap-message-envelope-bcc (uid &optional buffer) - `(with-current-buffer (or ,buffer (current-buffer)) - (elt (imap-message-get ,uid 'ENVELOPE) 7))) - -(defmacro imap-message-envelope-in-reply-to (uid &optional buffer) - `(with-current-buffer (or ,buffer (current-buffer)) - (elt (imap-message-get ,uid 'ENVELOPE) 8))) - -(defmacro imap-message-envelope-message-id (uid &optional buffer) - `(with-current-buffer (or ,buffer (current-buffer)) - (elt (imap-message-get ,uid 'ENVELOPE) 9))) - -(defmacro imap-message-body (uid &optional buffer) - `(with-current-buffer (or ,buffer (current-buffer)) - (imap-message-get ,uid 'BODY))) - -(defun imap-search (predicate &optional buffer) - (with-current-buffer (or buffer (current-buffer)) - (imap-mailbox-put 'search 'dummy) - (when (imap-ok-p (imap-send-command-wait (concat "UID SEARCH " predicate))) - (if (eq (imap-mailbox-get-1 'search imap-current-mailbox) 'dummy) - (progn - (message "Missing SEARCH response to a SEARCH command (server not RFC compliant)...") - nil) - (imap-mailbox-get-1 'search imap-current-mailbox))))) - -(defun imap-message-flag-permanent-p (flag &optional mailbox buffer) - "Return t if FLAG can be permanently (between IMAP sessions) saved on articles, in MAILBOX on server in BUFFER." - (with-current-buffer (or buffer (current-buffer)) - (or (member "\\*" (imap-mailbox-get 'permanentflags mailbox)) - (member flag (imap-mailbox-get 'permanentflags mailbox))))) - -(defun imap-message-flags-set (articles flags &optional silent buffer) - (when (and articles flags) - (with-current-buffer (or buffer (current-buffer)) - (imap-ok-p (imap-send-command-wait - (concat "UID STORE " articles - " FLAGS" (if silent ".SILENT") " (" flags ")")))))) - -(defun imap-message-flags-del (articles flags &optional silent buffer) - (when (and articles flags) - (with-current-buffer (or buffer (current-buffer)) - (imap-ok-p (imap-send-command-wait - (concat "UID STORE " articles - " -FLAGS" (if silent ".SILENT") " (" flags ")")))))) - -(defun imap-message-flags-add (articles flags &optional silent buffer) - (when (and articles flags) - (with-current-buffer (or buffer (current-buffer)) - (imap-ok-p (imap-send-command-wait - (concat "UID STORE " articles - " +FLAGS" (if silent ".SILENT") " (" flags ")")))))) - -(defun imap-message-copyuid-1 (mailbox) - (if (imap-capability 'UIDPLUS) - (list (nth 0 (imap-mailbox-get-1 'copyuid mailbox)) - (string-to-number (nth 2 (imap-mailbox-get-1 'copyuid mailbox)))) - (let ((old-mailbox imap-current-mailbox) - (state imap-state) - (imap-message-data (make-vector 2 0))) - (when (imap-mailbox-examine-1 mailbox) - (prog1 - (and (imap-fetch "*" "UID") - (list (imap-mailbox-get-1 'uidvalidity mailbox) - (apply 'max (imap-message-map - (lambda (uid prop) uid) 'UID)))) - (if old-mailbox - (imap-mailbox-select old-mailbox (eq state 'examine)) - (imap-mailbox-unselect))))))) - -(defun imap-message-copyuid (mailbox &optional buffer) - (with-current-buffer (or buffer (current-buffer)) - (imap-message-copyuid-1 (imap-utf7-decode mailbox)))) - -(defun imap-message-copy (articles mailbox - &optional dont-create no-copyuid buffer) - "Copy ARTICLES (a string message set) to MAILBOX on server in -BUFFER, creating mailbox if it doesn't exist. If dont-create is -non-nil, it will not create a mailbox. On success, return a list with -the UIDVALIDITY of the mailbox the article(s) was copied to as the -first element, rest of list contain the saved articles' UIDs." - (when articles - (with-current-buffer (or buffer (current-buffer)) - (let ((mailbox (imap-utf7-encode mailbox))) - (if (let ((cmd (concat "UID COPY " articles " \"" mailbox "\"")) - (imap-current-target-mailbox mailbox)) - (if (imap-ok-p (imap-send-command-wait cmd)) - t - (when (and (not dont-create) - ;; removed because of buggy Oracle server - ;; that doesn't send TRYCREATE tags (which - ;; is a MUST according to specifications): - ;;(imap-mailbox-get-1 'trycreate mailbox) - (imap-mailbox-create-1 mailbox)) - (imap-ok-p (imap-send-command-wait cmd))))) - (or no-copyuid - (imap-message-copyuid-1 mailbox))))))) - -(defun imap-message-appenduid-1 (mailbox) - (if (imap-capability 'UIDPLUS) - (imap-mailbox-get-1 'appenduid mailbox) - (let ((old-mailbox imap-current-mailbox) - (state imap-state) - (imap-message-data (make-vector 2 0))) - (when (imap-mailbox-examine-1 mailbox) - (prog1 - (and (imap-fetch "*" "UID") - (list (imap-mailbox-get-1 'uidvalidity mailbox) - (apply 'max (imap-message-map - (lambda (uid prop) uid) 'UID)))) - (if old-mailbox - (imap-mailbox-select old-mailbox (eq state 'examine)) - (imap-mailbox-unselect))))))) - -(defun imap-message-appenduid (mailbox &optional buffer) - (with-current-buffer (or buffer (current-buffer)) - (imap-message-appenduid-1 (imap-utf7-encode mailbox)))) - -(defun imap-message-append (mailbox article &optional flags date-time buffer) - "Append ARTICLE (a buffer) to MAILBOX on server in BUFFER. -FLAGS and DATE-TIME is currently not used. Return a cons holding -uidvalidity of MAILBOX and UID the newly created article got, or nil -on failure." - (let ((mailbox (imap-utf7-encode mailbox))) - (with-current-buffer (or buffer (current-buffer)) - (and (let ((imap-current-target-mailbox mailbox)) - (imap-ok-p - (imap-send-command-wait - (list "APPEND \"" mailbox "\" " article)))) - (imap-message-appenduid-1 mailbox))))) - -(defun imap-body-lines (body) - "Return number of lines in article by looking at the mime bodystructure BODY." - (if (listp body) - (if (stringp (car body)) - (cond ((and (string= (upcase (car body)) "TEXT") - (numberp (nth 7 body))) - (nth 7 body)) - ((and (string= (upcase (car body)) "MESSAGE") - (numberp (nth 9 body))) - (nth 9 body)) - (t 0)) - (apply '+ (mapcar 'imap-body-lines body))) - 0)) - -(defun imap-envelope-from (from) - "Return a from string line." - (and from - (concat (aref from 0) - (if (aref from 0) " <") - (aref from 2) - "@" - (aref from 3) - (if (aref from 0) ">")))) - - -;; Internal functions. - -(defun imap-add-callback (tag func) - (setq imap-callbacks (append (list (cons tag func)) imap-callbacks))) - -(defun imap-send-command-1 (cmdstr) - (setq cmdstr (concat cmdstr imap-client-eol)) - (and imap-log - (with-current-buffer (get-buffer-create imap-log-buffer) - (imap-disable-multibyte) - (buffer-disable-undo) - (goto-char (point-max)) - (insert cmdstr))) - (process-send-string imap-process cmdstr)) - -(defun imap-send-command (command &optional buffer) - (with-current-buffer (or buffer (current-buffer)) - (if (not (listp command)) (setq command (list command))) - (let ((tag (setq imap-tag (1+ imap-tag))) - cmd cmdstr) - (setq cmdstr (concat (number-to-string imap-tag) " ")) - (while (setq cmd (pop command)) - (cond ((stringp cmd) - (setq cmdstr (concat cmdstr cmd))) - ((bufferp cmd) - (let ((eol imap-client-eol) - (calcfirst imap-calculate-literal-size-first) - size) - (with-current-buffer cmd - (if calcfirst - (setq size (buffer-size))) - (when (not (equal eol "\r\n")) - ;; XXX modifies buffer! - (goto-char (point-min)) - (while (search-forward "\r\n" nil t) - (replace-match eol))) - (if (not calcfirst) - (setq size (buffer-size)))) - (setq cmdstr - (concat cmdstr (format "{%d}" size)))) - (unwind-protect - (progn - (imap-send-command-1 cmdstr) - (setq cmdstr nil) - (if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE)) - (setq command nil) ;; abort command if no cont-req - (let ((process imap-process) - (stream imap-stream) - (eol imap-client-eol)) - (with-current-buffer cmd - (and imap-log - (with-current-buffer (get-buffer-create - imap-log-buffer) - (imap-disable-multibyte) - (buffer-disable-undo) - (goto-char (point-max)) - (insert-buffer-substring cmd))) - (process-send-region process (point-min) - (point-max))) - (process-send-string process imap-client-eol)))) - (setq imap-continuation nil))) - ((functionp cmd) - (imap-send-command-1 cmdstr) - (setq cmdstr nil) - (unwind-protect - (if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE)) - (setq command nil) ;; abort command if no cont-req - (setq command (cons (funcall cmd imap-continuation) - command))) - (setq imap-continuation nil))) - (t - (error "Unknown command type")))) - (if cmdstr - (imap-send-command-1 cmdstr)) - tag))) - -(defun imap-wait-for-tag (tag &optional buffer) - (with-current-buffer (or buffer (current-buffer)) - (let (imap-have-messaged) - (while (and (null imap-continuation) - (memq (process-status imap-process) '(open run)) - (< imap-reached-tag tag)) - (let ((len (/ (point-max) 1024)) - message-log-max) - (unless (< len 10) - (setq imap-have-messaged t) - (message "imap read: %dk" len)) - (accept-process-output imap-process - (truncate imap-read-timeout) - (truncate (* (- imap-read-timeout - (truncate imap-read-timeout)) - 1000))))) - ;; A process can die _before_ we have processed everything it - ;; has to say. Moreover, this can happen in between the call to - ;; accept-process-output and the call to process-status in an - ;; iteration of the loop above. - (when (and (null imap-continuation) - (< imap-reached-tag tag)) - (accept-process-output imap-process 0 0)) - (when imap-have-messaged - (message "")) - (and (memq (process-status imap-process) '(open run)) - (or (assq tag imap-failed-tags) - (if imap-continuation - 'INCOMPLETE - 'OK)))))) - -(defun imap-sentinel (process string) - (delete-process process)) - -(defun imap-find-next-line () - "Return point at end of current line, taking into account literals. -Return nil if no complete line has arrived." - (when (re-search-forward (concat imap-server-eol "\\|{\\([0-9]+\\)}" - imap-server-eol) - nil t) - (if (match-string 1) - (if (< (point-max) (+ (point) (string-to-number (match-string 1)))) - nil - (goto-char (+ (point) (string-to-number (match-string 1)))) - (imap-find-next-line)) - (point)))) - -(defun imap-arrival-filter (proc string) - "IMAP process filter." - ;; Sometimes, we are called even though the process has died. - ;; Better abstain from doing stuff in that case. - (when (buffer-name (process-buffer proc)) - (with-current-buffer (process-buffer proc) - (goto-char (point-max)) - (insert string) - (and imap-log - (with-current-buffer (get-buffer-create imap-log-buffer) - (imap-disable-multibyte) - (buffer-disable-undo) - (goto-char (point-max)) - (insert string))) - (let (end) - (goto-char (point-min)) - (while (setq end (imap-find-next-line)) - (save-restriction - (narrow-to-region (point-min) end) - (delete-backward-char (length imap-server-eol)) - (goto-char (point-min)) - (unwind-protect - (cond ((eq imap-state 'initial) - (imap-parse-greeting)) - ((or (eq imap-state 'auth) - (eq imap-state 'nonauth) - (eq imap-state 'selected) - (eq imap-state 'examine)) - (imap-parse-response)) - (t - (message "Unknown state %s in arrival filter" - imap-state))) - (delete-region (point-min) (point-max))))))))) - - -;; Imap parser. - -(defsubst imap-forward () - (or (eobp) (forward-char))) - -;; number = 1*DIGIT -;; ; Unsigned 32-bit integer -;; ; (0 <= n < 4,294,967,296) - -(defsubst imap-parse-number () - (when (looking-at "[0-9]+") - (prog1 - (string-to-number (match-string 0)) - (goto-char (match-end 0))))) - -;; literal = "{" number "}" CRLF *CHAR8 -;; ; Number represents the number of CHAR8s - -(defsubst imap-parse-literal () - (when (looking-at "{\\([0-9]+\\)}\r\n") - (let ((pos (match-end 0)) - (len (string-to-number (match-string 1)))) - (if (< (point-max) (+ pos len)) - nil - (goto-char (+ pos len)) - (buffer-substring pos (+ pos len)))))) - -;; string = quoted / literal -;; -;; quoted = DQUOTE *QUOTED-CHAR DQUOTE -;; -;; QUOTED-CHAR = / -;; "\" quoted-specials -;; -;; quoted-specials = DQUOTE / "\" -;; -;; TEXT-CHAR = - -(defsubst imap-parse-string () - (cond ((eq (char-after) ?\") - (forward-char 1) - (let ((p (point)) (name "")) - (skip-chars-forward "^\"\\\\") - (setq name (buffer-substring p (point))) - (while (eq (char-after) ?\\) - (setq p (1+ (point))) - (forward-char 2) - (skip-chars-forward "^\"\\\\") - (setq name (concat name (buffer-substring p (point))))) - (forward-char 1) - name)) - ((eq (char-after) ?{) - (imap-parse-literal)))) - -;; nil = "NIL" - -(defsubst imap-parse-nil () - (if (looking-at "NIL") - (goto-char (match-end 0)))) - -;; nstring = string / nil - -(defsubst imap-parse-nstring () - (or (imap-parse-string) - (and (imap-parse-nil) - nil))) - -;; astring = atom / string -;; -;; atom = 1*ATOM-CHAR -;; -;; ATOM-CHAR = -;; -;; atom-specials = "(" / ")" / "{" / SP / CTL / list-wildcards / -;; quoted-specials -;; -;; list-wildcards = "%" / "*" -;; -;; quoted-specials = DQUOTE / "\" - -(defsubst imap-parse-astring () - (or (imap-parse-string) - (buffer-substring (point) - (if (re-search-forward "[(){ \r\n%*\"\\]" nil t) - (goto-char (1- (match-end 0))) - (end-of-line) - (point))))) - -;; address = "(" addr-name SP addr-adl SP addr-mailbox SP -;; addr-host ")" -;; -;; addr-adl = nstring -;; ; Holds route from [RFC-822] route-addr if -;; ; non-nil -;; -;; addr-host = nstring -;; ; nil indicates [RFC-822] group syntax. -;; ; Otherwise, holds [RFC-822] domain name -;; -;; addr-mailbox = nstring -;; ; nil indicates end of [RFC-822] group; if -;; ; non-nil and addr-host is nil, holds -;; ; [RFC-822] group name. -;; ; Otherwise, holds [RFC-822] local-part -;; ; after removing [RFC-822] quoting -;; -;; addr-name = nstring -;; ; If non-nil, holds phrase from [RFC-822] -;; ; mailbox after removing [RFC-822] quoting -;; - -(defsubst imap-parse-address () - (let (address) - (when (eq (char-after) ?\() - (imap-forward) - (setq address (vector (prog1 (imap-parse-nstring) - (imap-forward)) - (prog1 (imap-parse-nstring) - (imap-forward)) - (prog1 (imap-parse-nstring) - (imap-forward)) - (imap-parse-nstring))) - (when (eq (char-after) ?\)) - (imap-forward) - address)))) - -;; address-list = "(" 1*address ")" / nil -;; -;; nil = "NIL" - -(defsubst imap-parse-address-list () - (if (eq (char-after) ?\() - (let (address addresses) - (imap-forward) - (while (and (not (eq (char-after) ?\))) - ;; next line for MS Exchange bug - (progn (and (eq (char-after) ? ) (imap-forward)) t) - (setq address (imap-parse-address))) - (setq addresses (cons address addresses))) - (when (eq (char-after) ?\)) - (imap-forward) - (nreverse addresses))) - ;; With assert, the code might not be eval'd. - ;; (assert (imap-parse-nil) t "In imap-parse-address-list") - (imap-parse-nil))) - -;; mailbox = "INBOX" / astring -;; ; INBOX is case-insensitive. All case variants of -;; ; INBOX (e.g. "iNbOx") MUST be interpreted as INBOX -;; ; not as an astring. An astring which consists of -;; ; the case-insensitive sequence "I" "N" "B" "O" "X" -;; ; is considered to be INBOX and not an astring. -;; ; Refer to section 5.1 for further -;; ; semantic details of mailbox names. - -(defsubst imap-parse-mailbox () - (let ((mailbox (imap-parse-astring))) - (if (string-equal "INBOX" (upcase mailbox)) - "INBOX" - mailbox))) - -;; greeting = "*" SP (resp-cond-auth / resp-cond-bye) CRLF -;; -;; resp-cond-auth = ("OK" / "PREAUTH") SP resp-text -;; ; Authentication condition -;; -;; resp-cond-bye = "BYE" SP resp-text - -(defun imap-parse-greeting () - "Parse a IMAP greeting." - (cond ((looking-at "\\* OK ") - (setq imap-state 'nonauth)) - ((looking-at "\\* PREAUTH ") - (setq imap-state 'auth)) - ((looking-at "\\* BYE ") - (setq imap-state 'closed)))) - -;; response = *(continue-req / response-data) response-done -;; -;; continue-req = "+" SP (resp-text / base64) CRLF -;; -;; response-data = "*" SP (resp-cond-state / resp-cond-bye / -;; mailbox-data / message-data / capability-data) CRLF -;; -;; response-done = response-tagged / response-fatal -;; -;; response-fatal = "*" SP resp-cond-bye CRLF -;; ; Server closes connection immediately -;; -;; response-tagged = tag SP resp-cond-state CRLF -;; -;; resp-cond-state = ("OK" / "NO" / "BAD") SP resp-text -;; ; Status condition -;; -;; resp-cond-bye = "BYE" SP resp-text -;; -;; mailbox-data = "FLAGS" SP flag-list / -;; "LIST" SP mailbox-list / -;; "LSUB" SP mailbox-list / -;; "SEARCH" *(SP nz-number) / -;; "STATUS" SP mailbox SP "(" -;; [status-att SP number *(SP status-att SP number)] ")" / -;; number SP "EXISTS" / -;; number SP "RECENT" -;; -;; message-data = nz-number SP ("EXPUNGE" / ("FETCH" SP msg-att)) -;; -;; capability-data = "CAPABILITY" *(SP capability) SP "IMAP4rev1" -;; *(SP capability) -;; ; IMAP4rev1 servers which offer RFC 1730 -;; ; compatibility MUST list "IMAP4" as the first -;; ; capability. - -(defun imap-parse-response () - "Parse a IMAP command response." - (let (token) - (case (setq token (read (current-buffer))) - (+ (setq imap-continuation - (or (buffer-substring (min (point-max) (1+ (point))) - (point-max)) - t))) - (* (case (prog1 (setq token (read (current-buffer))) - (imap-forward)) - (OK (imap-parse-resp-text)) - (NO (imap-parse-resp-text)) - (BAD (imap-parse-resp-text)) - (BYE (imap-parse-resp-text)) - (FLAGS (imap-mailbox-put 'flags (imap-parse-flag-list))) - (LIST (imap-parse-data-list 'list)) - (LSUB (imap-parse-data-list 'lsub)) - (SEARCH (imap-mailbox-put - 'search - (read (concat "(" (buffer-substring (point) (point-max)) ")")))) - (STATUS (imap-parse-status)) - (CAPABILITY (setq imap-capability - (read (concat "(" (upcase (buffer-substring - (point) (point-max))) - ")")))) - (ACL (imap-parse-acl)) - (t (case (prog1 (read (current-buffer)) - (imap-forward)) - (EXISTS (imap-mailbox-put 'exists token)) - (RECENT (imap-mailbox-put 'recent token)) - (EXPUNGE t) - (FETCH (imap-parse-fetch token)) - (t (message "Garbage: %s" (buffer-string))))))) - (t (let (status) - (if (not (integerp token)) - (message "Garbage: %s" (buffer-string)) - (case (prog1 (setq status (read (current-buffer))) - (imap-forward)) - (OK (progn - (setq imap-reached-tag (max imap-reached-tag token)) - (imap-parse-resp-text))) - (NO (progn - (setq imap-reached-tag (max imap-reached-tag token)) - (save-excursion - (imap-parse-resp-text)) - (let (code text) - (when (eq (char-after) ?\[) - (setq code (buffer-substring (point) - (search-forward "]"))) - (imap-forward)) - (setq text (buffer-substring (point) (point-max))) - (push (list token status code text) - imap-failed-tags)))) - (BAD (progn - (setq imap-reached-tag (max imap-reached-tag token)) - (save-excursion - (imap-parse-resp-text)) - (let (code text) - (when (eq (char-after) ?\[) - (setq code (buffer-substring (point) - (search-forward "]"))) - (imap-forward)) - (setq text (buffer-substring (point) (point-max))) - (push (list token status code text) imap-failed-tags) - (error "Internal error, tag %s status %s code %s text %s" - token status code text)))) - (t (message "Garbage: %s" (buffer-string)))) - (when (assq token imap-callbacks) - (funcall (cdr (assq token imap-callbacks)) token status) - (setq imap-callbacks - (imap-remassoc token imap-callbacks))))))))) - -;; resp-text = ["[" resp-text-code "]" SP] text -;; -;; text = 1*TEXT-CHAR -;; -;; TEXT-CHAR = - -(defun imap-parse-resp-text () - (imap-parse-resp-text-code)) - -;; resp-text-code = "ALERT" / -;; "BADCHARSET [SP "(" astring *(SP astring) ")" ] / -;; "NEWNAME" SP string SP string / -;; "PARSE" / -;; "PERMANENTFLAGS" SP "(" -;; [flag-perm *(SP flag-perm)] ")" / -;; "READ-ONLY" / -;; "READ-WRITE" / -;; "TRYCREATE" / -;; "UIDNEXT" SP nz-number / -;; "UIDVALIDITY" SP nz-number / -;; "UNSEEN" SP nz-number / -;; resp-text-atom [SP 1*] -;; -;; resp_code_apnd = "APPENDUID" SPACE nz_number SPACE uniqueid -;; -;; resp_code_copy = "COPYUID" SPACE nz_number SPACE set SPACE set -;; -;; set = sequence-num / (sequence-num ":" sequence-num) / -;; (set "," set) -;; ; Identifies a set of messages. For message -;; ; sequence numbers, these are consecutive -;; ; numbers from 1 to the number of messages in -;; ; the mailbox -;; ; Comma delimits individual numbers, colon -;; ; delimits between two numbers inclusive. -;; ; Example: 2,4:7,9,12:* is 2,4,5,6,7,9,12,13, -;; ; 14,15 for a mailbox with 15 messages. -;; -;; sequence-num = nz-number / "*" -;; ; * is the largest number in use. For message -;; ; sequence numbers, it is the number of messages -;; ; in the mailbox. For unique identifiers, it is -;; ; the unique identifier of the last message in -;; ; the mailbox. -;; -;; flag-perm = flag / "\*" -;; -;; flag = "\Answered" / "\Flagged" / "\Deleted" / -;; "\Seen" / "\Draft" / flag-keyword / flag-extension -;; ; Does not include "\Recent" -;; -;; flag-extension = "\" atom -;; ; Future expansion. Client implementations -;; ; MUST accept flag-extension flags. Server -;; ; implementations MUST NOT generate -;; ; flag-extension flags except as defined by -;; ; future standard or standards-track -;; ; revisions of this specification. -;; -;; flag-keyword = atom -;; -;; resp-text-atom = 1* - -(defun imap-parse-resp-text-code () - ;; xxx next line for stalker communigate pro 3.3.1 bug - (when (looking-at " \\[") - (imap-forward)) - (when (eq (char-after) ?\[) - (imap-forward) - (cond ((search-forward "PERMANENTFLAGS " nil t) - (imap-mailbox-put 'permanentflags (imap-parse-flag-list))) - ((search-forward "UIDNEXT \\([0-9]+\\)" nil t) - (imap-mailbox-put 'uidnext (match-string 1))) - ((search-forward "UNSEEN " nil t) - (imap-mailbox-put 'first-unseen (read (current-buffer)))) - ((looking-at "UIDVALIDITY \\([0-9]+\\)") - (imap-mailbox-put 'uidvalidity (match-string 1))) - ((search-forward "READ-ONLY" nil t) - (imap-mailbox-put 'read-only t)) - ((search-forward "NEWNAME " nil t) - (let (oldname newname) - (setq oldname (imap-parse-string)) - (imap-forward) - (setq newname (imap-parse-string)) - (imap-mailbox-put 'newname newname oldname))) - ((search-forward "TRYCREATE" nil t) - (imap-mailbox-put 'trycreate t imap-current-target-mailbox)) - ((looking-at "APPENDUID \\([0-9]+\\) \\([0-9]+\\)") - (imap-mailbox-put 'appenduid - (list (match-string 1) - (string-to-number (match-string 2))) - imap-current-target-mailbox)) - ((looking-at "COPYUID \\([0-9]+\\) \\([0-9,:]+\\) \\([0-9,:]+\\)") - (imap-mailbox-put 'copyuid (list (match-string 1) - (match-string 2) - (match-string 3)) - imap-current-target-mailbox)) - ((search-forward "ALERT] " nil t) - (message "Imap server %s information: %s" imap-server - (buffer-substring (point) (point-max))))))) - -;; mailbox-list = "(" [mbx-list-flags] ")" SP -;; (DQUOTE QUOTED-CHAR DQUOTE / nil) SP mailbox -;; -;; mbx-list-flags = *(mbx-list-oflag SP) mbx-list-sflag -;; *(SP mbx-list-oflag) / -;; mbx-list-oflag *(SP mbx-list-oflag) -;; -;; mbx-list-oflag = "\Noinferiors" / flag-extension -;; ; Other flags; multiple possible per LIST response -;; -;; mbx-list-sflag = "\Noselect" / "\Marked" / "\Unmarked" -;; ; Selectability flags; only one per LIST response -;; -;; QUOTED-CHAR = / -;; "\" quoted-specials -;; -;; quoted-specials = DQUOTE / "\" - -(defun imap-parse-data-list (type) - (let (flags delimiter mailbox) - (setq flags (imap-parse-flag-list)) - (when (looking-at " NIL\\| \"\\\\?\\(.\\)\"") - (setq delimiter (match-string 1)) - (goto-char (1+ (match-end 0))) - (when (setq mailbox (imap-parse-mailbox)) - (imap-mailbox-put type t mailbox) - (imap-mailbox-put 'list-flags flags mailbox) - (imap-mailbox-put 'delimiter delimiter mailbox))))) - -;; msg_att ::= "(" 1#("ENVELOPE" SPACE envelope / -;; "FLAGS" SPACE "(" #(flag / "\Recent") ")" / -;; "INTERNALDATE" SPACE date_time / -;; "RFC822" [".HEADER" / ".TEXT"] SPACE nstring / -;; "RFC822.SIZE" SPACE number / -;; "BODY" ["STRUCTURE"] SPACE body / -;; "BODY" section ["<" number ">"] SPACE nstring / -;; "UID" SPACE uniqueid) ")" -;; -;; date_time ::= <"> date_day_fixed "-" date_month "-" date_year -;; SPACE time SPACE zone <"> -;; -;; section ::= "[" [section_text / (nz_number *["." nz_number] -;; ["." (section_text / "MIME")])] "]" -;; -;; section_text ::= "HEADER" / "HEADER.FIELDS" [".NOT"] -;; SPACE header_list / "TEXT" -;; -;; header_fld_name ::= astring -;; -;; header_list ::= "(" 1#header_fld_name ")" - -(defsubst imap-parse-header-list () - (when (eq (char-after) ?\() - (let (strlist) - (while (not (eq (char-after) ?\))) - (imap-forward) - (push (imap-parse-astring) strlist)) - (imap-forward) - (nreverse strlist)))) - -(defsubst imap-parse-fetch-body-section () - (let ((section - (buffer-substring (point) (1- (re-search-forward "[] ]" nil t))))) - (if (eq (char-before) ? ) - (prog1 - (mapconcat 'identity (cons section (imap-parse-header-list)) " ") - (search-forward "]" nil t)) - section))) - -(defun imap-parse-fetch (response) - (when (eq (char-after) ?\() - (let (uid flags envelope internaldate rfc822 rfc822header rfc822text - rfc822size body bodydetail bodystructure flags-empty) - (while (not (eq (char-after) ?\))) - (imap-forward) - (let ((token (read (current-buffer)))) - (imap-forward) - (cond ((eq token 'UID) - (setq uid (condition-case () - (read (current-buffer)) - (error)))) - ((eq token 'FLAGS) - (setq flags (imap-parse-flag-list)) - (if (not flags) - (setq flags-empty 't))) - ((eq token 'ENVELOPE) - (setq envelope (imap-parse-envelope))) - ((eq token 'INTERNALDATE) - (setq internaldate (imap-parse-string))) - ((eq token 'RFC822) - (setq rfc822 (imap-parse-nstring))) - ((eq token 'RFC822.HEADER) - (setq rfc822header (imap-parse-nstring))) - ((eq token 'RFC822.TEXT) - (setq rfc822text (imap-parse-nstring))) - ((eq token 'RFC822.SIZE) - (setq rfc822size (read (current-buffer)))) - ((eq token 'BODY) - (if (eq (char-before) ?\[) - (push (list - (upcase (imap-parse-fetch-body-section)) - (and (eq (char-after) ?<) - (buffer-substring (1+ (point)) - (search-forward ">" nil t))) - (progn (imap-forward) - (imap-parse-nstring))) - bodydetail) - (setq body (imap-parse-body)))) - ((eq token 'BODYSTRUCTURE) - (setq bodystructure (imap-parse-body)))))) - (when uid - (setq imap-current-message uid) - (imap-message-put uid 'UID uid) - (and (or flags flags-empty) (imap-message-put uid 'FLAGS flags)) - (and envelope (imap-message-put uid 'ENVELOPE envelope)) - (and internaldate (imap-message-put uid 'INTERNALDATE internaldate)) - (and rfc822 (imap-message-put uid 'RFC822 rfc822)) - (and rfc822header (imap-message-put uid 'RFC822.HEADER rfc822header)) - (and rfc822text (imap-message-put uid 'RFC822.TEXT rfc822text)) - (and rfc822size (imap-message-put uid 'RFC822.SIZE rfc822size)) - (and body (imap-message-put uid 'BODY body)) - (and bodydetail (imap-message-put uid 'BODYDETAIL bodydetail)) - (and bodystructure (imap-message-put uid 'BODYSTRUCTURE bodystructure)) - (run-hooks 'imap-fetch-data-hook))))) - -;; mailbox-data = ... -;; "STATUS" SP mailbox SP "(" -;; [status-att SP number -;; *(SP status-att SP number)] ")" -;; ... -;; -;; status-att = "MESSAGES" / "RECENT" / "UIDNEXT" / "UIDVALIDITY" / -;; "UNSEEN" - -(defun imap-parse-status () - (let ((mailbox (imap-parse-mailbox))) - (if (eq (char-after) ? ) - (forward-char)) - (when (and mailbox (eq (char-after) ?\()) - (while (and (not (eq (char-after) ?\))) - (or (forward-char) t) - (looking-at "\\([A-Za-z]+\\) ")) - (let ((token (match-string 1))) - (goto-char (match-end 0)) - (cond ((string= token "MESSAGES") - (imap-mailbox-put 'messages (read (current-buffer)) mailbox)) - ((string= token "RECENT") - (imap-mailbox-put 'recent (read (current-buffer)) mailbox)) - ((string= token "UIDNEXT") - (and (looking-at "[0-9]+") - (imap-mailbox-put 'uidnext (match-string 0) mailbox) - (goto-char (match-end 0)))) - ((string= token "UIDVALIDITY") - (and (looking-at "[0-9]+") - (imap-mailbox-put 'uidvalidity (match-string 0) mailbox) - (goto-char (match-end 0)))) - ((string= token "UNSEEN") - (imap-mailbox-put 'unseen (read (current-buffer)) mailbox)) - (t - (message "Unknown status data %s in mailbox %s ignored" - token mailbox) - (read (current-buffer))))))))) - -;; acl_data ::= "ACL" SPACE mailbox *(SPACE identifier SPACE -;; rights) -;; -;; identifier ::= astring -;; -;; rights ::= astring - -(defun imap-parse-acl () - (let ((mailbox (imap-parse-mailbox)) - identifier rights acl) - (while (eq (char-after) ?\ ) - (imap-forward) - (setq identifier (imap-parse-astring)) - (imap-forward) - (setq rights (imap-parse-astring)) - (setq acl (append acl (list (cons identifier rights))))) - (imap-mailbox-put 'acl acl mailbox))) - -;; flag-list = "(" [flag *(SP flag)] ")" -;; -;; flag = "\Answered" / "\Flagged" / "\Deleted" / -;; "\Seen" / "\Draft" / flag-keyword / flag-extension -;; ; Does not include "\Recent" -;; -;; flag-keyword = atom -;; -;; flag-extension = "\" atom -;; ; Future expansion. Client implementations -;; ; MUST accept flag-extension flags. Server -;; ; implementations MUST NOT generate -;; ; flag-extension flags except as defined by -;; ; future standard or standards-track -;; ; revisions of this specification. - -(defun imap-parse-flag-list () - (let (flag-list start) - (assert (eq (char-after) ?\() nil "In imap-parse-flag-list") - (while (and (not (eq (char-after) ?\))) - (setq start (progn - (imap-forward) - ;; next line for Courier IMAP bug. - (skip-chars-forward " ") - (point))) - (> (skip-chars-forward "^ )" (imap-point-at-eol)) 0)) - (push (buffer-substring start (point)) flag-list)) - (assert (eq (char-after) ?\)) nil "In imap-parse-flag-list") - (imap-forward) - (nreverse flag-list))) - -;; envelope = "(" env-date SP env-subject SP env-from SP env-sender SP -;; env-reply-to SP env-to SP env-cc SP env-bcc SP -;; env-in-reply-to SP env-message-id ")" -;; -;; env-bcc = "(" 1*address ")" / nil -;; -;; env-cc = "(" 1*address ")" / nil -;; -;; env-date = nstring -;; -;; env-from = "(" 1*address ")" / nil -;; -;; env-in-reply-to = nstring -;; -;; env-message-id = nstring -;; -;; env-reply-to = "(" 1*address ")" / nil -;; -;; env-sender = "(" 1*address ")" / nil -;; -;; env-subject = nstring -;; -;; env-to = "(" 1*address ")" / nil - -(defun imap-parse-envelope () - (when (eq (char-after) ?\() - (imap-forward) - (vector (prog1 (imap-parse-nstring) ;; date - (imap-forward)) - (prog1 (imap-parse-nstring) ;; subject - (imap-forward)) - (prog1 (imap-parse-address-list) ;; from - (imap-forward)) - (prog1 (imap-parse-address-list) ;; sender - (imap-forward)) - (prog1 (imap-parse-address-list) ;; reply-to - (imap-forward)) - (prog1 (imap-parse-address-list) ;; to - (imap-forward)) - (prog1 (imap-parse-address-list) ;; cc - (imap-forward)) - (prog1 (imap-parse-address-list) ;; bcc - (imap-forward)) - (prog1 (imap-parse-nstring) ;; in-reply-to - (imap-forward)) - (prog1 (imap-parse-nstring) ;; message-id - (imap-forward))))) - -;; body-fld-param = "(" string SP string *(SP string SP string) ")" / nil - -(defsubst imap-parse-string-list () - (cond ((eq (char-after) ?\() ;; body-fld-param - (let (strlist str) - (imap-forward) - (while (setq str (imap-parse-string)) - (push str strlist) - ;; buggy stalker communigate pro 3.0 doesn't print SPC - ;; between body-fld-param's sometimes - (or (eq (char-after) ?\") - (imap-forward))) - (nreverse strlist))) - ((imap-parse-nil) - nil))) - -;; body-extension = nstring / number / -;; "(" body-extension *(SP body-extension) ")" -;; ; Future expansion. Client implementations -;; ; MUST accept body-extension fields. Server -;; ; implementations MUST NOT generate -;; ; body-extension fields except as defined by -;; ; future standard or standards-track -;; ; revisions of this specification. - -(defun imap-parse-body-extension () - (if (eq (char-after) ?\() - (let (b-e) - (imap-forward) - (push (imap-parse-body-extension) b-e) - (while (eq (char-after) ?\ ) - (imap-forward) - (push (imap-parse-body-extension) b-e)) - (assert (eq (char-after) ?\)) nil "In imap-parse-body-extension") - (imap-forward) - (nreverse b-e)) - (or (imap-parse-number) - (imap-parse-nstring)))) - -;; body-ext-1part = body-fld-md5 [SP body-fld-dsp [SP body-fld-lang -;; *(SP body-extension)]] -;; ; MUST NOT be returned on non-extensible -;; ; "BODY" fetch -;; -;; body-ext-mpart = body-fld-param [SP body-fld-dsp [SP body-fld-lang -;; *(SP body-extension)]] -;; ; MUST NOT be returned on non-extensible -;; ; "BODY" fetch - -(defsubst imap-parse-body-ext () - (let (ext) - (when (eq (char-after) ?\ ) ;; body-fld-dsp - (imap-forward) - (let (dsp) - (if (eq (char-after) ?\() - (progn - (imap-forward) - (push (imap-parse-string) dsp) - (imap-forward) - (push (imap-parse-string-list) dsp) - (imap-forward)) - ;; With assert, the code might not be eval'd. - ;; (assert (imap-parse-nil) t "In imap-parse-body-ext") - (imap-parse-nil)) - (push (nreverse dsp) ext)) - (when (eq (char-after) ?\ ) ;; body-fld-lang - (imap-forward) - (if (eq (char-after) ?\() - (push (imap-parse-string-list) ext) - (push (imap-parse-nstring) ext)) - (while (eq (char-after) ?\ ) ;; body-extension - (imap-forward) - (setq ext (append (imap-parse-body-extension) ext))))) - ext)) - -;; body = "(" body-type-1part / body-type-mpart ")" -;; -;; body-ext-1part = body-fld-md5 [SP body-fld-dsp [SP body-fld-lang -;; *(SP body-extension)]] -;; ; MUST NOT be returned on non-extensible -;; ; "BODY" fetch -;; -;; body-ext-mpart = body-fld-param [SP body-fld-dsp [SP body-fld-lang -;; *(SP body-extension)]] -;; ; MUST NOT be returned on non-extensible -;; ; "BODY" fetch -;; -;; body-fields = body-fld-param SP body-fld-id SP body-fld-desc SP -;; body-fld-enc SP body-fld-octets -;; -;; body-fld-desc = nstring -;; -;; body-fld-dsp = "(" string SP body-fld-param ")" / nil -;; -;; body-fld-enc = (DQUOTE ("7BIT" / "8BIT" / "BINARY" / "BASE64"/ -;; "QUOTED-PRINTABLE") DQUOTE) / string -;; -;; body-fld-id = nstring -;; -;; body-fld-lang = nstring / "(" string *(SP string) ")" -;; -;; body-fld-lines = number -;; -;; body-fld-md5 = nstring -;; -;; body-fld-octets = number -;; -;; body-fld-param = "(" string SP string *(SP string SP string) ")" / nil -;; -;; body-type-1part = (body-type-basic / body-type-msg / body-type-text) -;; [SP body-ext-1part] -;; -;; body-type-basic = media-basic SP body-fields -;; ; MESSAGE subtype MUST NOT be "RFC822" -;; -;; body-type-msg = media-message SP body-fields SP envelope -;; SP body SP body-fld-lines -;; -;; body-type-text = media-text SP body-fields SP body-fld-lines -;; -;; body-type-mpart = 1*body SP media-subtype -;; [SP body-ext-mpart] -;; -;; media-basic = ((DQUOTE ("APPLICATION" / "AUDIO" / "IMAGE" / -;; "MESSAGE" / "VIDEO") DQUOTE) / string) SP media-subtype -;; ; Defined in [MIME-IMT] -;; -;; media-message = DQUOTE "MESSAGE" DQUOTE SP DQUOTE "RFC822" DQUOTE -;; ; Defined in [MIME-IMT] -;; -;; media-subtype = string -;; ; Defined in [MIME-IMT] -;; -;; media-text = DQUOTE "TEXT" DQUOTE SP media-subtype -;; ; Defined in [MIME-IMT] - -(defun imap-parse-body () - (let (body) - (when (eq (char-after) ?\() - (imap-forward) - (if (eq (char-after) ?\() - (let (subbody) - (while (and (eq (char-after) ?\() - (setq subbody (imap-parse-body))) - ;; buggy stalker communigate pro 3.0 insert a SPC between - ;; parts in multiparts - (when (and (eq (char-after) ?\ ) - (eq (char-after (1+ (point))) ?\()) - (imap-forward)) - (push subbody body)) - (imap-forward) - (push (imap-parse-string) body) ;; media-subtype - (when (eq (char-after) ?\ ) ;; body-ext-mpart: - (imap-forward) - (if (eq (char-after) ?\() ;; body-fld-param - (push (imap-parse-string-list) body) - (push (and (imap-parse-nil) nil) body)) - (setq body - (append (imap-parse-body-ext) body))) ;; body-ext-... - (assert (eq (char-after) ?\)) nil "In imap-parse-body") - (imap-forward) - (nreverse body)) - - (push (imap-parse-string) body) ;; media-type - (imap-forward) - (push (imap-parse-string) body) ;; media-subtype - (imap-forward) - ;; next line for Sun SIMS bug - (and (eq (char-after) ? ) (imap-forward)) - (if (eq (char-after) ?\() ;; body-fld-param - (push (imap-parse-string-list) body) - (push (and (imap-parse-nil) nil) body)) - (imap-forward) - (push (imap-parse-nstring) body) ;; body-fld-id - (imap-forward) - (push (imap-parse-nstring) body) ;; body-fld-desc - (imap-forward) - ;; next `or' for Sun SIMS bug, it regard body-fld-enc as a - ;; nstring and return nil instead of defaulting back to 7BIT - ;; as the standard says. - (push (or (imap-parse-nstring) "7BIT") body) ;; body-fld-enc - (imap-forward) - (push (imap-parse-number) body) ;; body-fld-octets - - ;; ok, we're done parsing the required parts, what comes now is one - ;; of three things: - ;; - ;; envelope (then we're parsing body-type-msg) - ;; body-fld-lines (then we're parsing body-type-text) - ;; body-ext-1part (then we're parsing body-type-basic) - ;; - ;; the problem is that the two first are in turn optionally followed -;; by the third. So we parse the first two here (if there are any)... - - (when (eq (char-after) ?\ ) - (imap-forward) - (let (lines) - (cond ((eq (char-after) ?\() ;; body-type-msg: - (push (imap-parse-envelope) body) ;; envelope - (imap-forward) - (push (imap-parse-body) body) ;; body - ;; buggy stalker communigate pro 3.0 doesn't print - ;; number of lines in message/rfc822 attachment - (if (eq (char-after) ?\)) - (push 0 body) - (imap-forward) - (push (imap-parse-number) body))) ;; body-fld-lines - ((setq lines (imap-parse-number)) ;; body-type-text: - (push lines body)) ;; body-fld-lines - (t - (backward-char))))) ;; no match... - - ;; ...and then parse the third one here... - - (when (eq (char-after) ?\ ) ;; body-ext-1part: - (imap-forward) - (push (imap-parse-nstring) body) ;; body-fld-md5 - (setq body (append (imap-parse-body-ext) body))) ;; body-ext-1part.. - - (assert (eq (char-after) ?\)) nil "In imap-parse-body 2") - (imap-forward) - (nreverse body))))) - -(when imap-debug ; (untrace-all) - (require 'trace) - (buffer-disable-undo (get-buffer-create imap-debug-buffer)) - (mapcar (lambda (f) (trace-function-background f imap-debug-buffer)) - '( - imap-utf7-encode - imap-utf7-decode - imap-error-text - imap-kerberos4s-p - imap-kerberos4-open - imap-ssl-p - imap-ssl-open - imap-network-p - imap-network-open - imap-interactive-login - imap-kerberos4a-p - imap-kerberos4-auth - imap-cram-md5-p - imap-cram-md5-auth - imap-login-p - imap-login-auth - imap-anonymous-p - imap-anonymous-auth - imap-open-1 - imap-open - imap-opened - imap-authenticate - imap-close - imap-capability - imap-namespace - imap-send-command-wait - imap-mailbox-put - imap-mailbox-get - imap-mailbox-map-1 - imap-mailbox-map - imap-current-mailbox - imap-current-mailbox-p-1 - imap-current-mailbox-p - imap-mailbox-select-1 - imap-mailbox-select - imap-mailbox-examine-1 - imap-mailbox-examine - imap-mailbox-unselect - imap-mailbox-expunge - imap-mailbox-close - imap-mailbox-create-1 - imap-mailbox-create - imap-mailbox-delete - imap-mailbox-rename - imap-mailbox-lsub - imap-mailbox-list - imap-mailbox-subscribe - imap-mailbox-unsubscribe - imap-mailbox-status - imap-mailbox-acl-get - imap-mailbox-acl-set - imap-mailbox-acl-delete - imap-current-message - imap-list-to-message-set - imap-fetch-asynch - imap-fetch - imap-message-put - imap-message-get - imap-message-map - imap-search - imap-message-flag-permanent-p - imap-message-flags-set - imap-message-flags-del - imap-message-flags-add - imap-message-copyuid-1 - imap-message-copyuid - imap-message-copy - imap-message-appenduid-1 - imap-message-appenduid - imap-message-append - imap-body-lines - imap-envelope-from - imap-send-command-1 - imap-send-command - imap-wait-for-tag - imap-sentinel - imap-find-next-line - imap-arrival-filter - imap-parse-greeting - imap-parse-response - imap-parse-resp-text - imap-parse-resp-text-code - imap-parse-data-list - imap-parse-fetch - imap-parse-status - imap-parse-acl - imap-parse-flag-list - imap-parse-envelope - imap-parse-body-extension - imap-parse-body - ))) - -(provide 'imap) - -;;; arch-tag: 27369ed6-33e4-482f-96f1-8bb906ba70f7 -;;; imap.el ends here diff --git a/xemacs-packages/gnus/lisp/legacy-gnus-agent.el b/xemacs-packages/gnus/lisp/legacy-gnus-agent.el deleted file mode 100644 index 7a3cfb98..00000000 --- a/xemacs-packages/gnus/lisp/legacy-gnus-agent.el +++ /dev/null @@ -1,259 +0,0 @@ -;;; gnus-agent.el --- Legacy unplugged support for Gnus - -;; Copyright (C) 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Kevin Greiner -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; Conversion functions for the Agent. - -;;; Code: -(require 'gnus-start) -(require 'gnus-util) -(require 'gnus-range) -(require 'gnus-agent) - -;; Oort Gnus v0.08 - This release updated agent to no longer use -;; history file and to support a compressed alist. - -(defvar gnus-agent-compressed-agentview-search-only nil) - -(defun gnus-agent-convert-to-compressed-agentview (converting-to) - "Iterates over all agentview files to ensure that they have been -converted to the compressed format." - - (let ((search-in (list gnus-agent-directory)) - here - members - member - converted-something) - (while (setq here (pop search-in)) - (setq members (directory-files here t)) - (while (setq member (pop members)) - (cond ((string-match "/\\.\\.?$" member) - nil) - ((file-directory-p member) - (push member search-in)) - ((equal (file-name-nondirectory member) ".agentview") - (setq converted-something - (or (gnus-agent-convert-agentview member) - converted-something)))))) - - (if converted-something - (gnus-message 4 "Successfully converted Gnus %s offline (agent) files to %s" gnus-newsrc-file-version converting-to)))) - -(defun gnus-agent-convert-to-compressed-agentview-prompt () - (catch 'found-file-to-convert - (let ((gnus-agent-compressed-agentview-search-only t)) - (gnus-agent-convert-to-compressed-agentview nil)))) - -(gnus-convert-mark-converter-prompt 'gnus-agent-convert-to-compressed-agentview 'gnus-agent-convert-to-compressed-agentview-prompt) - -(defun gnus-agent-convert-agentview (file) - "Load FILE and do a `read' there." - (with-temp-buffer - (nnheader-insert-file-contents file) - (goto-char (point-min)) - (let ((inhibit-quit t) - (alist (read (current-buffer))) - (version (condition-case nil (read (current-buffer)) - (end-of-file 0))) - changed-version - history-file) - - (cond - ((= version 0) - (let (entry - (gnus-command-method nil)) - (mm-disable-multibyte) ;; everything is binary - (erase-buffer) - (insert "\n") - (let ((file (concat (file-name-directory file) "/history"))) - (when (file-exists-p file) - (nnheader-insert-file-contents file) - (setq history-file file))) - - (goto-char (point-min)) - (while (not (eobp)) - (if (and (looking-at - "[^\t\n]+\t\\([0-9]+\\)\t\\([^ \n]+\\) \\([0-9]+\\)") - (string= (gnus-agent-article-name ".agentview" (match-string 2)) - file) - (setq entry (assoc (string-to-number (match-string 3)) alist))) - (setcdr entry (string-to-number (match-string 1)))) - (forward-line 1)) - (setq changed-version t))) - ((= version 1) - (setq changed-version t))) - - (when changed-version - (when gnus-agent-compressed-agentview-search-only - (throw 'found-file-to-convert t)) - - (erase-buffer) - (let ((compressed nil)) - (mapcar (lambda (pair) - (let* ((article-id (car pair)) - (day-of-download (cdr pair)) - (comp-list (assq day-of-download compressed))) - (if comp-list - (setcdr comp-list - (cons article-id (cdr comp-list))) - (setq compressed - (cons (list day-of-download article-id) - compressed))) - nil)) alist) - (mapcar (lambda (comp-list) - (setcdr comp-list - (gnus-compress-sequence - (nreverse (cdr comp-list))))) - compressed) - (princ compressed (current-buffer))) - (insert "\n2\n") - (write-file file) - (when history-file - (delete-file history-file)) - t)))) - -;; End of Oort Gnus v0.08 updates - -;; No Gnus v0.3 - This release provides a mechanism for upgrading gnus -;; from previous versions. Therefore, the previous -;; hacks to handle a gnus-agent-expire-days that -;; specifies a list of values can be removed. - -(defun gnus-agent-unlist-expire-days (converting-to) - (when (listp gnus-agent-expire-days) - (let (buffer) - (unwind-protect - (save-window-excursion - (setq buffer (gnus-get-buffer-create " *Gnus agent upgrade*")) - (set-buffer buffer) - (erase-buffer) - (insert "The definition of gnus-agent-expire-days has been changed.\nYou currently have it set to the list:\n ") - (gnus-pp gnus-agent-expire-days) - - (insert "\nIn order to use version '" converting-to "' of gnus, you will need to set\n") - (insert "gnus-agent-expire-days to an integer. If you still wish to set different\n") - (insert "expiration days to individual groups, you must instead set the\n") - (insert "'agent-days-until-old group and/or topic parameter.\n") - (insert "\n") - (insert "If you would like, gnus can iterate over every group comparing its name to the\n") - (insert "regular expressions that you currently have in gnus-agent-expire-days. When\n") - (insert "gnus finds a match, it will update that group's 'agent-days-until-old group\n") - (insert "parameter to the value associated with the regular expression.\n") - (insert "\n") - (insert "Whether gnus assigns group parameters, or not, gnus will terminate with an\n") - (insert "ERROR as soon as this function completes. The reason is that you must\n") - (insert "manually edit your configuration to either not set gnus-agent-expire-days or\n") - (insert "to set it to an integer before gnus can be used.\n") - (insert "\n") - (insert "Once you have successfully edited gnus-agent-expire-days, gnus will be able to\n") - (insert "execute past this function.\n") - (insert "\n") - (insert "Should gnus use gnus-agent-expire-days to assign\n") - (insert "agent-days-until-old parameters to individual groups? (Y/N)") - - (switch-to-buffer buffer) - (beep) - (beep) - - (let ((echo-keystrokes 0) - c) - (while (progn (setq c (read-char-exclusive)) - (cond ((or (eq c ?y) (eq c ?Y)) - (save-excursion - (let ((groups (gnus-group-listed-groups))) - (while groups - (let* ((group (pop groups)) - (days gnus-agent-expire-days) - (day (catch 'found - (while days - (when (eq 0 (string-match - (caar days) - group)) - (throw 'found (cadar days))) - (setq days (cdr days))) - nil))) - (when day - (gnus-group-set-parameter group 'agent-days-until-old - day)))))) - nil - ) - ((or (eq c ?n) (eq c ?N)) - nil) - (t - t)))))) - (kill-buffer buffer)) - (error "Change gnus-agent-expire-days to an integer for gnus to start")))) - -;; The gnus-agent-unlist-expire-days has its own conversion prompt. -;; Therefore, hide the default prompt. -(gnus-convert-mark-converter-prompt 'gnus-agent-unlist-expire-days t) - -(defun gnus-agent-unhook-expire-days (converting-to) - "Remove every lambda from gnus-group-prepare-hook that mention the -symbol gnus-agent-do-once in their definition. This should NOT be -necessary as gnus-agent.el no longer adds them. However, it is -possible that the hook was persistently saved." - (let ((h t)) ; iterate from bgn of hook - (while h - (let ((func (progn (when (eq h t) - ;; init h to list of functions - (setq h (cond ((listp gnus-group-prepare-hook) - gnus-group-prepare-hook) - ((boundp 'gnus-group-prepare-hook) - (list gnus-group-prepare-hook))))) - (pop h)))) - - (when (cond ((eq (type-of func) 'compiled-function) - ;; Search def. of compiled function for gnus-agent-do-once string - (let* (definition - print-level - print-length - (standard-output - (lambda (char) - (setq definition (cons char definition))))) - (princ func) ; populates definition with reversed list of characters - (let* ((i (length definition)) - (s (make-string i 0))) - (while definition - (aset s (setq i (1- i)) (pop definition))) - - (string-match "\\bgnus-agent-do-once\\b" s)))) - ((listp func) - (eq (cadr (nth 2 func)) 'gnus-agent-do-once) ; handles eval'd lambda - )) - - (remove-hook 'gnus-group-prepare-hook func) - ;; I don't what remove-hook is going to actually do to the - ;; hook list so start over from the beginning. - (setq h t)))))) - -;; gnus-agent-unhook-expire-days is safe in that it does not modify -;; the .newsrc.eld file. -(gnus-convert-mark-converter-prompt 'gnus-agent-unhook-expire-days t) - -(provide 'legacy-gnus-agent) - -;; arch-tag: 845c7b8a-88f7-4468-b8d7-94e8fc72cf1a -;;; legacy-gnus-agent.el ends here diff --git a/xemacs-packages/gnus/lisp/lpath.el b/xemacs-packages/gnus/lisp/lpath.el deleted file mode 100644 index d9063200..00000000 --- a/xemacs-packages/gnus/lisp/lpath.el +++ /dev/null @@ -1,92 +0,0 @@ -;; Shut up. - -(defun maybe-fbind (args) - (while args - (or (fboundp (car args)) - (defalias (car args) 'ignore)) - (setq args (cdr args)))) - -(defun maybe-bind (args) - (mapcar (lambda (var) (unless (boundp var) (set var nil))) args)) - -(unless (featurep 'xemacs) - (defun nnkiboze-score-file (a)) - (maybe-fbind - '(Info-menu - cp-supported-codepages delete-annotation glyph-height make-annotation - make-glyph map-extents set-extent-property set-itimer-function w3-do-setup - w3-prepare-buffer w3-region w32-focus-frame w3m-detect-meta-charset - w3m-region window-pixel-height window-pixel-width)) - - (when (<= emacs-major-version 22) - (maybe-fbind '(display-time-event-handler frame-device))) - - (when (= emacs-major-version 21) - (defun split-line (&optional arg)) - (maybe-fbind - '(bbdb-complete-name - custom-autoload delete-extent device-connection dfw-device - events-to-keys find-coding-system find-face font-lock-set-defaults - get-char-table glyph-width mail-aliases-setup make-event - make-network-process message-xmas-redefine put-char-table temp-directory - unicode-precedence-list url-generic-parse-url url-http-file-exists-p - url-insert-file-contents valid-image-instantiator-format-p - vcard-pretty-print w3-coding-system-for-mime-charset)) - (maybe-bind - '(filladapt-mode - help-echo-owns-message itimer-list ps-print-color-p url-version - w3-meta-charset-content-type-regexp - w3-meta-content-type-charset-regexp)))) - -(when (featurep 'xemacs) - (defun nnkiboze-score-file (a)) - (defun split-line (&optional arg)) - (maybe-fbind - '(codepage-setup - create-image detect-coding-string display-time-event-handler - event-click-count event-end event-start find-coding-systems-for-charsets - find-coding-systems-region find-coding-systems-string find-image - image-size image-type-available-p insert-image mail-abbrevs-setup - make-mode-line-mouse-map make-network-process mouse-minibuffer-check - mouse-movement-p mouse-scroll-subr posn-point posn-window put-image - read-event rmail-msg-is-pruned rmail-msg-restore-non-pruned-header - select-safe-coding-system sort-coding-systems track-mouse - url-generic-parse-url url-http-file-exists-p url-insert-file-contents - vcard-pretty-print w3m-detect-meta-charset window-edges)) - (maybe-bind - '(adaptive-fill-first-line-regexp - buffer-display-table cursor-in-non-selected-windows - default-enable-multibyte-characters filladapt-mode - gnus-agent-expire-current-dirs idna-program installation-directory - line-spacing mark-active mouse-selection-click-count - mouse-selection-click-count-buffer - rmail-insert-mime-forwarded-message-function tool-bar-mode - transient-mark-mode url-version w3-meta-charset-content-type-regexp - w3-meta-content-type-charset-regexp)) - - (when (or (and (= emacs-major-version 21) (= emacs-minor-version 4)) - (featurep 'sxemacs)) - (maybe-fbind - '(custom-autoload - display-graphic-p display-images-p display-visual-class - replace-regexp-in-string select-frame-set-input-focus - unicode-precedence-list w32-focus-frame x-focus-frame))) - - (unless (featurep 'mule) - (maybe-fbind - '(ccl-execute-on-string - charsetp coding-system-get get-charset-property pgg-parse-crc24-string - unicode-precedence-list)) - (maybe-bind - '(current-language-environment language-info-alist pgg-parse-crc24))) - - (unless (featurep 'file-coding) - (maybe-fbind - '(coding-system-base - coding-system-change-eol-conversion coding-system-list coding-system-p - find-coding-system)) - (maybe-bind '(buffer-file-coding-system enable-multibyte-characters)))) - -(provide 'lpath) - -;;; arch-tag: d1ad864f-dca6-4d21-aa3f-be3248e66dba diff --git a/xemacs-packages/gnus/lisp/mail-parse.el b/xemacs-packages/gnus/lisp/mail-parse.el deleted file mode 100644 index 33871a85..00000000 --- a/xemacs-packages/gnus/lisp/mail-parse.el +++ /dev/null @@ -1,79 +0,0 @@ -;;; mail-parse.el --- Interface functions for parsing mail - -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; This file contains wrapper functions for a wide range of mail -;; parsing functions. The idea is that there are low-level libraries -;; that impement according to various specs (RFC2231, DRUMS, USEFOR), -;; but that programmers that want to parse some header (say, -;; Content-Type) will want to use the latest spec. -;; -;; So while each low-level library (rfc2231.el, for instance) decodes -;; faithfully according to that (proposed) standard, this library is -;; the interface library. If some later RFC supersedes RFC2231, one -;; would just have to write a new low-level library, adjust the -;; aliases in this library, and the users and programmers won't notice -;; any changes. - -;;; Code: - -(require 'mail-prsvr) -(require 'ietf-drums) -(require 'rfc2231) -(require 'rfc2047) -(require 'rfc2045) - -(defalias 'mail-header-parse-content-type 'rfc2231-parse-qp-string) -(defalias 'mail-header-parse-content-disposition 'rfc2231-parse-qp-string) -(defalias 'mail-content-type-get 'rfc2231-get-value) -;(defalias 'mail-header-encode-parameter 'rfc2045-encode-string) -(defalias 'mail-header-encode-parameter 'rfc2231-encode-string) - -(defalias 'mail-header-remove-comments 'ietf-drums-remove-comments) -(defalias 'mail-header-remove-whitespace 'ietf-drums-remove-whitespace) -(defalias 'mail-header-strip 'ietf-drums-strip) -(defalias 'mail-header-get-comment 'ietf-drums-get-comment) -(defalias 'mail-header-parse-address 'ietf-drums-parse-address) -(defalias 'mail-header-parse-addresses 'ietf-drums-parse-addresses) -(defalias 'mail-header-parse-date 'ietf-drums-parse-date) -(defalias 'mail-narrow-to-head 'ietf-drums-narrow-to-header) -(defalias 'mail-quote-string 'ietf-drums-quote-string) - -(defalias 'mail-header-fold-field 'rfc2047-fold-field) -(defalias 'mail-header-unfold-field 'rfc2047-unfold-field) -(defalias 'mail-header-narrow-to-field 'rfc2047-narrow-to-field) -(defalias 'mail-header-field-value 'rfc2047-field-value) - -(defalias 'mail-encode-encoded-word-region 'rfc2047-encode-region) -(defalias 'mail-encode-encoded-word-buffer 'rfc2047-encode-message-header) -(defalias 'mail-encode-encoded-word-string 'rfc2047-encode-string) -(defalias 'mail-decode-encoded-word-region 'rfc2047-decode-region) -(defalias 'mail-decode-encoded-word-string 'rfc2047-decode-string) -(defalias 'mail-decode-encoded-address-region 'rfc2047-decode-address-region) -(defalias 'mail-decode-encoded-address-string 'rfc2047-decode-address-string) - -(provide 'mail-parse) - -;;; arch-tag: 3e63d75c-c962-4784-ab01-7ba07ca9d2d4 -;;; mail-parse.el ends here diff --git a/xemacs-packages/gnus/lisp/mail-prsvr.el b/xemacs-packages/gnus/lisp/mail-prsvr.el deleted file mode 100644 index b6fdd828..00000000 --- a/xemacs-packages/gnus/lisp/mail-prsvr.el +++ /dev/null @@ -1,47 +0,0 @@ -;;; mail-prsvr.el --- Interface variables for parsing mail - -;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(defvar mail-parse-charset nil - "Default charset used by low-level libraries. -This variable should never be set. Instead, it should be bound by -functions that wish to call mail-parse functions and let them know -what the desired charset is to be.") - -(defvar mail-parse-mule-charset nil - "Default MULE charset used by low-level libraries. -This variable should never be set.") - -(defvar mail-parse-ignored-charsets nil - "Ignored charsets used by low-level libraries. -This variable should never be set. Instead, it should be bound by -functions that wish to call mail-parse functions and let them know -what the desired charsets is to be ignored.") - -(provide 'mail-prsvr) - -;;; arch-tag: 9ba878cc-8b43-4f7a-85b1-69b1a9a5d9f5 -;;; mail-prsvr.el ends here diff --git a/xemacs-packages/gnus/lisp/mail-source.el b/xemacs-packages/gnus/lisp/mail-source.el deleted file mode 100644 index ff1a75a1..00000000 --- a/xemacs-packages/gnus/lisp/mail-source.el +++ /dev/null @@ -1,1082 +0,0 @@ -;;; mail-source.el --- functions for fetching mail - -;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news, mail - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile - (require 'cl) - (require 'imap) - (eval-when-compile (defvar display-time-mail-function))) -(eval-and-compile - (autoload 'pop3-movemail "pop3") - (autoload 'pop3-get-message-count "pop3") - (autoload 'nnheader-cancel-timer "nnheader") - (autoload 'nnheader-run-at-time "nnheader")) -(require 'format-spec) -(require 'mm-util) -(require 'message) ;; for `message-directory' - -(defgroup mail-source nil - "The mail-fetching library." - :version "21.1" - :group 'gnus) - -;; Define these at compile time to avoid dragging in imap always. -(defconst mail-source-imap-authenticators - (eval-when-compile - (mapcar (lambda (a) - (list 'const (car a))) - imap-authenticator-alist))) -(defconst mail-source-imap-streams - (eval-when-compile - (mapcar (lambda (a) - (list 'const (car a))) - imap-stream-alist))) - -(defcustom mail-sources nil - "*Where the mail backends will look for incoming mail. -This variable is a list of mail source specifiers. -See Info node `(gnus)Mail Source Specifiers'." - :group 'mail-source - :link '(custom-manual "(gnus)Mail Source Specifiers") - :type `(choice - (const nil) - (repeat - (choice :format "%[Value Menu%] %v" - :value (file) - (cons :tag "Spool file" - (const :format "" file) - (checklist :tag "Options" :greedy t - (group :inline t - (const :format "" :value :path) - file))) - (cons :tag "Several files in a directory" - (const :format "" directory) - (checklist :tag "Options" :greedy t - (group :inline t - (const :format "" :value :path) - (directory :tag "Path")) - (group :inline t - (const :format "" :value :suffix) - (string :tag "Suffix")) - (group :inline t - (const :format "" :value :predicate) - (function :tag "Predicate")) - (group :inline t - (const :format "" :value :prescript) - (choice :tag "Prescript" - :value nil - (string :format "%v") - (function :format "%v"))) - (group :inline t - (const :format "" :value :postscript) - (choice :tag "Postscript" - :value nil - (string :format "%v") - (function :format "%v"))) - (group :inline t - (const :format "" :value :plugged) - (boolean :tag "Plugged")))) - (cons :tag "POP3 server" - (const :format "" pop) - (checklist :tag "Options" :greedy t - (group :inline t - (const :format "" :value :server) - (string :tag "Server")) - (group :inline t - (const :format "" :value :port) - (choice :tag "Port" - :value "pop3" - (number :format "%v") - (string :format "%v"))) - (group :inline t - (const :format "" :value :user) - (string :tag "User")) - (group :inline t - (const :format "" :value :password) - (string :tag "Password")) - (group :inline t - (const :format "" :value :program) - (string :tag "Program")) - (group :inline t - (const :format "" :value :prescript) - (choice :tag "Prescript" - :value nil - (string :format "%v") - (function :format "%v"))) - (group :inline t - (const :format "" :value :postscript) - (choice :tag "Postscript" - :value nil - (string :format "%v") - (function :format "%v"))) - (group :inline t - (const :format "" :value :function) - (function :tag "Function")) - (group :inline t - (const :format "" - :value :authentication) - (choice :tag "Authentication" - :value apop - (const password) - (const apop))) - (group :inline t - (const :format "" :value :plugged) - (boolean :tag "Plugged")))) - (cons :tag "Maildir (qmail, postfix...)" - (const :format "" maildir) - (checklist :tag "Options" :greedy t - (group :inline t - (const :format "" :value :path) - (directory :tag "Path")) - (group :inline t - (const :format "" :value :plugged) - (boolean :tag "Plugged")))) - (cons :tag "IMAP server" - (const :format "" imap) - (checklist :tag "Options" :greedy t - (group :inline t - (const :format "" :value :server) - (string :tag "Server")) - (group :inline t - (const :format "" :value :port) - (choice :tag "Port" - :value 143 - number string)) - (group :inline t - (const :format "" :value :user) - (string :tag "User")) - (group :inline t - (const :format "" :value :password) - (string :tag "Password")) - (group :inline t - (const :format "" :value :stream) - (choice :tag "Stream" - :value network - ,@mail-source-imap-streams)) - (group :inline t - (const :format "" :value :program) - (string :tag "Program")) - (group :inline t - (const :format "" - :value :authenticator) - (choice :tag "Authenticator" - :value login - ,@mail-source-imap-authenticators)) - (group :inline t - (const :format "" :value :mailbox) - (string :tag "Mailbox" - :value "INBOX")) - (group :inline t - (const :format "" :value :predicate) - (string :tag "Predicate" - :value "UNSEEN UNDELETED")) - (group :inline t - (const :format "" :value :fetchflag) - (string :tag "Fetchflag" - :value "\\Deleted")) - (group :inline t - (const :format "" - :value :dontexpunge) - (boolean :tag "Dontexpunge")) - (group :inline t - (const :format "" :value :plugged) - (boolean :tag "Plugged")))) - (cons :tag "Webmail server" - (const :format "" webmail) - (checklist :tag "Options" :greedy t - (group :inline t - (const :format "" :value :subtype) - ;; Should be generated from - ;; `webmail-type-definition', but we - ;; can't require webmail without W3. - (choice :tag "Subtype" - :value hotmail - (const hotmail) - (const yahoo) - (const netaddress) - (const netscape) - (const my-deja))) - (group :inline t - (const :format "" :value :user) - (string :tag "User")) - (group :inline t - (const :format "" :value :password) - (string :tag "Password")) - (group :inline t - (const :format "" - :value :dontexpunge) - (boolean :tag "Dontexpunge")) - (group :inline t - (const :format "" :value :plugged) - (boolean :tag "Plugged")))))))) - -(defcustom mail-source-ignore-errors nil - "*Ignore errors when querying mail sources. -If nil, the user will be prompted when an error occurs. If non-nil, -the error will be ignored." - :version "22.1" - :group 'mail-source - :type 'boolean) - -(defcustom mail-source-primary-source nil - "*Primary source for incoming mail. -If non-nil, this maildrop will be checked periodically for new mail." - :group 'mail-source - :type 'sexp) - -(defcustom mail-source-flash t - "*If non-nil, flash periodically when mail is available." - :group 'mail-source - :type 'boolean) - -(defcustom mail-source-crash-box "~/.emacs-mail-crash-box" - "File where mail will be stored while processing it." - :group 'mail-source - :type 'file) - -(defcustom mail-source-directory message-directory - "Directory where incoming mail source files (if any) will be stored." - :group 'mail-source - :type 'directory) - -(defcustom mail-source-default-file-modes 384 - "Set the mode bits of all new mail files to this integer." - :group 'mail-source - :type 'integer) - -(defcustom mail-source-delete-incoming - ;; 10 ;; development versions - 2 ;; released versions - "If non-nil, delete incoming files after handling. -If t, delete immediately, if nil, never delete. If a positive number, delete -files older than number of days. - -Removing of old files happens in `mail-source-callback', i.e. no -old incoming files will be deleted unless you receive new mail. -You may also set this variable to nil and call -`mail-source-delete-old-incoming' interactively." - :group 'mail-source - :version "22.2" ;; No Gnus / Gnus 5.10.10 (default changed) - :type '(choice (const :tag "immediately" t) - (const :tag "never" nil) - (integer :tag "days"))) - -(defcustom mail-source-delete-old-incoming-confirm nil - "If non-nil, ask for confirmation before deleting old incoming files. -This variable only applies when `mail-source-delete-incoming' is a positive -number." - :version "22.2" ;; No Gnus / Gnus 5.10.10 (default changed) - :group 'mail-source - :type 'boolean) - -(defcustom mail-source-incoming-file-prefix "Incoming" - "Prefix for file name for storing incoming mail" - :group 'mail-source - :type 'string) - -(defcustom mail-source-report-new-mail-interval 5 - "Interval in minutes between checks for new mail." - :group 'mail-source - :type 'number) - -(defcustom mail-source-idle-time-delay 5 - "Number of idle seconds to wait before checking for new mail." - :group 'mail-source - :type 'number) - -(defcustom mail-source-movemail-program nil - "If non-nil, name of program for fetching new mail." - :version "22.1" - :group 'mail-source - :type '(choice (const nil) string)) - -;;; Internal variables. - -(defvar mail-source-string "" - "A dynamically bound string that says what the current mail source is.") - -(defvar mail-source-new-mail-available nil - "Flag indicating when new mail is available.") - -(eval-and-compile - (defvar mail-source-common-keyword-map - '((:plugged)) - "Mapping from keywords to default values. -Common keywords should be listed here.") - - (defvar mail-source-keyword-map - '((file - (:prescript) - (:prescript-delay) - (:postscript) - (:path (or (getenv "MAIL") - (expand-file-name (user-login-name) rmail-spool-directory)))) - (directory - (:prescript) - (:prescript-delay) - (:postscript) - (:path) - (:suffix ".spool") - (:predicate identity)) - (pop - (:prescript) - (:prescript-delay) - (:postscript) - (:server (getenv "MAILHOST")) - (:port 110) - (:user (or (user-login-name) (getenv "LOGNAME") (getenv "USER"))) - (:program) - (:function) - (:password) - (:authentication password)) - (maildir - (:path (or (getenv "MAILDIR") "~/Maildir/")) - (:subdirs ("cur" "new")) - (:function)) - (imap - (:server (getenv "MAILHOST")) - (:port) - (:stream) - (:program) - (:authentication) - (:user (or (user-login-name) (getenv "LOGNAME") (getenv "USER"))) - (:password) - (:mailbox "INBOX") - (:predicate "UNSEEN UNDELETED") - (:fetchflag "\\Deleted") - (:prescript) - (:prescript-delay) - (:postscript) - (:dontexpunge)) - (webmail - (:subtype hotmail) - (:user (or (user-login-name) (getenv "LOGNAME") (getenv "USER"))) - (:password) - (:dontexpunge) - (:authentication password))) - "Mapping from keywords to default values. -All keywords that can be used must be listed here.")) - -(defvar mail-source-fetcher-alist - '((file mail-source-fetch-file) - (directory mail-source-fetch-directory) - (pop mail-source-fetch-pop) - (maildir mail-source-fetch-maildir) - (imap mail-source-fetch-imap) - (webmail mail-source-fetch-webmail)) - "A mapping from source type to fetcher function.") - -(defvar mail-source-password-cache nil) - -(defvar mail-source-plugged t) - -;;; Functions - -(eval-and-compile - (defun mail-source-strip-keyword (keyword) - "Strip the leading colon off the KEYWORD." - (intern (substring (symbol-name keyword) 1)))) - -(eval-and-compile - (defun mail-source-bind-1 (type) - (let* ((defaults (cdr (assq type mail-source-keyword-map))) - default bind) - (while (setq default (pop defaults)) - (push (list (mail-source-strip-keyword (car default)) - nil) - bind)) - bind))) - -(defmacro mail-source-bind (type-source &rest body) - "Return a `let' form that binds all variables in source TYPE. -TYPE-SOURCE is a list where the first element is the TYPE, and -the second variable is the SOURCE. -At run time, the mail source specifier SOURCE will be inspected, -and the variables will be set according to it. Variables not -specified will be given default values. - -After this is done, BODY will be executed in the scope -of the `let' form. - -The variables bound and their default values are described by -the `mail-source-keyword-map' variable." - `(let ,(mail-source-bind-1 (car type-source)) - (mail-source-set-1 ,(cadr type-source)) - ,@body)) - -(put 'mail-source-bind 'lisp-indent-function 1) -(put 'mail-source-bind 'edebug-form-spec '(sexp body)) - -(defun mail-source-set-1 (source) - (let* ((type (pop source)) - (defaults (cdr (assq type mail-source-keyword-map))) - default value keyword) - (while (setq default (pop defaults)) - (set (mail-source-strip-keyword (setq keyword (car default))) - (if (setq value (plist-get source keyword)) - (mail-source-value value) - (mail-source-value (cadr default))))))) - -(eval-and-compile - (defun mail-source-bind-common-1 () - (let* ((defaults mail-source-common-keyword-map) - default bind) - (while (setq default (pop defaults)) - (push (list (mail-source-strip-keyword (car default)) - nil) - bind)) - bind))) - -(defun mail-source-set-common-1 (source) - (let* ((type (pop source)) - (defaults mail-source-common-keyword-map) - (defaults-1 (cdr (assq type mail-source-keyword-map))) - default value keyword) - (while (setq default (pop defaults)) - (set (mail-source-strip-keyword (setq keyword (car default))) - (if (setq value (plist-get source keyword)) - (mail-source-value value) - (if (setq value (assq keyword defaults-1)) - (mail-source-value (cadr value)) - (mail-source-value (cadr default)))))))) - -(defmacro mail-source-bind-common (source &rest body) - "Return a `let' form that binds all common variables. -See `mail-source-bind'." - `(let ,(mail-source-bind-common-1) - (mail-source-set-common-1 source) - ,@body)) - -(put 'mail-source-bind-common 'lisp-indent-function 1) -(put 'mail-source-bind-common 'edebug-form-spec '(sexp body)) - -(defun mail-source-value (value) - "Return the value of VALUE." - (cond - ;; String - ((stringp value) - value) - ;; Function - ((and (listp value) (symbolp (car value)) (fboundp (car value))) - (eval value)) - ;; Just return the value. - (t - value))) - -(defun mail-source-fetch (source callback) - "Fetch mail from SOURCE and call CALLBACK zero or more times. -CALLBACK will be called with the name of the file where (some of) -the mail from SOURCE is put. -Return the number of files that were found." - (mail-source-bind-common source - (if (or mail-source-plugged plugged) - (save-excursion - (let ((function (cadr (assq (car source) mail-source-fetcher-alist))) - (found 0)) - (unless function - (error "%S is an invalid mail source specification" source)) - ;; If there's anything in the crash box, we do it first. - (when (file-exists-p mail-source-crash-box) - (message "Processing mail from %s..." mail-source-crash-box) - (setq found (mail-source-callback - callback mail-source-crash-box))) - (+ found - (if (or debug-on-quit debug-on-error) - (funcall function source callback) - (condition-case err - (funcall function source callback) - (error - (if (and (not mail-source-ignore-errors) - (not - (yes-or-no-p - (format "Mail source %s error (%s). Continue? " - (if (memq ':password source) - (let ((s (copy-sequence source))) - (setcar (cdr (memq ':password s)) - "********") - s) - source) - (cadr err))))) - (error "Cannot get new mail")) - 0))))))))) - -(defun mail-source-delete-old-incoming (&optional age confirm) - "Remove incoming files older than AGE days. -If CONFIRM is non-nil, ask for confirmation before removing a file." - (interactive "P") - (let* ((high2days (/ 65536.0 60 60 24));; convert high bits to days - (low2days (/ 1.0 65536.0)) ;; convert low bits to days - (diff (if (natnump age) age 30));; fallback, if no valid AGE given - currday files) - (setq files (directory-files - mail-source-directory t - (concat "\\`" - (regexp-quote mail-source-incoming-file-prefix))) - currday (* (car (current-time)) high2days) - currday (+ currday (* low2days (nth 1 (current-time))))) - (while files - (let* ((ffile (car files)) - (bfile (gnus-replace-in-string - ffile "\\`.*/\\([^/]+\\)\\'" "\\1")) - (filetime (nth 5 (file-attributes ffile))) - (fileday (* (car filetime) high2days)) - (fileday (+ fileday (* low2days (nth 1 filetime))))) - (setq files (cdr files)) - (when (and (> (- currday fileday) diff) - (if confirm - (y-or-n-p - (format "\ -Delete old (> %s day(s)) incoming mail file `%s'? " diff bfile)) - (gnus-message 8 "\ -Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile) - t)) - (delete-file ffile)))))) - -(defun mail-source-callback (callback info) - "Call CALLBACK on the mail file, and then remove the mail file. -Pass INFO on to CALLBACK." - (if (or (not (file-exists-p mail-source-crash-box)) - (zerop (nth 7 (file-attributes mail-source-crash-box)))) - (progn - (when (file-exists-p mail-source-crash-box) - (delete-file mail-source-crash-box)) - 0) - (prog1 - (funcall callback mail-source-crash-box info) - (when (file-exists-p mail-source-crash-box) - ;; Delete or move the incoming mail out of the way. - (if (eq mail-source-delete-incoming t) - (delete-file mail-source-crash-box) - (let ((incoming - (mm-make-temp-file - (expand-file-name - mail-source-incoming-file-prefix - mail-source-directory)))) - (unless (file-exists-p (file-name-directory incoming)) - (make-directory (file-name-directory incoming) t)) - (rename-file mail-source-crash-box incoming t) - ;; remove old incoming files? - (when (natnump mail-source-delete-incoming) - (mail-source-delete-old-incoming - mail-source-delete-incoming - mail-source-delete-old-incoming-confirm)))))))) - -(defun mail-source-movemail (from to) - "Move FROM to TO using movemail." - (if (not (file-writable-p to)) - (error "Can't write to crash box %s. Not moving mail" to) - (let ((to (file-truename (expand-file-name to))) - errors result) - (setq to (file-truename to) - from (file-truename from)) - ;; Set TO if have not already done so, and rename or copy - ;; the file FROM to TO if and as appropriate. - (cond - ((file-exists-p to) - ;; The crash box exists already. - t) - ((not (file-exists-p from)) - ;; There is no inbox. - (setq to nil)) - ((zerop (nth 7 (file-attributes from))) - ;; Empty file. - (setq to nil)) - (t - ;; If getting from mail spool directory, use movemail to move - ;; rather than just renaming, so as to interlock with the - ;; mailer. - (unwind-protect - (save-excursion - (setq errors (generate-new-buffer " *mail source loss*")) - (let ((default-directory "/")) - (setq result - (apply - 'call-process - (append - (list - (or mail-source-movemail-program - (expand-file-name "movemail" exec-directory)) - nil errors nil from to))))) - (when (file-exists-p to) - (set-file-modes to mail-source-default-file-modes)) - (if (and (or (not (buffer-modified-p errors)) - (zerop (buffer-size errors))) - (and (numberp result) - (zerop result))) - ;; No output => movemail won. - t - (set-buffer errors) - ;; There may be a warning about older revisions. We - ;; ignore that. - (goto-char (point-min)) - (if (search-forward "older revision" nil t) - t - ;; Probably a real error. - (subst-char-in-region (point-min) (point-max) ?\n ?\ ) - (goto-char (point-max)) - (skip-chars-backward " \t") - (delete-region (point) (point-max)) - (goto-char (point-min)) - (when (looking-at "movemail: ") - (delete-region (point-min) (match-end 0))) - ;; Result may be a signal description string. - (unless (yes-or-no-p - (format "movemail: %s (%s return). Continue? " - (buffer-string) result)) - (error "%s" (buffer-string))) - (setq to nil))))))) - (when (and errors - (buffer-name errors)) - (kill-buffer errors)) - ;; Return whether we moved successfully or not. - to))) - -(defun mail-source-movemail-and-remove (from to) - "Move FROM to TO using movemail, then remove FROM if empty." - (or (not (mail-source-movemail from to)) - (not (zerop (nth 7 (file-attributes from)))) - (delete-file from))) - -(defun mail-source-fetch-with-program (program) - (eq 0 (call-process shell-file-name nil nil nil - shell-command-switch program))) - -(defun mail-source-run-script (script spec &optional delay) - (when script - (if (functionp script) - (funcall script) - (mail-source-call-script - (format-spec script spec)))) - (when delay - (sleep-for delay))) - -(defun mail-source-call-script (script) - (let ((background nil)) - (when (string-match "& *$" script) - (setq script (substring script 0 (match-beginning 0)) - background 0)) - (call-process shell-file-name nil background nil - shell-command-switch script))) - -;;; -;;; Different fetchers -;;; - -(defun mail-source-fetch-file (source callback) - "Fetcher for single-file sources." - (mail-source-bind (file source) - (mail-source-run-script - prescript (format-spec-make ?t mail-source-crash-box) - prescript-delay) - (let ((mail-source-string (format "file:%s" path))) - (if (mail-source-movemail path mail-source-crash-box) - (prog1 - (mail-source-callback callback path) - (mail-source-run-script - postscript (format-spec-make ?t mail-source-crash-box))) - 0)))) - -(defun mail-source-fetch-directory (source callback) - "Fetcher for directory sources." - (mail-source-bind (directory source) - (mail-source-run-script - prescript (format-spec-make ?t path) prescript-delay) - (let ((found 0) - (mail-source-string (format "directory:%s" path))) - (dolist (file (directory-files - path t (concat (regexp-quote suffix) "$"))) - (when (and (file-regular-p file) - (funcall predicate file) - (mail-source-movemail file mail-source-crash-box)) - (incf found (mail-source-callback callback file)))) - (mail-source-run-script postscript (format-spec-make ?t path)) - found))) - -(defun mail-source-fetch-pop (source callback) - "Fetcher for single-file sources." - (mail-source-bind (pop source) - (mail-source-run-script - prescript - (format-spec-make ?p password ?t mail-source-crash-box - ?s server ?P port ?u user) - prescript-delay) - (let ((from (format "%s:%s:%s" server user port)) - (mail-source-string (format "pop:%s@%s" user server)) - result) - (when (eq authentication 'password) - (setq password - (or password - (cdr (assoc from mail-source-password-cache)) - (read-passwd - (format "Password for %s at %s: " user server))))) - (when server - (setenv "MAILHOST" server)) - (setq result - (cond - (program - (mail-source-fetch-with-program - (format-spec - program - (format-spec-make ?p password ?t mail-source-crash-box - ?s server ?P port ?u user)))) - (function - (funcall function mail-source-crash-box)) - ;; The default is to use pop3.el. - (t - (require 'pop3) - (let ((pop3-password password) - (pop3-maildrop user) - (pop3-mailhost server) - (pop3-port port) - (pop3-authentication-scheme - (if (eq authentication 'apop) 'apop 'pass))) - (if (or debug-on-quit debug-on-error) - (save-excursion (pop3-movemail mail-source-crash-box)) - (condition-case err - (save-excursion (pop3-movemail mail-source-crash-box)) - (error - ;; We nix out the password in case the error - ;; was because of a wrong password being given. - (setq mail-source-password-cache - (delq (assoc from mail-source-password-cache) - mail-source-password-cache)) - (signal (car err) (cdr err))))))))) - (if result - (progn - (when (eq authentication 'password) - (unless (assoc from mail-source-password-cache) - (push (cons from password) mail-source-password-cache))) - (prog1 - (mail-source-callback callback server) - ;; Update display-time's mail flag, if relevant. - (if (equal source mail-source-primary-source) - (setq mail-source-new-mail-available nil)) - (mail-source-run-script - postscript - (format-spec-make ?p password ?t mail-source-crash-box - ?s server ?P port ?u user)))) - ;; We nix out the password in case the error - ;; was because of a wrong password being given. - (setq mail-source-password-cache - (delq (assoc from mail-source-password-cache) - mail-source-password-cache)) - 0)))) - -(defun mail-source-check-pop (source) - "Check whether there is new mail." - (mail-source-bind (pop source) - (let ((from (format "%s:%s:%s" server user port)) - (mail-source-string (format "pop:%s@%s" user server)) - result) - (when (eq authentication 'password) - (setq password - (or password - (cdr (assoc from mail-source-password-cache)) - (read-passwd - (format "Password for %s at %s: " user server)))) - (unless (assoc from mail-source-password-cache) - (push (cons from password) mail-source-password-cache))) - (when server - (setenv "MAILHOST" server)) - (setq result - (cond - ;; No easy way to check whether mail is waiting for these. - (program) - (function) - ;; The default is to use pop3.el. - (t - (require 'pop3) - (let ((pop3-password password) - (pop3-maildrop user) - (pop3-mailhost server) - (pop3-port port) - (pop3-authentication-scheme - (if (eq authentication 'apop) 'apop 'pass))) - (if (or debug-on-quit debug-on-error) - (save-excursion (pop3-get-message-count)) - (condition-case err - (save-excursion (pop3-get-message-count)) - (error - ;; We nix out the password in case the error - ;; was because of a wrong password being given. - (setq mail-source-password-cache - (delq (assoc from mail-source-password-cache) - mail-source-password-cache)) - (signal (car err) (cdr err))))))))) - (if result - ;; Inform display-time that we have new mail. - (setq mail-source-new-mail-available (> result 0)) - ;; We nix out the password in case the error - ;; was because of a wrong password being given. - (setq mail-source-password-cache - (delq (assoc from mail-source-password-cache) - mail-source-password-cache))) - result))) - -(defun mail-source-touch-pop () - "Open and close a POP connection shortly. -POP server should be defined in `mail-source-primary-source' (which is -preferred) or `mail-sources'. You may use it for the POP-before-SMTP -authentication. To do that, you need to set the -`message-send-mail-function' variable as `message-smtpmail-send-it' -and put the following line in your ~/.gnus.el file: - -\(add-hook 'message-send-mail-hook 'mail-source-touch-pop) - -See the Gnus manual for details." - (let ((sources (if mail-source-primary-source - (list mail-source-primary-source) - mail-sources))) - (while sources - (if (eq 'pop (car (car sources))) - (mail-source-check-pop (car sources))) - (setq sources (cdr sources))))) - -(defun mail-source-new-mail-p () - "Handler for `display-time' to indicate when new mail is available." - ;; Flash (ie. ring the visible bell) if mail is available. - (if (and mail-source-flash mail-source-new-mail-available) - (let ((visible-bell t)) - (ding))) - ;; Only report flag setting; flag is updated on a different schedule. - mail-source-new-mail-available) - - -(defvar mail-source-report-new-mail nil) -(defvar mail-source-report-new-mail-timer nil) -(defvar mail-source-report-new-mail-idle-timer nil) - -(eval-when-compile - (if (featurep 'xemacs) - (require 'timer-funcs) - (require 'timer))) - -(defun mail-source-start-idle-timer () - ;; Start our idle timer if necessary, so we delay the check until the - ;; user isn't typing. - (unless mail-source-report-new-mail-idle-timer - (setq mail-source-report-new-mail-idle-timer - (run-with-idle-timer - mail-source-idle-time-delay - nil - (lambda () - (unwind-protect - (mail-source-check-pop mail-source-primary-source) - (setq mail-source-report-new-mail-idle-timer nil))))) - ;; Since idle timers created when Emacs is already in the idle - ;; state don't get activated until Emacs _next_ becomes idle, we - ;; need to force our timer to be considered active now. We do - ;; this by being naughty and poking the timer internals directly - ;; (element 0 of the vector is nil if the timer is active). - (aset mail-source-report-new-mail-idle-timer 0 nil))) - -(defun mail-source-report-new-mail (arg) - "Toggle whether to report when new mail is available. -This only works when `display-time' is enabled." - (interactive "P") - (if (not mail-source-primary-source) - (error "Need to set `mail-source-primary-source' to check for new mail")) - (let ((on (if (null arg) - (not mail-source-report-new-mail) - (> (prefix-numeric-value arg) 0)))) - (setq mail-source-report-new-mail on) - (and mail-source-report-new-mail-timer - (nnheader-cancel-timer mail-source-report-new-mail-timer)) - (and mail-source-report-new-mail-idle-timer - (nnheader-cancel-timer mail-source-report-new-mail-idle-timer)) - (setq mail-source-report-new-mail-timer nil) - (setq mail-source-report-new-mail-idle-timer nil) - (if on - (progn - (require 'time) - ;; display-time-mail-function is an Emacs 21 feature. - (setq display-time-mail-function #'mail-source-new-mail-p) - ;; Set up the main timer. - (setq mail-source-report-new-mail-timer - (nnheader-run-at-time - (* 60 mail-source-report-new-mail-interval) - (* 60 mail-source-report-new-mail-interval) - #'mail-source-start-idle-timer)) - ;; When you get new mail, clear "Mail" from the mode line. - (add-hook 'nnmail-post-get-new-mail-hook - 'display-time-event-handler) - (message "Mail check enabled")) - (setq display-time-mail-function nil) - (remove-hook 'nnmail-post-get-new-mail-hook - 'display-time-event-handler) - (message "Mail check disabled")))) - -(defun mail-source-fetch-maildir (source callback) - "Fetcher for maildir sources." - (mail-source-bind (maildir source) - (let ((found 0) - mail-source-string) - (unless (string-match "/$" path) - (setq path (concat path "/"))) - (dolist (subdir subdirs) - (when (file-directory-p (concat path subdir)) - (setq mail-source-string (format "maildir:%s%s" path subdir)) - (dolist (file (directory-files (concat path subdir) t)) - (when (and (not (file-directory-p file)) - (not (if function - (funcall function file mail-source-crash-box) - (let ((coding-system-for-write - mm-text-coding-system) - (coding-system-for-read - mm-text-coding-system)) - (with-temp-file mail-source-crash-box - (insert-file-contents file) - (goto-char (point-min)) -;;; ;; Unix mail format -;;; (unless (looking-at "\n*From ") -;;; (insert "From maildir " -;;; (current-time-string) "\n")) -;;; (while (re-search-forward "^From " nil t) -;;; (replace-match ">From ")) -;;; (goto-char (point-max)) -;;; (insert "\n\n") - ;; MMDF mail format - (insert "\001\001\001\001\n")) - (delete-file file))))) - (incf found (mail-source-callback callback file)))))) - found))) - -(eval-and-compile - (autoload 'imap-open "imap") - (autoload 'imap-authenticate "imap") - (autoload 'imap-mailbox-select "imap") - (autoload 'imap-mailbox-unselect "imap") - (autoload 'imap-mailbox-close "imap") - (autoload 'imap-search "imap") - (autoload 'imap-fetch "imap") - (autoload 'imap-close "imap") - (autoload 'imap-error-text "imap") - (autoload 'imap-message-flags-add "imap") - (autoload 'imap-list-to-message-set "imap") - (autoload 'imap-range-to-message-set "imap") - (autoload 'nnheader-ms-strip-cr "nnheader")) - -(defvar mail-source-imap-file-coding-system 'binary - "Coding system for the crashbox made by `mail-source-fetch-imap'.") - -(defun mail-source-fetch-imap (source callback) - "Fetcher for imap sources." - (mail-source-bind (imap source) - (mail-source-run-script - prescript (format-spec-make ?p password ?t mail-source-crash-box - ?s server ?P port ?u user) - prescript-delay) - (let ((from (format "%s:%s:%s" server user port)) - (found 0) - (buf (generate-new-buffer " *imap source*")) - (mail-source-string (format "imap:%s:%s" server mailbox)) - (imap-shell-program (or (list program) imap-shell-program)) - remove) - (if (and (imap-open server port stream authentication buf) - (imap-authenticate - user (or (cdr (assoc from mail-source-password-cache)) - password) buf) - (imap-mailbox-select mailbox nil buf)) - (let ((coding-system-for-write mail-source-imap-file-coding-system) - str) - (with-temp-file mail-source-crash-box - ;; Avoid converting 8-bit chars from inserted strings to - ;; multibyte. - (mm-disable-multibyte) - ;; remember password - (with-current-buffer buf - (when (and imap-password - (not (assoc from mail-source-password-cache))) - (push (cons from imap-password) mail-source-password-cache))) - ;; if predicate is nil, use all uids - (dolist (uid (imap-search (or predicate "1:*") buf)) - (when (setq str - (if (imap-capability 'IMAP4rev1 buf) - (caddar (imap-fetch uid "BODY.PEEK[]" - 'BODYDETAIL nil buf)) - (imap-fetch uid "RFC822.PEEK" 'RFC822 nil buf))) - (push uid remove) - (insert "From imap " (current-time-string) "\n") - (save-excursion - (insert str "\n\n")) - (while (re-search-forward "^From " nil t) - (replace-match ">From ")) - (goto-char (point-max)))) - (nnheader-ms-strip-cr)) - (incf found (mail-source-callback callback server)) - (when (and remove fetchflag) - (setq remove (nreverse remove)) - (imap-message-flags-add - (imap-range-to-message-set (gnus-compress-sequence remove)) - fetchflag nil buf)) - (if dontexpunge - (imap-mailbox-unselect buf) - (imap-mailbox-close nil buf)) - (imap-close buf)) - (imap-close buf) - ;; We nix out the password in case the error - ;; was because of a wrong password being given. - (setq mail-source-password-cache - (delq (assoc from mail-source-password-cache) - mail-source-password-cache)) - (error "IMAP error: %s" (imap-error-text buf))) - (kill-buffer buf) - (mail-source-run-script - postscript - (format-spec-make ?p password ?t mail-source-crash-box - ?s server ?P port ?u user)) - found))) - -(eval-and-compile - (autoload 'webmail-fetch "webmail")) - -(defun mail-source-fetch-webmail (source callback) - "Fetch for webmail source." - (mail-source-bind (webmail source) - (let ((mail-source-string (format "webmail:%s:%s" subtype user)) - (webmail-newmail-only dontexpunge) - (webmail-move-to-trash-can (not dontexpunge))) - (when (eq authentication 'password) - (setq password - (or password - (cdr (assoc (format "webmail:%s:%s" subtype user) - mail-source-password-cache)) - (read-passwd - (format "Password for %s at %s: " user subtype)))) - (when (and password - (not (assoc (format "webmail:%s:%s" subtype user) - mail-source-password-cache))) - (push (cons (format "webmail:%s:%s" subtype user) password) - mail-source-password-cache))) - (webmail-fetch mail-source-crash-box subtype user password) - (mail-source-callback callback (symbol-name subtype))))) - -(provide 'mail-source) - -;;; arch-tag: 72948025-1d17-4d6c-bb12-ef1aa2c490fd -;;; mail-source.el ends here diff --git a/xemacs-packages/gnus/lisp/mailcap.el b/xemacs-packages/gnus/lisp/mailcap.el deleted file mode 100644 index 42d6ad5f..00000000 --- a/xemacs-packages/gnus/lisp/mailcap.el +++ /dev/null @@ -1,995 +0,0 @@ -;;; mailcap.el --- MIME media types configuration - -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: William M. Perry -;; Lars Magne Ingebrigtsen -;; Keywords: news, mail, multimedia - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; Provides configuration of MIME media types from directly from Lisp -;; and via the usual mailcap mechanism (RFC 1524). Deals with -;; mime.types similarly. - -;;; Code: - -(eval-when-compile (require 'cl)) -(require 'mail-parse) -(require 'mm-util) - -(defgroup mailcap nil - "Definition of viewers for MIME types." - :version "21.1" - :group 'mime) - -(defvar mailcap-parse-args-syntax-table - (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table))) - (modify-syntax-entry ?' "\"" table) - (modify-syntax-entry ?` "\"" table) - (modify-syntax-entry ?{ "(" table) - (modify-syntax-entry ?} ")" table) - table) - "A syntax table for parsing SGML attributes.") - -(eval-and-compile - (when (featurep 'xemacs) - (condition-case nil - (require 'lpr) - (error nil)))) - -(defvar mailcap-print-command - (mapconcat 'identity - (cons (if (boundp 'lpr-command) - lpr-command - "lpr") - (when (boundp 'lpr-switches) - (if (stringp lpr-switches) - (list lpr-switches) - lpr-switches))) - " ") - "Shell command (including switches) used to print Postscript files.") - -;; Postpone using defcustom for this as it's so big and we essentially -;; have to have two copies of the data around then. Perhaps just -;; customize the Lisp viewers and rely on the normal configuration -;; files for the rest? -- fx -(defvar mailcap-mime-data - `(("application" - ("vnd.ms-excel" - (viewer . "gnumeric %s") - (test . (getenv "DISPLAY")) - (type . "application/vnd.ms-excel")) - ("x-x509-ca-cert" - (viewer . ssl-view-site-cert) - (test . (fboundp 'ssl-view-site-cert)) - (type . "application/x-x509-ca-cert")) - ("x-x509-user-cert" - (viewer . ssl-view-user-cert) - (test . (fboundp 'ssl-view-user-cert)) - (type . "application/x-x509-user-cert")) - ("octet-stream" - (viewer . mailcap-save-binary-file) - (non-viewer . t) - (type . "application/octet-stream")) - ("dvi" - (viewer . "xdvi -safer %s") - (test . (eq window-system 'x)) - ("needsx11") - (type . "application/dvi") - ("print" . "dvips -qRP %s")) - ("dvi" - (viewer . "dvitty %s") - (test . (not (getenv "DISPLAY"))) - (type . "application/dvi") - ("print" . "dvips -qRP %s")) - ("emacs-lisp" - (viewer . mailcap-maybe-eval) - (type . "application/emacs-lisp")) - ("x-emacs-lisp" - (viewer . mailcap-maybe-eval) - (type . "application/x-emacs-lisp")) - ("x-tar" - (viewer . mailcap-save-binary-file) - (non-viewer . t) - (type . "application/x-tar")) - ("x-latex" - (viewer . tex-mode) - (test . (fboundp 'tex-mode)) - (type . "application/x-latex")) - ("x-tex" - (viewer . tex-mode) - (test . (fboundp 'tex-mode)) - (type . "application/x-tex")) - ("latex" - (viewer . tex-mode) - (test . (fboundp 'tex-mode)) - (type . "application/latex")) - ("tex" - (viewer . tex-mode) - (test . (fboundp 'tex-mode)) - (type . "application/tex")) - ("texinfo" - (viewer . texinfo-mode) - (test . (fboundp 'texinfo-mode)) - (type . "application/tex")) - ("zip" - (viewer . mailcap-save-binary-file) - (non-viewer . t) - (type . "application/zip") - ("copiousoutput")) - ("pdf" - (viewer . "gv -safer %s") - (type . "application/pdf") - (test . window-system) - ("print" . ,(concat "pdf2ps %s - | " mailcap-print-command))) - ("pdf" - (viewer . "gpdf %s") - (type . "application/pdf") - ("print" . ,(concat "pdftops %s - | " mailcap-print-command)) - (test . (eq window-system 'x))) - ("pdf" - (viewer . "xpdf %s") - (type . "application/pdf") - ("print" . ,(concat "pdftops %s - | " mailcap-print-command)) - (test . (eq window-system 'x))) - ("pdf" - (viewer . ,(concat "pdftotext %s -")) - (type . "application/pdf") - ("print" . ,(concat "pdftops %s - | " mailcap-print-command)) - ("copiousoutput")) - ("postscript" - (viewer . "gv -safer %s") - (type . "application/postscript") - (test . window-system) - ("print" . ,(concat mailcap-print-command " %s")) - ("needsx11")) - ("postscript" - (viewer . "ghostview -dSAFER %s") - (type . "application/postscript") - (test . (eq window-system 'x)) - ("print" . ,(concat mailcap-print-command " %s")) - ("needsx11")) - ("postscript" - (viewer . "ps2ascii %s") - (type . "application/postscript") - (test . (not (getenv "DISPLAY"))) - ("print" . ,(concat mailcap-print-command " %s")) - ("copiousoutput")) - ("sieve" - (viewer . sieve-mode) - (test . (fboundp 'sieve-mode)) - (type . "application/sieve")) - ("pgp-keys" - (viewer . "gpg --import --interactive --verbose") - (type . "application/pgp-keys") - ("needsterminal"))) - ("audio" - ("x-mpeg" - (viewer . "maplay %s") - (type . "audio/x-mpeg")) - (".*" - (viewer . "showaudio") - (type . "audio/*"))) - ("message" - ("rfc-*822" - (viewer . mm-view-message) - (test . (and (featurep 'gnus) - (gnus-alive-p))) - (type . "message/rfc822")) - ("rfc-*822" - (viewer . vm-mode) - (test . (fboundp 'vm-mode)) - (type . "message/rfc822")) - ("rfc-*822" - (viewer . w3-mode) - (test . (fboundp 'w3-mode)) - (type . "message/rfc822")) - ("rfc-*822" - (viewer . view-mode) - (type . "message/rfc822"))) - ("image" - ("x-xwd" - (viewer . "xwud -in %s") - (type . "image/x-xwd") - ("compose" . "xwd -frame > %s") - (test . (eq window-system 'x)) - ("needsx11")) - ("x11-dump" - (viewer . "xwud -in %s") - (type . "image/x-xwd") - ("compose" . "xwd -frame > %s") - (test . (eq window-system 'x)) - ("needsx11")) - ("windowdump" - (viewer . "xwud -in %s") - (type . "image/x-xwd") - ("compose" . "xwd -frame > %s") - (test . (eq window-system 'x)) - ("needsx11")) - (".*" - (viewer . "display %s") - (type . "image/*") - (test . (eq window-system 'x)) - ("needsx11")) - (".*" - (viewer . "ee %s") - (type . "image/*") - (test . (eq window-system 'x)) - ("needsx11"))) - ("text" - ("plain" - (viewer . w3-mode) - (test . (fboundp 'w3-mode)) - (type . "text/plain")) - ("plain" - (viewer . view-mode) - (test . (fboundp 'view-mode)) - (type . "text/plain")) - ("plain" - (viewer . fundamental-mode) - (type . "text/plain")) - ("enriched" - (viewer . enriched-decode) - (test . (fboundp 'enriched-decode)) - (type . "text/enriched")) - ("html" - (viewer . mm-w3-prepare-buffer) - (test . (fboundp 'w3-prepare-buffer)) - (type . "text/html"))) - ("video" - ("mpeg" - (viewer . "mpeg_play %s") - (type . "video/mpeg") - (test . (eq window-system 'x)) - ("needsx11"))) - ("x-world" - ("x-vrml" - (viewer . "webspace -remote %s -URL %u") - (type . "x-world/x-vrml") - ("description" - "VRML document"))) - ("archive" - ("tar" - (viewer . tar-mode) - (type . "archive/tar") - (test . (fboundp 'tar-mode))))) - "The mailcap structure is an assoc list of assoc lists. -1st assoc list is keyed on the major content-type -2nd assoc list is keyed on the minor content-type (which can be a regexp) - -Which looks like: ------------------ - ((\"application\" - (\"postscript\" . )) - (\"text\" - (\"plain\" . ))) - -Where is another assoc list of the various information -related to the mailcap RFC 1524. This is keyed on the lowercase -attribute name (viewer, test, etc). This looks like: - ((viewer . VIEWERINFO) - (test . TESTINFO) - (xxxx . \"STRING\") - FLAG) - -Where VIEWERINFO specifies how the content-type is viewed. Can be -a string, in which case it is run through a shell, with -appropriate parameters, or a symbol, in which case the symbol is -`funcall'ed, with the buffer as an argument. - -TESTINFO is a test for the viewer's applicability, or nil. If nil, it -means the viewer is always valid. If it is a Lisp function, it is -called with a list of items from any extra fields from the -Content-Type header as argument to return a boolean value for the -validity. Otherwise, if it is a non-function Lisp symbol or list -whose car is a symbol, it is `eval'led to yield the validity. If it -is a string or list of strings, it represents a shell command to run -to return a true or false shell value for the validity.") -(put 'mailcap-mime-data 'risky-local-variable t) - -(defcustom mailcap-download-directory nil - "*Directory to which `mailcap-save-binary-file' downloads files by default. -nil means your home directory." - :type '(choice (const :tag "Home directory" nil) - directory) - :group 'mailcap) - -(defvar mailcap-poor-system-types - '(ms-dos ms-windows windows-nt win32 w32 mswindows) - "Systems that don't have a Unix-like directory hierarchy.") - -;;; -;;; Utility functions -;;; - -(defun mailcap-save-binary-file () - (goto-char (point-min)) - (unwind-protect - (let ((file (read-file-name - "Filename to save as: " - (or mailcap-download-directory "~/"))) - (require-final-newline nil)) - (write-region (point-min) (point-max) file)) - (kill-buffer (current-buffer)))) - -(defvar mailcap-maybe-eval-warning - "*** WARNING *** - -This MIME part contains untrusted and possibly harmful content. -If you evaluate the Emacs Lisp code contained in it, a lot of nasty -things can happen. Please examine the code very carefully before you -instruct Emacs to evaluate it. You can browse the buffer containing -the code using \\[scroll-other-window]. - -If you are unsure what to do, please answer \"no\"." - "Text of warning message displayed by `mailcap-maybe-eval'. -Make sure that this text consists only of few text lines. Otherwise, -Gnus might fail to display all of it.") - -(defun mailcap-maybe-eval () - "Maybe evaluate a buffer of Emacs Lisp code." - (let ((lisp-buffer (current-buffer))) - (goto-char (point-min)) - (when - (save-window-excursion - (delete-other-windows) - (let ((buffer (get-buffer-create (generate-new-buffer-name - "*Warning*")))) - (unwind-protect - (with-current-buffer buffer - (insert (substitute-command-keys - mailcap-maybe-eval-warning)) - (goto-char (point-min)) - (display-buffer buffer) - (yes-or-no-p "This is potentially dangerous emacs-lisp code, evaluate it? ")) - (kill-buffer buffer)))) - (eval-buffer (current-buffer))) - (when (buffer-live-p lisp-buffer) - (with-current-buffer lisp-buffer - (emacs-lisp-mode))))) - - -;;; -;;; The mailcap parser -;;; - -(defun mailcap-replace-regexp (regexp to-string) - ;; Quiet replace-regexp. - (goto-char (point-min)) - (while (re-search-forward regexp nil t) - (replace-match to-string t nil))) - -(defvar mailcap-parsed-p nil) - -(defun mailcap-parse-mailcaps (&optional path force) - "Parse out all the mailcaps specified in a path string PATH. -Components of PATH are separated by the `path-separator' character -appropriate for this system. If FORCE, re-parse even if already -parsed. If PATH is omitted, use the value of environment variable -MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus -/usr/local/etc/mailcap." - (interactive (list nil t)) - (when (or (not mailcap-parsed-p) - force) - (cond - (path nil) - ((getenv "MAILCAPS") (setq path (getenv "MAILCAPS"))) - ((memq system-type mailcap-poor-system-types) - (setq path '("~/.mailcap" "~/mail.cap" "~/etc/mail.cap"))) - (t (setq path - ;; This is per RFC 1524, specifically - ;; with /usr before /usr/local. - '("~/.mailcap" "/etc/mailcap" "/usr/etc/mailcap" - "/usr/local/etc/mailcap")))) - (let ((fnames (reverse - (if (stringp path) - (delete "" (split-string path path-separator)) - path))) - fname) - (while fnames - (setq fname (car fnames)) - (if (and (file-readable-p fname) - (file-regular-p fname)) - (mailcap-parse-mailcap fname)) - (setq fnames (cdr fnames)))) - (setq mailcap-parsed-p t))) - -(defun mailcap-parse-mailcap (fname) - "Parse out the mailcap file specified by FNAME." - (let (major ; The major mime type (image/audio/etc) - minor ; The minor mime type (gif, basic, etc) - save-pos ; Misc saved positions used in parsing - viewer ; How to view this mime type - info ; Misc info about this mime type - ) - (with-temp-buffer - (insert-file-contents fname) - (set-syntax-table mailcap-parse-args-syntax-table) - (mailcap-replace-regexp "#.*" "") ; Remove all comments - (mailcap-replace-regexp "\\\\[ \t]*\n" " ") ; And collapse spaces - (mailcap-replace-regexp "\n+" "\n") ; And blank lines - (goto-char (point-max)) - (skip-chars-backward " \t\n") - (delete-region (point) (point-max)) - (while (not (bobp)) - (skip-chars-backward " \t\n") - (beginning-of-line) - (setq save-pos (point) - info nil) - (skip-chars-forward "^/; \t\n") - (downcase-region save-pos (point)) - (setq major (buffer-substring save-pos (point))) - (skip-chars-forward " \t") - (setq minor "") - (when (eq (char-after) ?/) - (forward-char) - (skip-chars-forward " \t") - (setq save-pos (point)) - (skip-chars-forward "^; \t\n") - (downcase-region save-pos (point)) - (setq minor - (cond - ((eq ?* (or (char-after save-pos) 0)) ".*") - ((= (point) save-pos) ".*") - (t (regexp-quote (buffer-substring save-pos (point))))))) - (skip-chars-forward " \t") - ;;; Got the major/minor chunks, now for the viewers/etc - ;;; The first item _must_ be a viewer, according to the - ;;; RFC for mailcap files (#1524) - (setq viewer "") - (when (eq (char-after) ?\;) - (forward-char) - (skip-chars-forward " \t") - (setq save-pos (point)) - (skip-chars-forward "^;\n") - ;; skip \; - (while (eq (char-before) ?\\) - (backward-delete-char 1) - (forward-char) - (skip-chars-forward "^;\n")) - (if (eq (or (char-after save-pos) 0) ?') - (setq viewer (progn - (narrow-to-region (1+ save-pos) (point)) - (goto-char (point-min)) - (prog1 - (read (current-buffer)) - (goto-char (point-max)) - (widen)))) - (setq viewer (buffer-substring save-pos (point))))) - (setq save-pos (point)) - (end-of-line) - (unless (equal viewer "") - (setq info (nconc (list (cons 'viewer viewer) - (cons 'type (concat major "/" - (if (string= minor ".*") - "*" minor)))) - (mailcap-parse-mailcap-extras save-pos (point)))) - (mailcap-mailcap-entry-passes-test info) - (mailcap-add-mailcap-entry major minor info)) - (beginning-of-line))))) - -(defun mailcap-parse-mailcap-extras (st nd) - "Grab all the extra stuff from a mailcap entry." - (let ( - name ; From name= - value ; its value - results ; Assoc list of results - name-pos ; Start of XXXX= position - val-pos ; Start of value position - done ; Found end of \'d ;s? - ) - (save-restriction - (narrow-to-region st nd) - (goto-char (point-min)) - (skip-chars-forward " \n\t;") - (while (not (eobp)) - (setq done nil) - (setq name-pos (point)) - (skip-chars-forward "^ \n\t=;") - (downcase-region name-pos (point)) - (setq name (buffer-substring name-pos (point))) - (skip-chars-forward " \t\n") - (if (not (eq (char-after (point)) ?=)) ; There is no value - (setq value t) - (skip-chars-forward " \t\n=") - (setq val-pos (point)) - (if (memq (char-after val-pos) '(?\" ?')) - (progn - (setq val-pos (1+ val-pos)) - (condition-case nil - (progn - (forward-sexp 1) - (backward-char 1)) - (error (goto-char (point-max))))) - (while (not done) - (skip-chars-forward "^;") - (if (eq (char-after (1- (point))) ?\\ ) - (progn - (subst-char-in-region (1- (point)) (point) ?\\ ? ) - (skip-chars-forward ";")) - (setq done t)))) - (setq value (buffer-substring val-pos (point)))) - ;; `test' as symbol, others like "copiousoutput" and "needsx11" as - ;; strings - (setq results (cons (cons (if (string-equal name "test") - 'test - name) - value) results)) - (skip-chars-forward " \";\n\t")) - results))) - -(defun mailcap-mailcap-entry-passes-test (info) - "Return non-nil if mailcap entry INFO passes its test clause. -Also return non-nil if no test clause is present." - (let ((test (assq 'test info)) ; The test clause - status) - (setq status (and test (split-string (cdr test) " "))) - (if (and (or (assoc "needsterm" info) - (assoc "needsterminal" info) - (assoc "needsx11" info)) - (not (getenv "DISPLAY"))) - (setq status nil) - (cond - ((and (equal (nth 0 status) "test") - (equal (nth 1 status) "-n") - (or (equal (nth 2 status) "$DISPLAY") - (equal (nth 2 status) "\"$DISPLAY\""))) - (setq status (if (getenv "DISPLAY") t nil))) - ((and (equal (nth 0 status) "test") - (equal (nth 1 status) "-z") - (or (equal (nth 2 status) "$DISPLAY") - (equal (nth 2 status) "\"$DISPLAY\""))) - (setq status (if (getenv "DISPLAY") nil t))) - (test nil) - (t nil))) - (and test (listp test) (setcdr test status)))) - -;;; -;;; The action routines. -;;; - -(defun mailcap-possible-viewers (major minor) - "Return a list of possible viewers from MAJOR for minor type MINOR." - (let ((exact '()) - (wildcard '())) - (while major - (cond - ((equal (car (car major)) minor) - (setq exact (cons (cdr (car major)) exact))) - ((and minor (string-match (concat "^" (car (car major)) "$") minor)) - (setq wildcard (cons (cdr (car major)) wildcard)))) - (setq major (cdr major))) - (nconc exact wildcard))) - -(defun mailcap-unescape-mime-test (test type-info) - (let (save-pos save-chr subst) - (cond - ((symbolp test) test) - ((and (listp test) (symbolp (car test))) test) - ((or (stringp test) - (and (listp test) (stringp (car test)) - (setq test (mapconcat 'identity test " ")))) - (with-temp-buffer - (insert test) - (goto-char (point-min)) - (while (not (eobp)) - (skip-chars-forward "^%") - (if (/= (- (point) - (progn (skip-chars-backward "\\\\") - (point))) - 0) ; It is an escaped % - (progn - (delete-char 1) - (skip-chars-forward "%.")) - (setq save-pos (point)) - (skip-chars-forward "%") - (setq save-chr (char-after (point))) - ;; Escapes: - ;; %s: name of a file for the body data - ;; %t: content-type - ;; %{ -;; Keywords: mail, news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; This mode provides mail-sending facilities from within Emacs. It -;; consists mainly of large chunks of code from the sendmail.el, -;; gnus-msg.el and rnewspost.el files. - -;;; Code: - -(eval-when-compile - (require 'cl) - (defvar gnus-message-group-art) - (defvar gnus-list-identifiers)) ; gnus-sum is required where necessary -(require 'canlock) -(require 'mailheader) -(require 'gmm-utils) -(require 'nnheader) -;; This is apparently necessary even though things are autoloaded. -;; Because we dynamically bind mail-abbrev-mode-regexp, we'd better -;; require mailabbrev here. -(if (featurep 'xemacs) - (require 'mail-abbrevs) - (require 'mailabbrev)) -(require 'mail-parse) -(require 'mml) -(require 'rfc822) -(eval-and-compile - (autoload 'gnus-find-method-for-group "gnus") - (autoload 'nnvirtual-find-group-art "nnvirtual") - (autoload 'gnus-group-decoded-name "gnus-group")) - -(defgroup message '((user-mail-address custom-variable) - (user-full-name custom-variable)) - "Mail and news message composing." - :link '(custom-manual "(message)Top") - :group 'mail - :group 'news) - -(put 'user-mail-address 'custom-type 'string) -(put 'user-full-name 'custom-type 'string) - -(defgroup message-various nil - "Various Message Variables." - :link '(custom-manual "(message)Various Message Variables") - :group 'message) - -(defgroup message-buffers nil - "Message Buffers." - :link '(custom-manual "(message)Message Buffers") - :group 'message) - -(defgroup message-sending nil - "Message Sending." - :link '(custom-manual "(message)Sending Variables") - :group 'message) - -(defgroup message-interface nil - "Message Interface." - :link '(custom-manual "(message)Interface") - :group 'message) - -(defgroup message-forwarding nil - "Message Forwarding." - :link '(custom-manual "(message)Forwarding") - :group 'message-interface) - -(defgroup message-insertion nil - "Message Insertion." - :link '(custom-manual "(message)Insertion") - :group 'message) - -(defgroup message-headers nil - "Message Headers." - :link '(custom-manual "(message)Message Headers") - :group 'message) - -(defgroup message-news nil - "Composing News Messages." - :group 'message) - -(defgroup message-mail nil - "Composing Mail Messages." - :group 'message) - -(defgroup message-faces nil - "Faces used for message composing." - :group 'message - :group 'faces) - -(defcustom message-directory "~/Mail/" - "*Directory from which all other mail file variables are derived." - :group 'message-various - :type 'directory) - -(defcustom message-max-buffers 10 - "*How many buffers to keep before starting to kill them off." - :group 'message-buffers - :type 'integer) - -(defcustom message-send-rename-function nil - "Function called to rename the buffer after sending it." - :group 'message-buffers - :type '(choice function (const nil))) - -(defcustom message-fcc-handler-function 'message-output - "*A function called to save outgoing articles. -This function will be called with the name of the file to store the -article in. The default function is `message-output' which saves in Unix -mailbox format." - :type '(radio (function-item message-output) - (function :tag "Other")) - :group 'message-sending) - -(defcustom message-fcc-externalize-attachments nil - "If non-nil, attachments are included as external parts in Fcc copies." - :version "22.1" - :type 'boolean - :group 'message-sending) - -(defcustom message-courtesy-message - "The following message is a courtesy copy of an article\nthat has been posted to %s as well.\n\n" - "*This is inserted at the start of a mailed copy of a posted message. -If the string contains the format spec \"%s\", the Newsgroups -the article has been posted to will be inserted there. -If this variable is nil, no such courtesy message will be added." - :group 'message-sending - :type '(radio string (const nil))) - -(defcustom message-ignored-bounced-headers - "^\\(Received\\|Return-Path\\|Delivered-To\\):" - "*Regexp that matches headers to be removed in resent bounced mail." - :group 'message-interface - :type 'regexp) - -;;;###autoload -(defcustom message-from-style 'default - "*Specifies how \"From\" headers look. - -If nil, they contain just the return address like: - king@grassland.com -If `parens', they look like: - king@grassland.com (Elvis Parsley) -If `angles', they look like: - Elvis Parsley - -Otherwise, most addresses look like `angles', but they look like -`parens' if `angles' would need quoting and `parens' would not." - :type '(choice (const :tag "simple" nil) - (const parens) - (const angles) - (const default)) - :group 'message-headers) - -(defcustom message-insert-canlock t - "Whether to insert a Cancel-Lock header in news postings." - :version "22.1" - :group 'message-headers - :type 'boolean) - -(defcustom message-syntax-checks - (if message-insert-canlock '((sender . disabled)) nil) - ;; Guess this one shouldn't be easy to customize... - "*Controls what syntax checks should not be performed on outgoing posts. -To disable checking of long signatures, for instance, add - `(signature . disabled)' to this list. - -Don't touch this variable unless you really know what you're doing. - -Checks include `approved', `continuation-headers', `control-chars', -`empty', `existing-newsgroups', `from', `illegible-text', -`invisible-text', `long-header-lines', `long-lines', `message-id', -`multiple-headers', `new-text', `newsgroups', `quoting-style', -`repeated-newsgroups', `reply-to', `sender', `sendsys', `shoot', -`shorten-followup-to', `signature', `size', `subject', `subject-cmsg' -and `valid-newsgroups'." - :group 'message-news - :type '(repeat sexp)) ; Fixme: improve this - -(defcustom message-required-headers '((optional . References) - From) - "*Headers to be generated or prompted for when sending a message. -Also see `message-required-news-headers' and -`message-required-mail-headers'." - :version "22.1" - :group 'message-news - :group 'message-headers - :link '(custom-manual "(message)Message Headers") - :type '(repeat sexp)) - -(defcustom message-draft-headers '(References From) - "*Headers to be generated when saving a draft message." - :version "22.1" - :group 'message-news - :group 'message-headers - :link '(custom-manual "(message)Message Headers") - :type '(repeat sexp)) - -(defcustom message-required-news-headers - '(From Newsgroups Subject Date Message-ID - (optional . Organization) - (optional . User-Agent)) - "*Headers to be generated or prompted for when posting an article. -RFC977 and RFC1036 require From, Date, Newsgroups, Subject, -Message-ID. Organization, Lines, In-Reply-To, Expires, and -User-Agent are optional. If you don't want message to insert some -header, remove it from this list." - :group 'message-news - :group 'message-headers - :link '(custom-manual "(message)Message Headers") - :type '(repeat sexp)) - -(defcustom message-required-mail-headers - '(From Subject Date (optional . In-Reply-To) Message-ID - (optional . User-Agent)) - "*Headers to be generated or prompted for when mailing a message. -It is recommended that From, Date, To, Subject and Message-ID be -included. Organization and User-Agent are optional." - :group 'message-mail - :group 'message-headers - :link '(custom-manual "(message)Message Headers") - :type '(repeat sexp)) - -(defcustom message-deletable-headers '(Message-ID Date Lines) - "Headers to be deleted if they already exist and were generated by message previously." - :group 'message-headers - :link '(custom-manual "(message)Message Headers") - :type 'sexp) - -(defcustom message-ignored-news-headers - "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:" - "*Regexp of headers to be removed unconditionally before posting." - :group 'message-news - :group 'message-headers - :link '(custom-manual "(message)Message Headers") - :type '(repeat :value-to-internal (lambda (widget value) - (custom-split-regexp-maybe value)) - :match (lambda (widget value) - (or (stringp value) - (widget-editable-list-match widget value))) - regexp)) - -(defcustom message-ignored-mail-headers - "^[GF]cc:\\|^Resent-Fcc:\\|^Xref:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:" - "*Regexp of headers to be removed unconditionally before mailing." - :group 'message-mail - :group 'message-headers - :link '(custom-manual "(message)Mail Headers") - :type 'regexp) - -(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-ID:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:\\|^X-Hashcash:\\|^X-Payment:" - "*Header lines matching this regexp will be deleted before posting. -It's best to delete old Path and Date headers before posting to avoid -any confusion." - :group 'message-interface - :link '(custom-manual "(message)Superseding") - :type '(repeat :value-to-internal (lambda (widget value) - (custom-split-regexp-maybe value)) - :match (lambda (widget value) - (or (stringp value) - (widget-editable-list-match widget value))) - regexp)) - -(defcustom message-subject-re-regexp - "^[ \t]*\\([Rr][Ee]\\(\\[[0-9]*\\]\\)*:[ \t]*\\)*[ \t]*" - "*Regexp matching \"Re: \" in the subject line." - :group 'message-various - :link '(custom-manual "(message)Message Headers") - :type 'regexp) - -;;; Start of variables adopted from `message-utils.el'. - -(defcustom message-subject-trailing-was-query 'ask - "*What to do with trailing \"(was: )\" in subject lines. -If nil, leave the subject unchanged. If it is the symbol `ask', query -the user what do do. In this case, the subject is matched against -`message-subject-trailing-was-ask-regexp'. If -`message-subject-trailing-was-query' is t, always strip the trailing -old subject. In this case, `message-subject-trailing-was-regexp' is -used." - :version "22.1" - :type '(choice (const :tag "never" nil) - (const :tag "always strip" t) - (const ask)) - :link '(custom-manual "(message)Message Headers") - :group 'message-various) - -(defcustom message-subject-trailing-was-ask-regexp - "[ \t]*\\([[(]+[Ww][Aa][Ss][ \t]*.*[\])]+\\)" - "*Regexp matching \"(was: )\" in the subject line. - -The function `message-strip-subject-trailing-was' uses this regexp if -`message-subject-trailing-was-query' is set to the symbol `ask'. If -the variable is t instead of `ask', use -`message-subject-trailing-was-regexp' instead. - -It is okay to create some false positives here, as the user is asked." - :version "22.1" - :group 'message-various - :link '(custom-manual "(message)Message Headers") - :type 'regexp) - -(defcustom message-subject-trailing-was-regexp - "[ \t]*\\((*[Ww][Aa][Ss]:[ \t]*.*)\\)" - "*Regexp matching \"(was: )\" in the subject line. - -If `message-subject-trailing-was-query' is set to t, the subject is -matched against `message-subject-trailing-was-regexp' in -`message-strip-subject-trailing-was'. You should use a regexp creating very -few false positives here." - :version "22.1" - :group 'message-various - :link '(custom-manual "(message)Message Headers") - :type 'regexp) - -;;; marking inserted text - -(defcustom message-mark-insert-begin - "--8<---------------cut here---------------start------------->8---\n" - "How to mark the beginning of some inserted text." - :version "22.1" - :type 'string - :link '(custom-manual "(message)Insertion Variables") - :group 'message-various) - -(defcustom message-mark-insert-end - "--8<---------------cut here---------------end--------------->8---\n" - "How to mark the end of some inserted text." - :version "22.1" - :type 'string - :link '(custom-manual "(message)Insertion Variables") - :group 'message-various) - -(defcustom message-archive-header "X-No-Archive: Yes\n" - "Header to insert when you don't want your article to be archived. -Archives \(such as groups.google.com\) respect this header." - :version "22.1" - :type 'string - :link '(custom-manual "(message)Header Commands") - :group 'message-various) - -(defcustom message-archive-note - "X-No-Archive: Yes - save http://groups.google.com/" - "Note to insert why you wouldn't want this posting archived. -If nil, don't insert any text in the body." - :version "22.1" - :type '(radio string (const nil)) - :link '(custom-manual "(message)Header Commands") - :group 'message-various) - -;;; Crossposts and Followups -;; inspired by JoH-followup-to by Jochem Huhman -;; new suggestions by R. Weikusat - -(defvar message-cross-post-old-target nil - "Old target for cross-posts or follow-ups.") -(make-variable-buffer-local 'message-cross-post-old-target) - -(defcustom message-cross-post-default t - "When non-nil `message-cross-post-followup-to' will perform a crosspost. -If nil, `message-cross-post-followup-to' will only do a followup. Note that -you can explicitly override this setting by calling -`message-cross-post-followup-to' with a prefix." - :version "22.1" - :type 'boolean - :group 'message-various) - -(defcustom message-cross-post-note "Crosspost & Followup-To: " - "Note to insert before signature to notify of cross-post and follow-up." - :version "22.1" - :type 'string - :group 'message-various) - -(defcustom message-followup-to-note "Followup-To: " - "Note to insert before signature to notify of follow-up only." - :version "22.1" - :type 'string - :group 'message-various) - -(defcustom message-cross-post-note-function 'message-cross-post-insert-note - "Function to use to insert note about Crosspost or Followup-To. -The function will be called with four arguments. The function should not only -insert a note, but also ensure old notes are deleted. See the documentation -for `message-cross-post-insert-note'." - :version "22.1" - :type 'function - :group 'message-various) - -;;; End of variables adopted from `message-utils.el'. - -;;;###autoload -(defcustom message-signature-separator "^-- *$" - "Regexp matching the signature separator." - :type 'regexp - :link '(custom-manual "(message)Various Message Variables") - :group 'message-various) - -(defcustom message-elide-ellipsis "\n[...]\n\n" - "*The string which is inserted for elided text." - :type 'string - :link '(custom-manual "(message)Various Commands") - :group 'message-various) - -(defcustom message-interactive t - "Non-nil means when sending a message wait for and display errors. -nil means let mailer mail back a message to report errors." - :group 'message-sending - :group 'message-mail - :link '(custom-manual "(message)Sending Variables") - :type 'boolean) - -(defcustom message-generate-new-buffers 'unique - "*Say whether to create a new message buffer to compose a message. -Valid values include: - -nil - Generate the buffer name in the Message way (e.g., *mail*, *news*, - *mail to whom*, *news on group*, etc.) and continue editing in the - existing buffer of that name. If there is no such buffer, it will - be newly created. - -`unique' or t - Create the new buffer with the name generated in the Message way. - -`unsent' - Similar to `unique' but the buffer name begins with \"*unsent \". - -`standard' - Similar to nil but the buffer name is simpler like *mail message*. - -function - If this is a function, call that function with three parameters: - The type, the To address and the group name (any of these may be nil). - The function should return the new buffer name." - :group 'message-buffers - :link '(custom-manual "(message)Message Buffers") - :type '(choice (const nil) - (sexp :tag "unique" :format "unique\n" :value unique - :match (lambda (widget value) (memq value '(unique t)))) - (const unsent) - (const standard) - (function :format "\n %{%t%}: %v"))) - -(defcustom message-kill-buffer-on-exit nil - "*Non-nil means that the message buffer will be killed after sending a message." - :group 'message-buffers - :link '(custom-manual "(message)Message Buffers") - :type 'boolean) - -(eval-when-compile - (defvar gnus-local-organization)) -(defcustom message-user-organization - (or (and (boundp 'gnus-local-organization) - (stringp gnus-local-organization) - gnus-local-organization) - (getenv "ORGANIZATION") - t) - "*String to be used as an Organization header. -If t, use `message-user-organization-file'." - :group 'message-headers - :type '(choice string - (const :tag "consult file" t))) - -;;;###autoload -(defcustom message-user-organization-file "/usr/lib/news/organization" - "*Local news organization file." - :type 'file - :link '(custom-manual "(message)News Headers") - :group 'message-headers) - -(defcustom message-make-forward-subject-function - #'message-forward-subject-name-subject - "*List of functions called to generate subject headers for forwarded messages. -The subject generated by the previous function is passed into each -successive function. - -The provided functions are: - -* `message-forward-subject-author-subject' Source of article (author or - newsgroup), in brackets followed by the subject -* `message-forward-subject-name-subject' Source of article (name of author - or newsgroup), in brackets followed by the subject -* `message-forward-subject-fwd' Subject of article with 'Fwd:' prepended - to it." - :group 'message-forwarding - :link '(custom-manual "(message)Forwarding") - :type '(radio (function-item message-forward-subject-author-subject) - (function-item message-forward-subject-fwd) - (function-item message-forward-subject-name-subject) - (repeat :tag "List of functions" function))) - -(defcustom message-forward-as-mime t - "*Non-nil means forward messages as an inline/rfc822 MIME section. -Otherwise, directly inline the old message in the forwarded message." - :version "21.1" - :group 'message-forwarding - :link '(custom-manual "(message)Forwarding") - :type 'boolean) - -(defcustom message-forward-show-mml 'best - "*Non-nil means show forwarded messages as MML (decoded from MIME). -Otherwise, forwarded messages are unchanged. -Can also be the symbol `best' to indicate that MML should be -used, except when it is a bad idea to use MML. One example where -it is a bad idea is when forwarding a signed or encrypted -message, because converting MIME to MML would invalidate the -digital signature." - :version "21.1" - :group 'message-forwarding - :type '(choice (const :tag "use MML" t) - (const :tag "don't use MML " nil) - (const :tag "use MML when appropriate" best))) - -(defcustom message-forward-before-signature t - "*Non-nil means put forwarded message before signature, else after." - :group 'message-forwarding - :type 'boolean) - -(defcustom message-wash-forwarded-subjects nil - "*Non-nil means try to remove as much cruft as possible from the subject. -Done before generating the new subject of a forward." - :group 'message-forwarding - :link '(custom-manual "(message)Forwarding") - :type 'boolean) - -(defcustom message-ignored-resent-headers "^Return-receipt\\|^X-Gnus\\|^Gnus-Warning:\\|^>?From " - "*All headers that match this regexp will be deleted when resending a message." - :group 'message-interface - :link '(custom-manual "(message)Resending") - :type '(repeat :value-to-internal (lambda (widget value) - (custom-split-regexp-maybe value)) - :match (lambda (widget value) - (or (stringp value) - (widget-editable-list-match widget value))) - regexp)) - -(defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus" - "*All headers that match this regexp will be deleted when forwarding a message." - :version "21.1" - :group 'message-forwarding - :type '(repeat :value-to-internal (lambda (widget value) - (custom-split-regexp-maybe value)) - :match (lambda (widget value) - (or (stringp value) - (widget-editable-list-match widget value))) - regexp)) - -(defcustom message-ignored-cited-headers "." - "*Delete these headers from the messages you yank." - :group 'message-insertion - :link '(custom-manual "(message)Insertion Variables") - :type 'regexp) - -(defcustom message-cite-prefix-regexp - (if (string-match "[[:digit:]]" "1") ;; support POSIX? - "\\([ \t]*[-_.[:word:]]+>+\\|[ \t]*[]>|}+]\\)+" - ;; ?-, ?_ or ?. MUST NOT be in syntax entry w. - (let ((old-table (syntax-table)) - non-word-constituents) - (set-syntax-table text-mode-syntax-table) - (setq non-word-constituents - (concat - (if (string-match "\\w" "-") "" "-") - (if (string-match "\\w" "_") "" "_") - (if (string-match "\\w" ".") "" "."))) - (set-syntax-table old-table) - (if (equal non-word-constituents "") - "\\([ \t]*\\(\\w\\)+>+\\|[ \t]*[]>|}+]\\)+" - (concat "\\([ \t]*\\(\\w\\|[" - non-word-constituents - "]\\)+>+\\|[ \t]*[]>|}+]\\)+")))) - "*Regexp matching the longest possible citation prefix on a line." - :version "22.1" - :group 'message-insertion - :link '(custom-manual "(message)Insertion Variables") - :type 'regexp) - -(defcustom message-cancel-message "I am canceling my own article.\n" - "Message to be inserted in the cancel message." - :group 'message-interface - :link '(custom-manual "(message)Canceling News") - :type 'string) - -;; Useful to set in site-init.el -;;;###autoload -(defcustom message-send-mail-function 'message-send-mail-with-sendmail - "Function to call to send the current buffer as mail. -The headers should be delimited by a line whose contents match the -variable `mail-header-separator'. - -Valid values include `message-send-mail-with-sendmail' (the default), -`message-send-mail-with-mh', `message-send-mail-with-qmail', -`message-smtpmail-send-it', `smtpmail-send-it' and `feedmail-send-it'. - -See also `send-mail-function'." - :type '(radio (function-item message-send-mail-with-sendmail) - (function-item message-send-mail-with-mh) - (function-item message-send-mail-with-qmail) - (function-item message-smtpmail-send-it) - (function-item smtpmail-send-it) - (function-item feedmail-send-it) - (function :tag "Other")) - :group 'message-sending - :link '(custom-manual "(message)Mail Variables") - :group 'message-mail) - -(defcustom message-send-news-function 'message-send-news - "Function to call to send the current buffer as news. -The headers should be delimited by a line whose contents match the -variable `mail-header-separator'." - :group 'message-sending - :group 'message-news - :link '(custom-manual "(message)News Variables") - :type 'function) - -(defcustom message-reply-to-function nil - "If non-nil, function that should return a list of headers. -This function should pick out addresses from the To, Cc, and From headers -and respond with new To and Cc headers." - :group 'message-interface - :link '(custom-manual "(message)Reply") - :type '(choice function (const nil))) - -(defcustom message-wide-reply-to-function nil - "If non-nil, function that should return a list of headers. -This function should pick out addresses from the To, Cc, and From headers -and respond with new To and Cc headers." - :group 'message-interface - :link '(custom-manual "(message)Wide Reply") - :type '(choice function (const nil))) - -(defcustom message-followup-to-function nil - "If non-nil, function that should return a list of headers. -This function should pick out addresses from the To, Cc, and From headers -and respond with new To and Cc headers." - :group 'message-interface - :link '(custom-manual "(message)Followup") - :type '(choice function (const nil))) - -(defcustom message-use-followup-to 'ask - "*Specifies what to do with Followup-To header. -If nil, always ignore the header. If it is t, use its value, but -query before using the \"poster\" value. If it is the symbol `ask', -always query the user whether to use the value. If it is the symbol -`use', always use the value." - :group 'message-interface - :link '(custom-manual "(message)Followup") - :type '(choice (const :tag "ignore" nil) - (const :tag "use & query" t) - (const use) - (const ask))) - -(defcustom message-use-mail-followup-to 'use - "*Specifies what to do with Mail-Followup-To header. -If nil, always ignore the header. If it is the symbol `ask', always -query the user whether to use the value. If it is the symbol `use', -always use the value." - :version "22.1" - :group 'message-interface - :link '(custom-manual "(message)Mailing Lists") - :type '(choice (const :tag "ignore" nil) - (const use) - (const ask))) - -(defcustom message-subscribed-address-functions nil - "*Specifies functions for determining list subscription. -If nil, do not attempt to determine list subscription with functions. -If non-nil, this variable contains a list of functions which return -regular expressions to match lists. These functions can be used in -conjunction with `message-subscribed-regexps' and -`message-subscribed-addresses'." - :version "22.1" - :group 'message-interface - :link '(custom-manual "(message)Mailing Lists") - :type '(repeat sexp)) - -(defcustom message-subscribed-address-file nil - "*A file containing addresses the user is subscribed to. -If nil, do not look at any files to determine list subscriptions. If -non-nil, each line of this file should be a mailing list address." - :version "22.1" - :group 'message-interface - :link '(custom-manual "(message)Mailing Lists") - :type '(radio file (const nil))) - -(defcustom message-subscribed-addresses nil - "*Specifies a list of addresses the user is subscribed to. -If nil, do not use any predefined list subscriptions. This list of -addresses can be used in conjunction with -`message-subscribed-address-functions' and `message-subscribed-regexps'." - :version "22.1" - :group 'message-interface - :link '(custom-manual "(message)Mailing Lists") - :type '(repeat string)) - -(defcustom message-subscribed-regexps nil - "*Specifies a list of addresses the user is subscribed to. -If nil, do not use any predefined list subscriptions. This list of -regular expressions can be used in conjunction with -`message-subscribed-address-functions' and `message-subscribed-addresses'." - :version "22.1" - :group 'message-interface - :link '(custom-manual "(message)Mailing Lists") - :type '(repeat regexp)) - -(defcustom message-allow-no-recipients 'ask - "Specifies what to do when there are no recipients other than Gcc/Fcc. -If it is the symbol `always', the posting is allowed. If it is the -symbol `never', the posting is not allowed. If it is the symbol -`ask', you are prompted." - :version "22.1" - :group 'message-interface - :link '(custom-manual "(message)Message Headers") - :type '(choice (const always) - (const never) - (const ask))) - -(defcustom message-sendmail-f-is-evil nil - "*Non-nil means don't add \"-f username\" to the sendmail command line. -Doing so would be even more evil than leaving it out." - :group 'message-sending - :link '(custom-manual "(message)Mail Variables") - :type 'boolean) - -(defcustom message-sendmail-envelope-from nil - "*Envelope-from when sending mail with sendmail. -If this is nil, use `user-mail-address'. If it is the symbol -`header', use the From: header of the message." - :version "22.1" - :type '(choice (string :tag "From name") - (const :tag "Use From: header from message" header) - (const :tag "Use `user-mail-address'" nil)) - :link '(custom-manual "(message)Mail Variables") - :group 'message-sending) - -;; qmail-related stuff -(defcustom message-qmail-inject-program "/var/qmail/bin/qmail-inject" - "Location of the qmail-inject program." - :group 'message-sending - :link '(custom-manual "(message)Mail Variables") - :type 'file) - -(defcustom message-qmail-inject-args nil - "Arguments passed to qmail-inject programs. -This should be a list of strings, one string for each argument. It -may also be a function. - -For e.g., if you wish to set the envelope sender address so that bounces -go to the right place or to deal with listserv's usage of that address, you -might set this variable to '(\"-f\" \"you@some.where\")." - :group 'message-sending - :link '(custom-manual "(message)Mail Variables") - :type '(choice (function) - (repeat string))) - -(defvar message-cater-to-broken-inn t - "Non-nil means Gnus should not fold the `References' header. -Folding `References' makes ancient versions of INN create incorrect -NOV lines.") - -(eval-when-compile - (defvar gnus-post-method) - (defvar gnus-select-method)) -(defcustom message-post-method - (cond ((and (boundp 'gnus-post-method) - (listp gnus-post-method) - gnus-post-method) - gnus-post-method) - ((boundp 'gnus-select-method) - gnus-select-method) - (t '(nnspool ""))) - "*Method used to post news. -Note that when posting from inside Gnus, for instance, this -variable isn't used." - :group 'message-news - :group 'message-sending - ;; This should be the `gnus-select-method' widget, but that might - ;; create a dependence to `gnus.el'. - :type 'sexp) - -;; FIXME: This should be a temporary workaround until someone implements a -;; proper solution. If a crash happens while replying, the auto-save file -;; will *not* have a `References:' header if `message-generate-headers-first' -;; is nil. See: http://article.gmane.org/gmane.emacs.gnus.general/51138 -(defcustom message-generate-headers-first '(references) - "Which headers should be generated before starting to compose a message. -If t, generate all required headers. This can also be a list of headers to -generate. The variables `message-required-news-headers' and -`message-required-mail-headers' specify which headers to generate. - -Note that the variable `message-deletable-headers' specifies headers which -are to be deleted and then re-generated before sending, so this variable -will not have a visible effect for those headers." - :group 'message-headers - :link '(custom-manual "(message)Message Headers") - :type '(choice (const :tag "None" nil) - (const :tag "References" '(references)) - (const :tag "All" t) - (repeat (sexp :tag "Header")))) - -(defcustom message-setup-hook nil - "Normal hook, run each time a new outgoing message is initialized. -The function `message-setup' runs this hook." - :group 'message-various - :link '(custom-manual "(message)Various Message Variables") - :type 'hook) - -(defcustom message-cancel-hook nil - "Hook run when cancelling articles." - :group 'message-various - :link '(custom-manual "(message)Various Message Variables") - :type 'hook) - -(defcustom message-signature-setup-hook nil - "Normal hook, run each time a new outgoing message is initialized. -It is run after the headers have been inserted and before -the signature is inserted." - :group 'message-various - :link '(custom-manual "(message)Various Message Variables") - :type 'hook) - -(defcustom message-mode-hook nil - "Hook run in message mode buffers." - :group 'message-various - :type 'hook) - -(defcustom message-header-hook nil - "Hook run in a message mode buffer narrowed to the headers." - :group 'message-various - :type 'hook) - -(defcustom message-header-setup-hook nil - "Hook called narrowed to the headers when setting up a message buffer." - :group 'message-various - :link '(custom-manual "(message)Various Message Variables") - :type 'hook) - -(defcustom message-minibuffer-local-map - (let ((map (make-sparse-keymap 'message-minibuffer-local-map))) - (set-keymap-parent map minibuffer-local-map) - map) - "Keymap for `message-read-from-minibuffer'." - :version "22.1" - :group 'message-various) - -;;;###autoload -(defcustom message-citation-line-function 'message-insert-citation-line - "*Function called to insert the \"Whomever writes:\" line. - -Note that Gnus provides a feature where the reader can click on -`writes:' to hide the cited text. If you change this line too much, -people who read your message will have to change their Gnus -configuration. See the variable `gnus-cite-attribution-suffix'." - :type 'function - :link '(custom-manual "(message)Insertion Variables") - :group 'message-insertion) - -;;;###autoload -(defcustom message-yank-prefix "> " - "*Prefix inserted on the lines of yanked messages. -Fix `message-cite-prefix-regexp' if it is set to an abnormal value. -See also `message-yank-cited-prefix'." - :type 'string - :link '(custom-manual "(message)Insertion Variables") - :group 'message-insertion) - -(defcustom message-yank-cited-prefix ">" - "*Prefix inserted on cited or empty lines of yanked messages. -Fix `message-cite-prefix-regexp' if it is set to an abnormal value. -See also `message-yank-prefix'." - :version "22.1" - :type 'string - :link '(custom-manual "(message)Insertion Variables") - :group 'message-insertion) - -(defcustom message-indentation-spaces 3 - "*Number of spaces to insert at the beginning of each cited line. -Used by `message-yank-original' via `message-yank-cite'." - :group 'message-insertion - :link '(custom-manual "(message)Insertion Variables") - :type 'integer) - -;;;###autoload -(defcustom message-cite-function 'message-cite-original - "*Function for citing an original message. -Predefined functions include `message-cite-original' and -`message-cite-original-without-signature'. -Note that `message-cite-original' uses `mail-citation-hook' if that is non-nil." - :type '(radio (function-item message-cite-original) - (function-item message-cite-original-without-signature) - (function-item sc-cite-original) - (function :tag "Other")) - :link '(custom-manual "(message)Insertion Variables") - :group 'message-insertion) - -;;;###autoload -(defcustom message-indent-citation-function 'message-indent-citation - "*Function for modifying a citation just inserted in the mail buffer. -This can also be a list of functions. Each function can find the -citation between (point) and (mark t). And each function should leave -point and mark around the citation text as modified." - :type 'function - :link '(custom-manual "(message)Insertion Variables") - :group 'message-insertion) - -;;;###autoload -(defcustom message-signature t - "*String to be inserted at the end of the message buffer. -If t, the `message-signature-file' file will be inserted instead. -If a function, the result from the function will be used instead. -If a form, the result from the form will be used instead." - :type 'sexp - :link '(custom-manual "(message)Insertion Variables") - :group 'message-insertion) - -;;;###autoload -(defcustom message-signature-file "~/.signature" - "*Name of file containing the text inserted at end of message buffer. -Ignored if the named file doesn't exist. -If nil, don't insert a signature." - :type '(choice file (const :tags "None" nil)) - :link '(custom-manual "(message)Insertion Variables") - :group 'message-insertion) - -;;;###autoload -(defcustom message-signature-insert-empty-line t - "*If non-nil, insert an empty line before the signature separator." - :version "22.1" - :type 'boolean - :link '(custom-manual "(message)Insertion Variables") - :group 'message-insertion) - -(defcustom message-distribution-function nil - "*Function called to return a Distribution header." - :group 'message-news - :group 'message-headers - :link '(custom-manual "(message)News Headers") - :type '(choice function (const nil))) - -(defcustom message-expires 14 - "Number of days before your article expires." - :group 'message-news - :group 'message-headers - :link '(custom-manual "(message)News Headers") - :type 'integer) - -(defcustom message-user-path nil - "If nil, use the NNTP server name in the Path header. -If stringp, use this; if non-nil, use no host name (user name only)." - :group 'message-news - :group 'message-headers - :link '(custom-manual "(message)News Headers") - :type '(choice (const :tag "nntp" nil) - (string :tag "name") - (sexp :tag "none" :format "%t" t))) - -(defvar message-reply-buffer nil) -(defvar message-reply-headers nil - "The headers of the current replied article. -It is a vector of the following headers: -\[number subject from date id references chars lines xref extra].") -(defvar message-newsreader nil) -(defvar message-mailer nil) -(defvar message-sent-message-via nil) -(defvar message-checksum nil) -(defvar message-send-actions nil - "A list of actions to be performed upon successful sending of a message.") -(defvar message-exit-actions nil - "A list of actions to be performed upon exiting after sending a message.") -(defvar message-kill-actions nil - "A list of actions to be performed before killing a message buffer.") -(defvar message-postpone-actions nil - "A list of actions to be performed after postponing a message.") - -(define-widget 'message-header-lines 'text - "All header lines must be LFD terminated." - :format "%{%t%}:%n%v" - :valid-regexp "^\\'" - :error "All header lines must be newline terminated") - -(defcustom message-default-headers "" - "*A string containing header lines to be inserted in outgoing messages. -It is inserted before you edit the message, so you can edit or delete -these lines." - :group 'message-headers - :link '(custom-manual "(message)Message Headers") - :type 'message-header-lines) - -(defcustom message-default-mail-headers "" - "*A string of header lines to be inserted in outgoing mails." - :group 'message-headers - :group 'message-mail - :link '(custom-manual "(message)Mail Headers") - :type 'message-header-lines) - -(defcustom message-default-news-headers "" - "*A string of header lines to be inserted in outgoing news articles." - :group 'message-headers - :group 'message-news - :link '(custom-manual "(message)News Headers") - :type 'message-header-lines) - -;; Note: could use /usr/ucb/mail instead of sendmail; -;; options -t, and -v if not interactive. -(defcustom message-mailer-swallows-blank-line - (if (and (string-match "sparc-sun-sunos\\(\\'\\|[^5]\\)" - system-configuration) - (file-readable-p "/etc/sendmail.cf") - (let ((buffer (get-buffer-create " *temp*"))) - (unwind-protect - (save-excursion - (set-buffer buffer) - (insert-file-contents "/etc/sendmail.cf") - (goto-char (point-min)) - (let ((case-fold-search nil)) - (re-search-forward "^OR\\>" nil t))) - (kill-buffer buffer)))) - ;; According to RFC822, "The field-name must be composed of printable - ;; ASCII characters (i. e., characters that have decimal values between - ;; 33 and 126, except colon)", i. e., any chars except ctl chars, - ;; space, or colon. - '(looking-at "[ \t]\\|[][!\"#$%&'()*+,-./0-9;<=>?@A-Z\\\\^_`a-z{|}~]+:")) - "*Set this non-nil if the system's mailer runs the header and body together. -\(This problem exists on Sunos 4 when sendmail is run in remote mode.) -The value should be an expression to test whether the problem will -actually occur." - :group 'message-sending - :link '(custom-manual "(message)Mail Variables") - :type 'sexp) - -;;;###autoload -(define-mail-user-agent 'message-user-agent - 'message-mail 'message-send-and-exit - 'message-kill-buffer 'message-send-hook) - -(defvar message-mh-deletable-headers '(Message-ID Date Lines Sender) - "If non-nil, delete the deletable headers before feeding to mh.") - -(defvar message-send-method-alist - '((news message-news-p message-send-via-news) - (mail message-mail-p message-send-via-mail)) - "Alist of ways to send outgoing messages. -Each element has the form - - \(TYPE PREDICATE FUNCTION) - -where TYPE is a symbol that names the method; PREDICATE is a function -called without any parameters to determine whether the message is -a message of type TYPE; and FUNCTION is a function to be called if -PREDICATE returns non-nil. FUNCTION is called with one parameter -- -the prefix.") - -(defcustom message-mail-alias-type 'abbrev - "*What alias expansion type to use in Message buffers. -The default is `abbrev', which uses mailabbrev. nil switches -mail aliases off." - :group 'message - :link '(custom-manual "(message)Mail Aliases") - :type '(choice (const :tag "Use Mailabbrev" abbrev) - (const :tag "No expansion" nil))) - -(defcustom message-auto-save-directory - (file-name-as-directory (nnheader-concat message-directory "drafts")) - "*Directory where Message auto-saves buffers if Gnus isn't running. -If nil, Message won't auto-save." - :group 'message-buffers - :link '(custom-manual "(message)Various Message Variables") - :type '(choice directory (const :tag "Don't auto-save" nil))) - -(defcustom message-default-charset - (and (not (mm-multibyte-p)) 'iso-8859-1) - "Default charset used in non-MULE Emacsen. -If nil, you might be asked to input the charset." - :version "21.1" - :group 'message - :link '(custom-manual "(message)Various Message Variables") - :type 'symbol) - -(defcustom message-dont-reply-to-names - (and (boundp 'rmail-dont-reply-to-names) rmail-dont-reply-to-names) - "*A regexp specifying addresses to prune when doing wide replies. -A value of nil means exclude your own user name only." - :version "21.1" - :group 'message - :link '(custom-manual "(message)Wide Reply") - :type '(choice (const :tag "Yourself" nil) - regexp)) - -(defvar message-shoot-gnksa-feet nil - "*A list of GNKSA feet you are allowed to shoot. -Gnus gives you all the opportunity you could possibly want for -shooting yourself in the foot. Also, Gnus allows you to shoot the -feet of Good Net-Keeping Seal of Approval. The following are foot -candidates: -`empty-article' Allow you to post an empty article; -`quoted-text-only' Allow you to post quoted text only; -`multiple-copies' Allow you to post multiple copies; -`cancel-messages' Allow you to cancel or supersede messages from - your other email addresses.") - -(defsubst message-gnksa-enable-p (feature) - (or (not (listp message-shoot-gnksa-feet)) - (memq feature message-shoot-gnksa-feet))) - -(defcustom message-hidden-headers nil - "Regexp of headers to be hidden when composing new messages. -This can also be a list of regexps to match headers. Or a list -starting with `not' and followed by regexps." - :version "22.1" - :group 'message - :link '(custom-manual "(message)Message Headers") - :type '(repeat regexp)) - -;;; Internal variables. -;;; Well, not really internal. - -(defvar message-mode-syntax-table - (let ((table (copy-syntax-table text-mode-syntax-table))) - (modify-syntax-entry ?% ". " table) - (modify-syntax-entry ?> ". " table) - (modify-syntax-entry ?< ". " table) - table) - "Syntax table used while in Message mode.") - -(defface message-header-to - '((((class color) - (background dark)) - (:foreground "green2" :bold t)) - (((class color) - (background light)) - (:foreground "MidnightBlue" :bold t)) - (t - (:bold t :italic t))) - "Face used for displaying From headers." - :group 'message-faces) -;; backward-compatibility alias -(put 'message-header-to-face 'face-alias 'message-header-to) - -(defface message-header-cc - '((((class color) - (background dark)) - (:foreground "green4" :bold t)) - (((class color) - (background light)) - (:foreground "MidnightBlue")) - (t - (:bold t))) - "Face used for displaying Cc headers." - :group 'message-faces) -;; backward-compatibility alias -(put 'message-header-cc-face 'face-alias 'message-header-cc) - -(defface message-header-subject - '((((class color) - (background dark)) - (:foreground "green3")) - (((class color) - (background light)) - (:foreground "navy blue" :bold t)) - (t - (:bold t))) - "Face used for displaying subject headers." - :group 'message-faces) -;; backward-compatibility alias -(put 'message-header-subject-face 'face-alias 'message-header-subject) - -(defface message-header-newsgroups - '((((class color) - (background dark)) - (:foreground "yellow" :bold t :italic t)) - (((class color) - (background light)) - (:foreground "blue4" :bold t :italic t)) - (t - (:bold t :italic t))) - "Face used for displaying newsgroups headers." - :group 'message-faces) -;; backward-compatibility alias -(put 'message-header-newsgroups-face 'face-alias 'message-header-newsgroups) - -(defface message-header-other - '((((class color) - (background dark)) - (:foreground "#b00000")) - (((class color) - (background light)) - (:foreground "steel blue")) - (t - (:bold t :italic t))) - "Face used for displaying newsgroups headers." - :group 'message-faces) -;; backward-compatibility alias -(put 'message-header-other-face 'face-alias 'message-header-other) - -(defface message-header-name - '((((class color) - (background dark)) - (:foreground "DarkGreen")) - (((class color) - (background light)) - (:foreground "cornflower blue")) - (t - (:bold t))) - "Face used for displaying header names." - :group 'message-faces) -;; backward-compatibility alias -(put 'message-header-name-face 'face-alias 'message-header-name) - -(defface message-header-xheader - '((((class color) - (background dark)) - (:foreground "blue")) - (((class color) - (background light)) - (:foreground "blue")) - (t - (:bold t))) - "Face used for displaying X-Header headers." - :group 'message-faces) -;; backward-compatibility alias -(put 'message-header-xheader-face 'face-alias 'message-header-xheader) - -(defface message-separator - '((((class color) - (background dark)) - (:foreground "blue3")) - (((class color) - (background light)) - (:foreground "brown")) - (t - (:bold t))) - "Face used for displaying the separator." - :group 'message-faces) -;; backward-compatibility alias -(put 'message-separator-face 'face-alias 'message-separator) - -(defface message-cited-text - '((((class color) - (background dark)) - (:foreground "red")) - (((class color) - (background light)) - (:foreground "red")) - (t - (:bold t))) - "Face used for displaying cited text names." - :group 'message-faces) -;; backward-compatibility alias -(put 'message-cited-text-face 'face-alias 'message-cited-text) - -(defface message-mml - '((((class color) - (background dark)) - (:foreground "ForestGreen")) - (((class color) - (background light)) - (:foreground "ForestGreen")) - (t - (:bold t))) - "Face used for displaying MML." - :group 'message-faces) -;; backward-compatibility alias -(put 'message-mml-face 'face-alias 'message-mml) - -(defun message-font-lock-make-header-matcher (regexp) - (let ((form - `(lambda (limit) - (let ((start (point))) - (save-restriction - (widen) - (goto-char (point-min)) - (if (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$") - nil t) - (setq limit (min limit (match-beginning 0)))) - (goto-char start)) - (and (< start limit) - (re-search-forward ,regexp limit t)))))) - (if (featurep 'bytecomp) - (byte-compile form) - form))) - -(defvar message-font-lock-keywords - (let ((content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)\n?")) - `((,(message-font-lock-make-header-matcher - (concat "^\\([Tt]o:\\)" content)) - (1 'message-header-name) - (2 'message-header-to nil t)) - (,(message-font-lock-make-header-matcher - (concat "^\\(^[GBF]?[Cc][Cc]:\\|^[Rr]eply-[Tt]o:\\)" content)) - (1 'message-header-name) - (2 'message-header-cc nil t)) - (,(message-font-lock-make-header-matcher - (concat "^\\([Ss]ubject:\\)" content)) - (1 'message-header-name) - (2 'message-header-subject nil t)) - (,(message-font-lock-make-header-matcher - (concat "^\\([Nn]ewsgroups:\\|Followup-[Tt]o:\\)" content)) - (1 'message-header-name) - (2 'message-header-newsgroups nil t)) - (,(message-font-lock-make-header-matcher - (concat "^\\([A-Z][^: \n\t]+:\\)" content)) - (1 'message-header-name) - (2 'message-header-other nil t)) - (,(message-font-lock-make-header-matcher - (concat "^\\(X-[A-Za-z0-9-]+:\\|In-Reply-To:\\)" content)) - (1 'message-header-name) - (2 'message-header-name)) - ,@(if (and mail-header-separator - (not (equal mail-header-separator ""))) - `((,(concat "^\\(" (regexp-quote mail-header-separator) "\\)$") - 1 'message-separator)) - nil) - ((lambda (limit) - (re-search-forward (concat "^\\(" - message-cite-prefix-regexp - "\\).*") - limit t)) - (0 'message-cited-text)) - ("<#/?\\(multipart\\|part\\|external\\|mml\\|secure\\)[^>]*>" - (0 'message-mml)))) - "Additional expressions to highlight in Message mode.") - - -;; XEmacs does it like this. For Emacs, we have to set the -;; `font-lock-defaults' buffer-local variable. -(put 'message-mode 'font-lock-defaults '(message-font-lock-keywords t)) - -(defvar message-face-alist - '((bold . bold-region) - (underline . underline-region) - (default . (lambda (b e) - (unbold-region b e) - (ununderline-region b e)))) - "Alist of mail and news faces for facemenu. -The cdr of each entry is a function for applying the face to a region.") - -(defcustom message-send-hook nil - "Hook run before sending messages. -This hook is run quite early when sending." - :group 'message-various - :options '(ispell-message) - :link '(custom-manual "(message)Various Message Variables") - :type 'hook) - -(defcustom message-send-mail-hook nil - "Hook run before sending mail messages. -This hook is run very late -- just before the message is sent as -mail." - :group 'message-various - :link '(custom-manual "(message)Various Message Variables") - :type 'hook) - -(defcustom message-send-news-hook nil - "Hook run before sending news messages. -This hook is run very late -- just before the message is sent as -news." - :group 'message-various - :link '(custom-manual "(message)Various Message Variables") - :type 'hook) - -(defcustom message-sent-hook nil - "Hook run after sending messages." - :group 'message-various - :type 'hook) - -(defvar message-send-coding-system 'binary - "Coding system to encode outgoing mail.") - -(defvar message-draft-coding-system - mm-auto-save-coding-system - "*Coding system to compose mail. -If you'd like to make it possible to share draft files between XEmacs -and Emacs, you may use `iso-2022-7bit' for this value at your own risk. -Note that the coding-system `iso-2022-7bit' isn't suitable to all data.") - -(defcustom message-send-mail-partially-limit 1000000 - "The limitation of messages sent as message/partial. -The lower bound of message size in characters, beyond which the message -should be sent in several parts. If it is nil, the size is unlimited." - :version "21.1" - :group 'message-buffers - :link '(custom-manual "(message)Mail Variables") - :type '(choice (const :tag "unlimited" nil) - (integer 1000000))) - -(defcustom message-alternative-emails nil - "*Regexp matching alternative email addresses. -The first address in the To, Cc or From headers of the original -article matching this variable is used as the From field of -outgoing messages. - -This variable has precedence over posting styles and anything that runs -off `message-setup-hook'." - :group 'message-headers - :link '(custom-manual "(message)Message Headers") - :type '(choice (const :tag "Always use primary" nil) - regexp)) - -(defcustom message-hierarchical-addresses nil - "A list of hierarchical mail address definitions. - -Inside each entry, the first address is the \"top\" address, and -subsequent addresses are subaddresses; this is used to indicate that -mail sent to the first address will automatically be delivered to the -subaddresses. So if the first address appears in the recipient list -for a message, the subaddresses will be removed (if present) before -the mail is sent. All addresses in this structure should be -downcased." - :version "22.1" - :group 'message-headers - :type '(repeat (repeat string))) - -(defcustom message-mail-user-agent nil - "Like `mail-user-agent'. -Except if it is nil, use Gnus native MUA; if it is t, use -`mail-user-agent'." - :version "22.1" - :type '(radio (const :tag "Gnus native" - :format "%t\n" - nil) - (const :tag "`mail-user-agent'" - :format "%t\n" - t) - (function-item :tag "Default Emacs mail" - :format "%t\n" - sendmail-user-agent) - (function-item :tag "Emacs interface to MH" - :format "%t\n" - mh-e-user-agent) - (function :tag "Other")) - :version "21.1" - :group 'message) - -(defcustom message-wide-reply-confirm-recipients nil - "Whether to confirm a wide reply to multiple email recipients. -If this variable is nil, don't ask whether to reply to all recipients. -If this variable is non-nil, pose the question \"Reply to all -recipients?\" before a wide reply to multiple recipients. If the user -answers yes, reply to all recipients as usual. If the user answers -no, only reply back to the author." - :version "22.1" - :group 'message-headers - :link '(custom-manual "(message)Wide Reply") - :type 'boolean) - -(defcustom message-user-fqdn nil - "*Domain part of Message-Ids." - :version "22.1" - :group 'message-headers - :link '(custom-manual "(message)News Headers") - :type '(radio (const :format "%v " nil) - (string :format "FQDN: %v"))) - -;; XEmacs change: Don't calculate a default value -(defcustom message-use-idna nil - "Whether to encode non-ASCII in domain names into ASCII according to IDNA. -GNU Libidn, and in particular the elisp package \"idna.el\" and -the external program \"idn\", must be installed for this -functionality to work." - :version "22.1" - :group 'message-headers - :link '(custom-manual "(message)IDNA") - :type '(choice (const :tag "Ask" ask) - (const :tag "Never" nil) - (const :tag "Always" t))) - -;;; Internal variables. - -(defvar message-sending-message "Sending...") -(defvar message-buffer-list nil) -(defvar message-this-is-news nil) -(defvar message-this-is-mail nil) -(defvar message-draft-article nil) -(defvar message-mime-part nil) -(defvar message-posting-charset nil) -(defvar message-inserted-headers nil) - -;; Byte-compiler warning -(eval-when-compile - (defvar gnus-active-hashtb) - (defvar gnus-read-active-file)) - -;;; Regexp matching the delimiter of messages in UNIX mail format -;;; (UNIX From lines), minus the initial ^. It should be a copy -;;; of rmail.el's rmail-unix-mail-delimiter. -(defvar message-unix-mail-delimiter - (let ((time-zone-regexp - (concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?" - "\\|[-+]?[0-9][0-9][0-9][0-9]" - "\\|" - "\\) *"))) - (concat - "From " - - ;; Many things can happen to an RFC 822 mailbox before it is put into - ;; a `From' line. The leading phrase can be stripped, e.g. - ;; `Joe <@w.x:joe@y.z>' -> `<@w.x:joe@y.z>'. The <> can be stripped, e.g. - ;; `<@x.y:joe@y.z>' -> `@x.y:joe@y.z'. Everything starting with a CRLF - ;; can be removed, e.g. - ;; From: joe@y.z (Joe K - ;; User) - ;; can yield `From joe@y.z (Joe K Fri Mar 22 08:11:15 1996', and - ;; From: Joe User - ;; - ;; can yield `From Joe User Fri Mar 22 08:11:15 1996'. - ;; The mailbox can be removed or be replaced by white space, e.g. - ;; From: "Joe User"{space}{tab} - ;; - ;; can yield `From {space}{tab} Fri Mar 22 08:11:15 1996', - ;; where {space} and {tab} represent the Ascii space and tab characters. - ;; We want to match the results of any of these manglings. - ;; The following regexp rejects names whose first characters are - ;; obviously bogus, but after that anything goes. - "\\([^\0-\b\n-\r\^?].*\\)?" - - ;; The time the message was sent. - "\\([^\0-\r \^?]+\\) +" ; day of the week - "\\([^\0-\r \^?]+\\) +" ; month - "\\([0-3]?[0-9]\\) +" ; day of month - "\\([0-2][0-9]:[0-5][0-9]\\(:[0-6][0-9]\\)?\\) *" ; time of day - - ;; Perhaps a time zone, specified by an abbreviation, or by a - ;; numeric offset. - time-zone-regexp - - ;; The year. - " \\([0-9][0-9]+\\) *" - - ;; On some systems the time zone can appear after the year, too. - time-zone-regexp - - ;; Old uucp cruft. - "\\(remote from .*\\)?" - - "\n")) - "Regexp matching the delimiter of messages in UNIX mail format.") - -(defvar message-unsent-separator - (concat "^ *---+ +Unsent message follows +---+ *$\\|" - "^ *---+ +Returned message +---+ *$\\|" - "^Start of returned message$\\|" - "^ *---+ +Original message +---+ *$\\|" - "^ *--+ +begin message +--+ *$\\|" - "^ *---+ +Original message follows +---+ *$\\|" - "^ *---+ +Undelivered message follows +---+ *$\\|" - "^|? *---+ +Message text follows: +---+ *|?$") - "A regexp that matches the separator before the text of a failed message.") - -(defvar message-header-format-alist - `((Newsgroups) - (To . message-fill-address) - (Cc . message-fill-address) - (Subject) - (In-Reply-To) - (Fcc) - (Bcc) - (Date) - (Organization) - (Distribution) - (Lines) - (Expires) - (Message-ID) - (References . message-shorten-references) - (User-Agent)) - "Alist used for formatting headers.") - -(defvar message-options nil - "Some saved answers when sending message.") - -(defvar message-send-mail-real-function nil - "Internal send mail function.") - -(defvar message-bogus-system-names "^localhost\\.\\|\\.local$" - "The regexp of bogus system names.") - -(defcustom message-valid-fqdn-regexp - (concat "[a-z0-9][-.a-z0-9]+\\." ;; [hostname.subdomain.]domain. - ;; valid TLDs: - "\\([a-z][a-z]\\|" ;; two letter country TDLs - "aero\\|arpa\\|bitnet\\|biz\\|bofh\\|" - "cat\\|com\\|coop\\|edu\\|gov\\|" - "info\\|int\\|jobs\\|" - "mil\\|mobi\\|museum\\|name\\|net\\|" - "org\\|pro\\|travel\\|uucp\\)") - ;; http://en.wikipedia.org/wiki/List_of_Internet_top-level_domains - ;; http://en.wikipedia.org/wiki/GTLD - ;; `in the process of being approved': .asia .post .tel .sex - ;; "dead" nato bitnet uucp - "Regular expression that matches a valid FQDN." - ;; see also: gnus-button-valid-fqdn-regexp - :version "22.1" - :group 'message-headers - :type 'regexp) - -(eval-and-compile - (autoload 'idna-to-ascii "idna") - (autoload 'message-setup-toolbar "messagexmas") - (autoload 'mh-new-draft-name "mh-comp") - (autoload 'mh-send-letter "mh-comp") - (autoload 'gnus-point-at-eol "gnus-util") - (autoload 'gnus-point-at-bol "gnus-util") - (autoload 'gnus-output-to-rmail "gnus-util") - (autoload 'gnus-output-to-mail "gnus-util") - (autoload 'nndraft-request-associate-buffer "nndraft") - (autoload 'nndraft-request-expire-articles "nndraft") - (autoload 'gnus-open-server "gnus-int") - (autoload 'gnus-request-post "gnus-int") - (autoload 'gnus-alive-p "gnus-util") - (autoload 'gnus-server-string "gnus") - (autoload 'gnus-group-name-charset "gnus-group") - (autoload 'gnus-group-name-decode "gnus-group") - (autoload 'gnus-groups-from-server "gnus") - (autoload 'rmail-output "rmailout") - (autoload 'gnus-delay-article "gnus-delay") - (autoload 'gnus-make-local-hook "gnus-util") - (autoload 'gnus-extract-address-components "gnus-util") - (autoload 'gnus-select-frame-set-input-focus "gnus-util")) - - - -;;; -;;; Utility functions. -;;; - -(defmacro message-y-or-n-p (question show &rest text) - "Ask QUESTION, displaying remaining args in a temporary buffer if SHOW." - `(message-talkative-question 'y-or-n-p ,question ,show ,@text)) - -(defmacro message-delete-line (&optional n) - "Delete the current line (and the next N lines)." - `(delete-region (progn (beginning-of-line) (point)) - (progn (forward-line ,(or n 1)) (point)))) - -(defun message-mark-active-p () - "Non-nil means the mark and region are currently active in this buffer." - mark-active) - -(defun message-unquote-tokens (elems) - "Remove double quotes (\") from strings in list ELEMS." - (mapcar (lambda (item) - (while (string-match "^\\(.*\\)\"\\(.*\\)$" item) - (setq item (concat (match-string 1 item) - (match-string 2 item)))) - item) - elems)) - -(defun message-tokenize-header (header &optional separator) - "Split HEADER into a list of header elements. -SEPARATOR is a string of characters to be used as separators. \",\" -is used by default." - (if (not header) - nil - (let ((regexp (format "[%s]+" (or separator ","))) - (first t) - beg quoted elems paren) - (with-temp-buffer - (mm-enable-multibyte) - (setq beg (point-min)) - (insert header) - (goto-char (point-min)) - (while (not (eobp)) - (if first - (setq first nil) - (forward-char 1)) - (cond ((and (> (point) beg) - (or (eobp) - (and (looking-at regexp) - (not quoted) - (not paren)))) - (push (buffer-substring beg (point)) elems) - (setq beg (match-end 0))) - ((eq (char-after) ?\") - (setq quoted (not quoted))) - ((and (eq (char-after) ?\() - (not quoted)) - (setq paren t)) - ((and (eq (char-after) ?\)) - (not quoted)) - (setq paren nil)))) - (nreverse elems))))) - -(defun message-mail-file-mbox-p (file) - "Say whether FILE looks like a Unix mbox file." - (when (and (file-exists-p file) - (file-readable-p file) - (file-regular-p file)) - (with-temp-buffer - (nnheader-insert-file-contents file) - (goto-char (point-min)) - (looking-at message-unix-mail-delimiter)))) - -(defun message-fetch-field (header &optional not-all) - "The same as `mail-fetch-field', only remove all newlines. -The buffer is expected to be narrowed to just the header of the message; -see `message-narrow-to-headers-or-head'." - (let* ((inhibit-point-motion-hooks t) - (case-fold-search t) - (value (mail-fetch-field header nil (not not-all)))) - (when value - (while (string-match "\n[\t ]+" value) - (setq value (replace-match " " t t value))) - (set-text-properties 0 (length value) nil value) - value))) - -(defun message-field-value (header &optional not-all) - "The same as `message-fetch-field', only narrow to the headers first." - (save-excursion - (save-restriction - (message-narrow-to-headers-or-head) - (message-fetch-field header not-all)))) - -(defun message-narrow-to-field () - "Narrow the buffer to the header on the current line." - (beginning-of-line) - (narrow-to-region - (point) - (progn - (forward-line 1) - (if (re-search-forward "^[^ \n\t]" nil t) - (progn - (beginning-of-line) - (point)) - (point-max)))) - (goto-char (point-min))) - -(defun message-add-header (&rest headers) - "Add the HEADERS to the message header, skipping those already present." - (while headers - (let (hclean) - (unless (string-match "^\\([^:]+\\):[ \t]*[^ \t]" (car headers)) - (error "Invalid header `%s'" (car headers))) - (setq hclean (match-string 1 (car headers))) - (save-restriction - (message-narrow-to-headers) - (unless (re-search-forward (concat "^" (regexp-quote hclean) ":") nil t) - (goto-char (point-max)) - (if (string-match "\n$" (car headers)) - (insert (car headers)) - (insert (car headers) ?\n))))) - (setq headers (cdr headers)))) - -(defmacro message-with-reply-buffer (&rest forms) - "Evaluate FORMS in the reply buffer, if it exists." - `(when (and message-reply-buffer - (buffer-name message-reply-buffer)) - (save-excursion - (set-buffer message-reply-buffer) - ,@forms))) - -(put 'message-with-reply-buffer 'lisp-indent-function 0) -(put 'message-with-reply-buffer 'edebug-form-spec '(body)) - -(defun message-fetch-reply-field (header) - "Fetch field HEADER from the message we're replying to." - (message-with-reply-buffer - (save-restriction - (mail-narrow-to-head) - (message-fetch-field header)))) - -(defun message-strip-list-identifiers (subject) - "Remove list identifiers in `gnus-list-identifiers' from string SUBJECT." - (require 'gnus-sum) ; for gnus-list-identifiers - (let ((regexp (if (stringp gnus-list-identifiers) - gnus-list-identifiers - (mapconcat 'identity gnus-list-identifiers " *\\|")))) - (if (string-match (concat "\\(\\(\\(Re: +\\)?\\(" regexp - " *\\)\\)+\\(Re: +\\)?\\)") subject) - (concat (substring subject 0 (match-beginning 1)) - (or (match-string 3 subject) - (match-string 5 subject)) - (substring subject - (match-end 1))) - subject))) - -(defun message-strip-subject-re (subject) - "Remove \"Re:\" from subject lines in string SUBJECT." - (if (string-match message-subject-re-regexp subject) - (substring subject (match-end 0)) - subject)) - -(defcustom message-replacement-char "." - "Replacement character used instead of unprintable or not decodable chars." - :group 'message-various - :version "22.1" ;; Gnus 5.10.9 - :type '(choice string - (const ".") - (const "?"))) - -;; FIXME: We also should call `message-strip-subject-encoded-words' -;; when forwarding. Probably in `message-make-forward-subject' and -;; `message-forward-make-body'. - -(defun message-strip-subject-encoded-words (subject) - "Fix non-decodable words in SUBJECT." - ;; Cf. `gnus-simplify-subject-fully'. - (let* ((case-fold-search t) - (replacement-chars (format "[%s%s%s]" - message-replacement-char - message-replacement-char - message-replacement-char)) - (enc-word-re "=\\?\\([^?]+\\)\\?\\([QB]\\)\\?\\([^?]+\\)\\(\\?=\\)") - cs-string - (have-marker - (with-temp-buffer - (insert subject) - (goto-char (point-min)) - (when (re-search-forward enc-word-re nil t) - (setq cs-string (match-string 1))))) - cs-coding q-or-b word-beg word-end) - (if (or (not have-marker) ;; No encoded word found... - ;; ... or double encoding was correct: - (and (stringp cs-string) - (setq cs-string (downcase cs-string)) - (mm-coding-system-p (intern cs-string)) - (not (prog1 - (y-or-n-p - (format "\ -Decoded Subject \"%s\" -contains a valid encoded word. Decode again? " - subject)) - (setq cs-coding (intern cs-string)))))) - subject - (with-temp-buffer - (insert subject) - (goto-char (point-min)) - (while (re-search-forward enc-word-re nil t) - (setq cs-string (downcase (match-string 1)) - q-or-b (match-string 2) - word-beg (match-beginning 0) - word-end (match-end 0)) - (setq cs-coding - (if (mm-coding-system-p (intern cs-string)) - (setq cs-coding (intern cs-string)) - nil)) - ;; No double encoded subject? => bogus charset. - (unless cs-coding - (setq cs-coding - (mm-read-coding-system - (format "\ -Decoded Subject \"%s\" -contains an encoded word. The charset `%s' is unknown or invalid. -Hit RET to replace non-decodable characters with \"%s\" or enter replacement -charset: " - subject cs-string message-replacement-char))) - (if cs-coding - (replace-match (concat "=?" (symbol-name cs-coding) - "?\\2?\\3\\4\\5")) - (save-excursion - (goto-char word-beg) - (re-search-forward "=\\?\\([^?]+\\)\\?\\([QB]\\)\\?" word-end t) - (replace-match "") - ;; QP or base64 - (if (string-match "\\`Q\\'" q-or-b) - ;; QP - (progn - (message "Replacing non-decodable characters with \"%s\"." - message-replacement-char) - (while (re-search-forward "\\(=[A-F0-9][A-F0-9]\\)+" - word-end t) - (replace-match message-replacement-char))) - ;; base64 - (message "Replacing non-decodable characters with \"%s\"." - replacement-chars) - (re-search-forward "[^?]+" word-end t) - (replace-match replacement-chars)) - (re-search-forward "\\?=") - (replace-match ""))))) - (rfc2047-decode-region (point-min) (point-max)) - (buffer-string))))) - -;;; Start of functions adopted from `message-utils.el'. - -(defun message-strip-subject-trailing-was (subject) - "Remove trailing \"(was: )\" from SUBJECT lines. -Leading \"Re: \" is not stripped by this function. Use the function -`message-strip-subject-re' for this." - (let* ((query message-subject-trailing-was-query) - (new) (found)) - (setq found - (string-match - (if (eq query 'ask) - message-subject-trailing-was-ask-regexp - message-subject-trailing-was-regexp) - subject)) - (if found - (setq new (substring subject 0 (match-beginning 0)))) - (if (or (not found) (eq query nil)) - subject - (if (eq query 'ask) - (if (message-y-or-n-p - "Strip `(was: )' in subject? " t - (concat - "Strip `(was: )' in subject " - "and use the new one instead?\n\n" - "Current subject is: \"" - subject "\"\n\n" - "New subject would be: \"" - new "\"\n\n" - "See the variable `message-subject-trailing-was-query' " - "to get rid of this query." - )) - new subject) - new)))) - -;;; Suggested by Jonas Steverud @ www.dtek.chalmers.se/~d4jonas/ - -(defun message-change-subject (new-subject) - "Ask for NEW-SUBJECT header, append (was: )." - ;; - (interactive - (list - (read-from-minibuffer "New subject: "))) - (cond ((and (not (or (null new-subject) ; new subject not empty - (zerop (string-width new-subject)) - (string-match "^[ \t]*$" new-subject)))) - (save-excursion - (let ((old-subject - (save-restriction - (message-narrow-to-headers) - (message-fetch-field "Subject")))) - (cond ((not old-subject) - (error "No current subject")) - ((not (string-match - (concat "^[ \t]*" - (regexp-quote new-subject) - " \t]*$") - old-subject)) ; yes, it really is a new subject - ;; delete eventual Re: prefix - (setq old-subject - (message-strip-subject-re old-subject)) - (message-goto-subject) - (message-delete-line) - (insert (concat "Subject: " - new-subject - " (was: " - old-subject ")\n"))))))))) - -(defun message-mark-inserted-region (beg end) - "Mark some region in the current article with enclosing tags. -See `message-mark-insert-begin' and `message-mark-insert-end'." - (interactive "r") - (save-excursion - ;; add to the end of the region first, otherwise end would be invalid - (goto-char end) - (insert message-mark-insert-end) - (goto-char beg) - (insert message-mark-insert-begin))) - -(defun message-mark-insert-file (file) - "Insert FILE at point, marking it with enclosing tags. -See `message-mark-insert-begin' and `message-mark-insert-end'." - (interactive "fFile to insert: ") - ;; reverse insertion to get correct result. - (let ((p (point))) - (insert message-mark-insert-end) - (goto-char p) - (insert-file-contents file) - (goto-char p) - (insert message-mark-insert-begin))) - -(defun message-add-archive-header () - "Insert \"X-No-Archive: Yes\" in the header and a note in the body. -The note can be customized using `message-archive-note'. When called with a -prefix argument, ask for a text to insert. If you don't want the note in the -body, set `message-archive-note' to nil." - (interactive) - (if current-prefix-arg - (setq message-archive-note - (read-from-minibuffer "Reason for No-Archive: " - (cons message-archive-note 0)))) - (save-excursion - (if (message-goto-signature) - (re-search-backward message-signature-separator)) - (when message-archive-note - (insert message-archive-note) - (newline)) - (message-add-header message-archive-header) - (message-sort-headers))) - -(defun message-cross-post-followup-to-header (target-group) - "Mangles FollowUp-To and Newsgroups header to point to TARGET-GROUP. -With prefix-argument just set Follow-Up, don't cross-post." - (interactive - (list ; Completion based on Gnus - (completing-read "Followup To: " - (if (boundp 'gnus-newsrc-alist) - gnus-newsrc-alist) - nil nil '("poster" . 0) - (if (boundp 'gnus-group-history) - 'gnus-group-history)))) - (message-remove-header "Follow[Uu]p-[Tt]o" t) - (message-goto-newsgroups) - (beginning-of-line) - ;; if we already did a crosspost before, kill old target - (if (and message-cross-post-old-target - (re-search-forward - (regexp-quote (concat "," message-cross-post-old-target)) - nil t)) - (replace-match "")) - ;; unless (followup is to poster or user explicitly asked not - ;; to cross-post, or target-group is already in Newsgroups) - ;; add target-group to Newsgroups line. - (cond ((and (or - ;; def: cross-post, req:no - (and message-cross-post-default (not current-prefix-arg)) - ;; def: no-cross-post, req:yes - (and (not message-cross-post-default) current-prefix-arg)) - (not (string-match "poster" target-group)) - (not (string-match (regexp-quote target-group) - (message-fetch-field "Newsgroups")))) - (end-of-line) - (insert (concat "," target-group)))) - (end-of-line) ; ensure Followup: comes after Newsgroups: - ;; unless new followup would be identical to Newsgroups line - ;; make a new Followup-To line - (if (not (string-match (concat "^[ \t]*" - target-group - "[ \t]*$") - (message-fetch-field "Newsgroups"))) - (insert (concat "\nFollowup-To: " target-group))) - (setq message-cross-post-old-target target-group)) - -(defun message-cross-post-insert-note (target-group cross-post in-old - old-groups) - "Insert a in message body note about a set Followup or Crosspost. -If there have been previous notes, delete them. TARGET-GROUP specifies the -group to Followup-To. When CROSS-POST is t, insert note about -crossposting. IN-OLD specifies whether TARGET-GROUP is a member of -OLD-GROUPS. OLD-GROUPS lists the old-groups the posting would have -been made to before the user asked for a Crosspost." - ;; start scanning body for previous uses - (message-goto-signature) - (let ((head (re-search-backward - (concat "^" mail-header-separator) - nil t))) ; just search in body - (message-goto-signature) - (while (re-search-backward - (concat "^" (regexp-quote message-cross-post-note) ".*") - head t) - (message-delete-line)) - (message-goto-signature) - (while (re-search-backward - (concat "^" (regexp-quote message-followup-to-note) ".*") - head t) - (message-delete-line)) - ;; insert new note - (if (message-goto-signature) - (re-search-backward message-signature-separator)) - (if (or in-old - (not cross-post) - (string-match "^[ \t]*poster[ \t]*$" target-group)) - (insert (concat message-followup-to-note target-group "\n")) - (insert (concat message-cross-post-note target-group "\n"))))) - -(defun message-cross-post-followup-to (target-group) - "Crossposts message and set Followup-To to TARGET-GROUP. -With prefix-argument just set Follow-Up, don't cross-post." - (interactive - (list ; Completion based on Gnus - (completing-read "Followup To: " - (if (boundp 'gnus-newsrc-alist) - gnus-newsrc-alist) - nil nil '("poster" . 0) - (if (boundp 'gnus-group-history) - 'gnus-group-history)))) - (cond ((not (or (null target-group) ; new subject not empty - (zerop (string-width target-group)) - (string-match "^[ \t]*$" target-group))) - (save-excursion - (let* ((old-groups (message-fetch-field "Newsgroups")) - (in-old (string-match - (regexp-quote target-group) - (or old-groups "")))) - ;; check whether target exactly matches old Newsgroups - (cond ((not old-groups) - (error "No current newsgroup")) - ((or (not in-old) - (not (string-match - (concat "^[ \t]*" - (regexp-quote target-group) - "[ \t]*$") - old-groups))) - ;; yes, Newsgroups line must change - (message-cross-post-followup-to-header target-group) - ;; insert note whether we do cross-post or followup-to - (funcall message-cross-post-note-function - target-group - (if (or (and message-cross-post-default - (not current-prefix-arg)) - (and (not message-cross-post-default) - current-prefix-arg)) t) - in-old old-groups)))))))) - -;;; Reduce To: to Cc: or Bcc: header - -(defun message-reduce-to-to-cc () - "Replace contents of To: header with contents of Cc: or Bcc: header." - (interactive) - (let ((cc-content - (save-restriction (message-narrow-to-headers) - (message-fetch-field "cc"))) - (bcc nil)) - (if (and (not cc-content) - (setq cc-content - (save-restriction - (message-narrow-to-headers) - (message-fetch-field "bcc")))) - (setq bcc t)) - (cond (cc-content - (save-excursion - (message-goto-to) - (message-delete-line) - (insert (concat "To: " cc-content "\n")) - (save-restriction - (message-narrow-to-headers) - (message-remove-header (if bcc - "bcc" - "cc")))))))) - -;;; End of functions adopted from `message-utils.el'. - -(defun message-remove-header (header &optional is-regexp first reverse) - "Remove HEADER in the narrowed buffer. -If IS-REGEXP, HEADER is a regular expression. -If FIRST, only remove the first instance of the header. -Return the number of headers removed." - (goto-char (point-min)) - (let ((regexp (if is-regexp header (concat "^" (regexp-quote header) ":"))) - (number 0) - (case-fold-search t) - last) - (while (and (not (eobp)) - (not last)) - (if (if reverse - (not (looking-at regexp)) - (looking-at regexp)) - (progn - (incf number) - (when first - (setq last t)) - (delete-region - (point) - ;; There might be a continuation header, so we have to search - ;; until we find a new non-continuation line. - (progn - (forward-line 1) - (if (re-search-forward "^[^ \t]" nil t) - (goto-char (match-beginning 0)) - (point-max))))) - (forward-line 1) - (if (re-search-forward "^[^ \t]" nil t) - (goto-char (match-beginning 0)) - (goto-char (point-max))))) - number)) - -(defun message-remove-first-header (header) - "Remove the first instance of HEADER if there is more than one." - (let ((count 0) - (regexp (concat "^" (regexp-quote header) ":"))) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward regexp nil t) - (incf count))) - (while (> count 1) - (message-remove-header header nil t) - (decf count)))) - -(defun message-narrow-to-headers () - "Narrow the buffer to the head of the message." - (widen) - (narrow-to-region - (goto-char (point-min)) - (if (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "\n") nil t) - (match-beginning 0) - (point-max))) - (goto-char (point-min))) - -(defun message-narrow-to-head-1 () - "Like `message-narrow-to-head'. Don't widen." - (narrow-to-region - (goto-char (point-min)) - (if (search-forward "\n\n" nil 1) - (1- (point)) - (point-max))) - (goto-char (point-min))) - -(defun message-narrow-to-head () - "Narrow the buffer to the head of the message. -Point is left at the beginning of the narrowed-to region." - (widen) - (message-narrow-to-head-1)) - -(defun message-narrow-to-headers-or-head () - "Narrow the buffer to the head of the message." - (widen) - (narrow-to-region - (goto-char (point-min)) - (if (re-search-forward (concat "\\(\n\\)\n\\|^\\(" - (regexp-quote mail-header-separator) - "\n\\)") - nil t) - (or (match-end 1) (match-beginning 2)) - (point-max))) - (goto-char (point-min))) - -(defun message-news-p () - "Say whether the current buffer contains a news message." - (and (not message-this-is-mail) - (or message-this-is-news - (save-excursion - (save-restriction - (message-narrow-to-headers) - (and (message-fetch-field "newsgroups") - (not (message-fetch-field "posted-to")))))))) - -(defun message-mail-p () - "Say whether the current buffer contains a mail message." - (and (not message-this-is-news) - (or message-this-is-mail - (save-excursion - (save-restriction - (message-narrow-to-headers) - (or (message-fetch-field "to") - (message-fetch-field "cc") - (message-fetch-field "bcc"))))))) - -(defun message-subscribed-p () - "Say whether we need to insert a MFT header." - (or message-subscribed-regexps - message-subscribed-addresses - message-subscribed-address-file - message-subscribed-address-functions)) - -(defun message-next-header () - "Go to the beginning of the next header." - (beginning-of-line) - (or (eobp) (forward-char 1)) - (not (if (re-search-forward "^[^ \t]" nil t) - (beginning-of-line) - (goto-char (point-max))))) - -(defun message-sort-headers-1 () - "Sort the buffer as headers using `message-rank' text props." - (goto-char (point-min)) - (require 'sort) - (sort-subr - nil 'message-next-header - (lambda () - (message-next-header) - (unless (bobp) - (forward-char -1))) - (lambda () - (or (get-text-property (point) 'message-rank) - 10000)))) - -(defun message-sort-headers () - "Sort the headers of the current message according to `message-header-format-alist'." - (interactive) - (save-excursion - (save-restriction - (let ((max (1+ (length message-header-format-alist))) - rank) - (message-narrow-to-headers) - (while (re-search-forward "^[^ \n]+:" nil t) - (put-text-property - (match-beginning 0) (1+ (match-beginning 0)) - 'message-rank - (if (setq rank (length (memq (assq (intern (buffer-substring - (match-beginning 0) - (1- (match-end 0)))) - message-header-format-alist) - message-header-format-alist))) - (- max rank) - (1+ max))))) - (message-sort-headers-1)))) - -(defun message-info (&optional arg) - "Display the Message manual. - -Prefixed with one \\[universal-argument], display the Emacs MIME manual. -Prefixed with two \\[universal-argument]'s, display the PGG manual." - (interactive "p") - (cond ((eq arg 16) (Info-goto-node "(pgg)Top")) - ((eq arg 4) (Info-goto-node "(emacs-mime)Top")) - (t (Info-goto-node "(message)Top")))) - - - -;;; -;;; Message mode -;;; - -;;; Set up keymap. - -(defvar message-mode-map nil) - -(unless message-mode-map - (setq message-mode-map (make-keymap)) - (set-keymap-parent message-mode-map text-mode-map) - (define-key message-mode-map "\C-c?" 'describe-mode) - - (define-key message-mode-map "\C-c\C-f\C-t" 'message-goto-to) - (define-key message-mode-map "\C-c\C-f\C-o" 'message-goto-from) - (define-key message-mode-map "\C-c\C-f\C-b" 'message-goto-bcc) - (define-key message-mode-map "\C-c\C-f\C-w" 'message-goto-fcc) - (define-key message-mode-map "\C-c\C-f\C-c" 'message-goto-cc) - (define-key message-mode-map "\C-c\C-f\C-s" 'message-goto-subject) - (define-key message-mode-map "\C-c\C-f\C-r" 'message-goto-reply-to) - (define-key message-mode-map "\C-c\C-f\C-n" 'message-goto-newsgroups) - (define-key message-mode-map "\C-c\C-f\C-d" 'message-goto-distribution) - (define-key message-mode-map "\C-c\C-f\C-f" 'message-goto-followup-to) - (define-key message-mode-map "\C-c\C-f\C-m" 'message-goto-mail-followup-to) - (define-key message-mode-map "\C-c\C-f\C-k" 'message-goto-keywords) - (define-key message-mode-map "\C-c\C-f\C-u" 'message-goto-summary) - (define-key message-mode-map "\C-c\C-f\C-i" - 'message-insert-or-toggle-importance) - (define-key message-mode-map "\C-c\C-f\C-a" - 'message-generate-unsubscribed-mail-followup-to) - - ;; modify headers (and insert notes in body) - (define-key message-mode-map "\C-c\C-fs" 'message-change-subject) - ;; - (define-key message-mode-map "\C-c\C-fx" 'message-cross-post-followup-to) - ;; prefix+message-cross-post-followup-to = same w/o cross-post - (define-key message-mode-map "\C-c\C-ft" 'message-reduce-to-to-cc) - (define-key message-mode-map "\C-c\C-fa" 'message-add-archive-header) - ;; mark inserted text - (define-key message-mode-map "\C-c\M-m" 'message-mark-inserted-region) - (define-key message-mode-map "\C-c\M-f" 'message-mark-insert-file) - - (define-key message-mode-map "\C-c\C-b" 'message-goto-body) - (define-key message-mode-map "\C-c\C-i" 'message-goto-signature) - - (define-key message-mode-map "\C-c\C-t" 'message-insert-to) - (define-key message-mode-map "\C-c\C-fw" 'message-insert-wide-reply) - (define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups) - (define-key message-mode-map "\C-c\C-l" 'message-to-list-only) - - (define-key message-mode-map "\C-c\C-u" 'message-insert-or-toggle-importance) - (define-key message-mode-map "\C-c\M-n" - 'message-insert-disposition-notification-to) - - (define-key message-mode-map "\C-c\C-y" 'message-yank-original) - (define-key message-mode-map "\C-c\M-\C-y" 'message-yank-buffer) - (define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message) - (define-key message-mode-map "\C-c\C-w" 'message-insert-signature) - (define-key message-mode-map "\C-c\M-h" 'message-insert-headers) - (define-key message-mode-map "\C-c\C-r" 'message-caesar-buffer-body) - (define-key message-mode-map "\C-c\C-o" 'message-sort-headers) - (define-key message-mode-map "\C-c\M-r" 'message-rename-buffer) - - (define-key message-mode-map "\C-c\C-c" 'message-send-and-exit) - (define-key message-mode-map "\C-c\C-s" 'message-send) - (define-key message-mode-map "\C-c\C-k" 'message-kill-buffer) - (define-key message-mode-map "\C-c\C-d" 'message-dont-send) - (define-key message-mode-map "\C-c\n" 'gnus-delay-article) - - (define-key message-mode-map "\C-c\C-e" 'message-elide-region) - (define-key message-mode-map "\C-c\C-v" 'message-delete-not-region) - (define-key message-mode-map "\C-c\C-z" 'message-kill-to-signature) - (define-key message-mode-map "\M-\r" 'message-newline-and-reformat) - ;;(define-key message-mode-map "\M-q" 'message-fill-paragraph) - (define-key message-mode-map [remap split-line] 'message-split-line) - - (define-key message-mode-map "\C-c\C-a" 'mml-attach-file) - - (define-key message-mode-map "\C-a" 'message-beginning-of-line) - (define-key message-mode-map "\t" 'message-tab) - (define-key message-mode-map "\M-;" 'comment-region)) - -(easy-menu-define - message-mode-menu message-mode-map "Message Menu." - `("Message" - ["Yank Original" message-yank-original message-reply-buffer] - ["Fill Yanked Message" message-fill-yanked-message t] - ["Insert Signature" message-insert-signature t] - ["Caesar (rot13) Message" message-caesar-buffer-body t] - ["Caesar (rot13) Region" message-caesar-region (message-mark-active-p)] - ["Elide Region" message-elide-region - :active (message-mark-active-p) - ,@(if (featurep 'xemacs) nil - '(:help "Replace text in region with an ellipsis"))] - ["Delete Outside Region" message-delete-not-region - :active (message-mark-active-p) - ,@(if (featurep 'xemacs) nil - '(:help "Delete all quoted text outside region"))] - ["Kill To Signature" message-kill-to-signature t] - ["Newline and Reformat" message-newline-and-reformat t] - ["Rename buffer" message-rename-buffer t] - ["Spellcheck" ispell-message - ,@(if (featurep 'xemacs) '(t) - '(:help "Spellcheck this message"))] - "----" - ["Insert Region Marked" message-mark-inserted-region - :active (message-mark-active-p) - ,@(if (featurep 'xemacs) nil - '(:help "Mark region with enclosing tags"))] - ["Insert File Marked..." message-mark-insert-file - ,@(if (featurep 'xemacs) '(t) - '(:help "Insert file at point marked with enclosing tags"))] - "----" - ["Send Message" message-send-and-exit - ,@(if (featurep 'xemacs) '(t) - '(:help "Send this message"))] - ["Postpone Message" message-dont-send - ,@(if (featurep 'xemacs) '(t) - '(:help "File this draft message and exit"))] - ["Send at Specific Time..." gnus-delay-article - ,@(if (featurep 'xemacs) '(t) - '(:help "Ask, then arrange to send message at that time"))] - ["Kill Message" message-kill-buffer - ,@(if (featurep 'xemacs) '(t) - '(:help "Delete this message without sending"))] - "----" - ["Message manual" message-info - ,@(if (featurep 'xemacs) '(t) - '(:help "Display the Message manual"))])) - -(easy-menu-define - message-mode-field-menu message-mode-map "" - `("Field" - ["To" message-goto-to t] - ["From" message-goto-from t] - ["Subject" message-goto-subject t] - ["Change subject..." message-change-subject t] - ["Cc" message-goto-cc t] - ["Bcc" message-goto-bcc t] - ["Fcc" message-goto-fcc t] - ["Reply-To" message-goto-reply-to t] - ["Flag As Important" message-insert-importance-high - ,@(if (featurep 'xemacs) '(t) - '(:help "Mark this message as important"))] - ["Flag As Unimportant" message-insert-importance-low - ,@(if (featurep 'xemacs) '(t) - '(:help "Mark this message as unimportant"))] - ["Request Receipt" - message-insert-disposition-notification-to - ,@(if (featurep 'xemacs) '(t) - '(:help "Request a receipt notification"))] - "----" - ;; (typical) news stuff - ["Summary" message-goto-summary t] - ["Keywords" message-goto-keywords t] - ["Newsgroups" message-goto-newsgroups t] - ["Fetch Newsgroups" message-insert-newsgroups t] - ["Followup-To" message-goto-followup-to t] - ;; ["Followup-To (with note in body)" message-cross-post-followup-to t] - ["Crosspost / Followup-To..." message-cross-post-followup-to t] - ["Distribution" message-goto-distribution t] - ["X-No-Archive:" message-add-archive-header t ] - "----" - ;; (typical) mailing-lists stuff - ["Fetch To" message-insert-to - ,@(if (featurep 'xemacs) '(t) - '(:help "Insert a To header that points to the author."))] - ["Fetch To and Cc" message-insert-wide-reply - ,@(if (featurep 'xemacs) '(t) - '(:help - "Insert To and Cc headers as if you were doing a wide reply."))] - "----" - ["Send to list only" message-to-list-only t] - ["Mail-Followup-To" message-goto-mail-followup-to t] - ["Unsubscribed list post" message-generate-unsubscribed-mail-followup-to - ,@(if (featurep 'xemacs) '(t) - '(:help "Insert a reasonable `Mail-Followup-To:' header."))] - ["Reduce To: to Cc:" message-reduce-to-to-cc t] - "----" - ["Sort Headers" message-sort-headers t] - ["Encode non-ASCII domain names" message-idna-to-ascii-rhs t] - ["Goto Body" message-goto-body t] - ["Goto Signature" message-goto-signature t])) - -(defvar message-tool-bar-map nil) - -(eval-when-compile - (defvar facemenu-add-face-function) - (defvar facemenu-remove-face-function)) - -;;; Forbidden properties -;; -;; We use `after-change-functions' to keep special text properties -;; that interfer with the normal function of message mode out of the -;; buffer. - -(defcustom message-strip-special-text-properties t - "Strip special properties from the message buffer. - -Emacs has a number of special text properties which can break message -composing in various ways. If this option is set, message will strip -these properties from the message composition buffer. However, some -packages requires these properties to be present in order to work. -If you use one of these packages, turn this option off, and hope the -message composition doesn't break too bad." - :version "22.1" - :group 'message-various - :link '(custom-manual "(message)Various Message Variables") - :type 'boolean) - -(defconst message-forbidden-properties - ;; No reason this should be clutter up customize. We make it a - ;; property list (rather than a list of property symbols), to be - ;; directly useful for `remove-text-properties'. - '(field nil read-only nil invisible nil intangible nil - mouse-face nil modification-hooks nil insert-in-front-hooks nil - insert-behind-hooks nil point-entered nil point-left nil) - ;; Other special properties: - ;; category, face, display: probably doesn't do any harm. - ;; fontified: is used by font-lock. - ;; syntax-table, local-map: I dunno. - ;; We need to add XEmacs names to the list. - "Property list of with properties forbidden in message buffers. -The values of the properties are ignored, only the property names are used.") - -(defun message-tamago-not-in-use-p (pos) - "Return t when tamago version 4 is not in use at the cursor position. -Tamago version 4 is a popular input method for writing Japanese text. -It uses the properties `intangible', `invisible', `modification-hooks' -and `read-only' when translating ascii or kana text to kanji text. -These properties are essential to work, so we should never strip them." - (not (and (boundp 'egg-modefull-mode) - (symbol-value 'egg-modefull-mode) - (or (memq (get-text-property pos 'intangible) - '(its-part-1 its-part-2)) - (get-text-property pos 'egg-end) - (get-text-property pos 'egg-lang) - (get-text-property pos 'egg-start))))) - -(defun message-strip-forbidden-properties (begin end &optional old-length) - "Strip forbidden properties between BEGIN and END, ignoring the third arg. -This function is intended to be called from `after-change-functions'. -See also `message-forbidden-properties'." - (when (and message-strip-special-text-properties - (message-tamago-not-in-use-p begin)) - (let ((buffer-read-only nil) - (inhibit-read-only t)) - (while (not (= begin end)) - (when (not (get-text-property begin 'message-hidden)) - (remove-text-properties begin (1+ begin) - message-forbidden-properties)) - (incf begin))))) - -;;;###autoload -(define-derived-mode message-mode text-mode "Message" - "Major mode for editing mail and news to be sent. -Like Text Mode but with these additional commands:\\ -C-c C-s `message-send' (send the message) C-c C-c `message-send-and-exit' -C-c C-d Postpone sending the message C-c C-k Kill the message -C-c C-f move to a header field (and create it if there isn't): - C-c C-f C-t move to To C-c C-f C-s move to Subject - C-c C-f C-c move to Cc C-c C-f C-b move to Bcc - C-c C-f C-w move to Fcc C-c C-f C-r move to Reply-To - C-c C-f C-u move to Summary C-c C-f C-n move to Newsgroups - C-c C-f C-k move to Keywords C-c C-f C-d move to Distribution - C-c C-f C-o move to From (\"Originator\") - C-c C-f C-f move to Followup-To - C-c C-f C-m move to Mail-Followup-To - C-c C-f C-i cycle through Importance values - C-c C-f s change subject and append \"(was: )\" - C-c C-f x crossposting with FollowUp-To header and note in body - C-c C-f t replace To: header with contents of Cc: or Bcc: - C-c C-f a Insert X-No-Archive: header and a note in the body -C-c C-t `message-insert-to' (add a To header to a news followup) -C-c C-l `message-to-list-only' (removes all but list address in to/cc) -C-c C-n `message-insert-newsgroups' (add a Newsgroup header to a news reply) -C-c C-b `message-goto-body' (move to beginning of message text). -C-c C-i `message-goto-signature' (move to the beginning of the signature). -C-c C-w `message-insert-signature' (insert `message-signature-file' file). -C-c C-y `message-yank-original' (insert current message, if any). -C-c C-q `message-fill-yanked-message' (fill what was yanked). -C-c C-e `message-elide-region' (elide the text between point and mark). -C-c C-v `message-delete-not-region' (remove the text outside the region). -C-c C-z `message-kill-to-signature' (kill the text up to the signature). -C-c C-r `message-caesar-buffer-body' (rot13 the message body). -C-c C-a `mml-attach-file' (attach a file as MIME). -C-c C-u `message-insert-or-toggle-importance' (insert or cycle importance). -C-c M-n `message-insert-disposition-notification-to' (request receipt). -C-c M-m `message-mark-inserted-region' (mark region with enclosing tags). -C-c M-f `message-mark-insert-file' (insert file marked with enclosing tags). -M-RET `message-newline-and-reformat' (break the line and reformat)." - (setq local-abbrev-table text-mode-abbrev-table) - (set (make-local-variable 'message-reply-buffer) nil) - (set (make-local-variable 'message-inserted-headers) nil) - (set (make-local-variable 'message-send-actions) nil) - (set (make-local-variable 'message-exit-actions) nil) - (set (make-local-variable 'message-kill-actions) nil) - (set (make-local-variable 'message-postpone-actions) nil) - (set (make-local-variable 'message-draft-article) nil) - (setq buffer-offer-save t) - (set (make-local-variable 'facemenu-add-face-function) - (lambda (face end) - (let ((face-fun (cdr (assq face message-face-alist)))) - (if face-fun - (funcall face-fun (point) end) - (error "Face %s not configured for %s mode" face mode-name))) - "")) - (set (make-local-variable 'facemenu-remove-face-function) t) - (set (make-local-variable 'message-reply-headers) nil) - (make-local-variable 'message-newsreader) - (make-local-variable 'message-mailer) - (make-local-variable 'message-post-method) - (set (make-local-variable 'message-sent-message-via) nil) - (set (make-local-variable 'message-checksum) nil) - (set (make-local-variable 'message-mime-part) 0) - (message-setup-fill-variables) - ;; Allow using comment commands to add/remove quoting. - ;; (set (make-local-variable 'comment-start) message-yank-prefix) - (when message-yank-prefix - (set (make-local-variable 'comment-start) message-yank-prefix) - (set (make-local-variable 'comment-start-skip) - (concat "^" (regexp-quote message-yank-prefix) "[ \t]*"))) - (if (featurep 'xemacs) - (message-setup-toolbar) - (set (make-local-variable 'font-lock-defaults) - '(message-font-lock-keywords t)) - (if (boundp 'tool-bar-map) - (set (make-local-variable 'tool-bar-map) (message-make-tool-bar)))) - (easy-menu-add message-mode-menu message-mode-map) - (easy-menu-add message-mode-field-menu message-mode-map) - (gnus-make-local-hook 'after-change-functions) - ;; Mmmm... Forbidden properties... - (add-hook 'after-change-functions 'message-strip-forbidden-properties - nil 'local) - ;; Allow mail alias things. - (when (eq message-mail-alias-type 'abbrev) - (if (fboundp 'mail-abbrevs-setup) - (mail-abbrevs-setup) - (if (fboundp 'mail-aliases-setup) ; warning avoidance - (mail-aliases-setup)))) - (unless buffer-file-name - (message-set-auto-save-file-name)) - (unless (buffer-base-buffer) - ;; Don't enable multibyte on an indirect buffer. Maybe enabling - ;; multibyte is not necessary at all. -- zsh - (mm-enable-multibyte)) - (set (make-local-variable 'indent-tabs-mode) nil) ;No tabs for indentation. - (mml-mode)) - -(defun message-setup-fill-variables () - "Setup message fill variables." - (set (make-local-variable 'fill-paragraph-function) - 'message-fill-paragraph) - (make-local-variable 'paragraph-separate) - (make-local-variable 'paragraph-start) - (make-local-variable 'adaptive-fill-regexp) - (unless (boundp 'adaptive-fill-first-line-regexp) - (setq adaptive-fill-first-line-regexp nil)) - (make-local-variable 'adaptive-fill-first-line-regexp) - (let ((quote-prefix-regexp - ;; User should change message-cite-prefix-regexp if - ;; message-yank-prefix is set to an abnormal value. - (concat "\\(" message-cite-prefix-regexp "\\)[ \t]*"))) - (setq paragraph-start - (concat - (regexp-quote mail-header-separator) "$\\|" - "[ \t]*$\\|" ; blank lines - "-- $\\|" ; signature delimiter - "---+$\\|" ; delimiters for forwarded messages - page-delimiter "$\\|" ; spoiler warnings - ".*wrote:$\\|" ; attribution lines - quote-prefix-regexp "$\\|" ; empty lines in quoted text - ; mml tags - "<#!*/?\\(multipart\\|part\\|external\\|mml\\|secure\\)")) - (setq paragraph-separate paragraph-start) - (setq adaptive-fill-regexp - (concat quote-prefix-regexp "\\|" adaptive-fill-regexp)) - (setq adaptive-fill-first-line-regexp - (concat quote-prefix-regexp "\\|" - adaptive-fill-first-line-regexp))) - (make-local-variable 'auto-fill-inhibit-regexp) - ;;(setq auto-fill-inhibit-regexp "^[A-Z][^: \n\t]+:") - (setq auto-fill-inhibit-regexp nil) - (make-local-variable 'normal-auto-fill-function) - (setq normal-auto-fill-function 'message-do-auto-fill) - ;; KLUDGE: auto fill might already be turned on in `text-mode-hook'. - ;; In that case, ensure that it uses the right function. The real - ;; solution would be not to use `define-derived-mode', and run - ;; `text-mode-hook' ourself at the end of the mode. - ;; -- Per Abrahamsen Date: 2001-10-19. - (when auto-fill-function - (setq auto-fill-function normal-auto-fill-function))) - - - -;;; -;;; Message mode commands -;;; - -;;; Movement commands - -(defun message-goto-to () - "Move point to the To header." - (interactive) - (message-position-on-field "To")) - -(defun message-goto-from () - "Move point to the From header." - (interactive) - (message-position-on-field "From")) - -(defun message-goto-subject () - "Move point to the Subject header." - (interactive) - (message-position-on-field "Subject")) - -(defun message-goto-cc () - "Move point to the Cc header." - (interactive) - (message-position-on-field "Cc" "To")) - -(defun message-goto-bcc () - "Move point to the Bcc header." - (interactive) - (message-position-on-field "Bcc" "Cc" "To")) - -(defun message-goto-fcc () - "Move point to the Fcc header." - (interactive) - (message-position-on-field "Fcc" "To" "Newsgroups")) - -(defun message-goto-reply-to () - "Move point to the Reply-To header." - (interactive) - (message-position-on-field "Reply-To" "Subject")) - -(defun message-goto-newsgroups () - "Move point to the Newsgroups header." - (interactive) - (message-position-on-field "Newsgroups")) - -(defun message-goto-distribution () - "Move point to the Distribution header." - (interactive) - (message-position-on-field "Distribution")) - -(defun message-goto-followup-to () - "Move point to the Followup-To header." - (interactive) - (message-position-on-field "Followup-To" "Newsgroups")) - -(defun message-goto-mail-followup-to () - "Move point to the Mail-Followup-To header." - (interactive) - (message-position-on-field "Mail-Followup-To" "To")) - -(defun message-goto-keywords () - "Move point to the Keywords header." - (interactive) - (message-position-on-field "Keywords" "Subject")) - -(defun message-goto-summary () - "Move point to the Summary header." - (interactive) - (message-position-on-field "Summary" "Subject")) - -(defun message-goto-body (&optional interactivep) - "Move point to the beginning of the message body." - (interactive (list t)) - (when (and interactivep - (looking-at "[ \t]*\n")) - (expand-abbrev)) - (goto-char (point-min)) - (or (search-forward (concat "\n" mail-header-separator "\n") nil t) - (search-forward-regexp "[^:]+:\\([^\n]\\|\n[ \t]\\)+\n\n" nil t))) - -(defun message-in-body-p () - "Return t if point is in the message body." - (let ((body (save-excursion (message-goto-body) (point)))) - (>= (point) body))) - -(defun message-goto-eoh () - "Move point to the end of the headers." - (interactive) - (message-goto-body) - (forward-line -1)) - -(defun message-goto-signature () - "Move point to the beginning of the message signature. -If there is no signature in the article, go to the end and -return nil." - (interactive) - (goto-char (point-min)) - (if (re-search-forward message-signature-separator nil t) - (forward-line 1) - (goto-char (point-max)) - nil)) - -(defun message-generate-unsubscribed-mail-followup-to (&optional include-cc) - "Insert a reasonable MFT header in a post to an unsubscribed list. -When making original posts to a mailing list you are not subscribed to, -you have to type in a MFT header by hand. The contents, usually, are -the addresses of the list and your own address. This function inserts -such a header automatically. It fetches the contents of the To: header -in the current mail buffer, and appends the current `user-mail-address'. - -If the optional argument INCLUDE-CC is non-nil, the addresses in the -Cc: header are also put into the MFT." - - (interactive "P") - (let* (cc tos) - (save-restriction - (message-narrow-to-headers) - (message-remove-header "Mail-Followup-To") - (setq cc (and include-cc (message-fetch-field "Cc"))) - (setq tos (if cc - (concat (message-fetch-field "To") "," cc) - (message-fetch-field "To")))) - (message-goto-mail-followup-to) - (insert (concat tos ", " user-mail-address)))) - - - -(defun message-insert-to (&optional force) - "Insert a To header that points to the author of the article being replied to. -If the original author requested not to be sent mail, don't insert unless the -prefix FORCE is given." - (interactive "P") - (let* ((mct (message-fetch-reply-field "mail-copies-to")) - (dont (and mct (or (equal (downcase mct) "never") - (equal (downcase mct) "nobody")))) - (to (or (message-fetch-reply-field "mail-reply-to") - (message-fetch-reply-field "reply-to") - (message-fetch-reply-field "from")))) - (when (and dont to) - (message - (if force - "Ignoring the user request not to have copies sent via mail" - "Complying with the user request not to have copies sent via mail"))) - (when (and force (not to)) - (error "No mail address in the article")) - (when (and to (or force (not dont))) - (message-carefully-insert-headers (list (cons 'To to)))))) - -(defun message-insert-wide-reply () - "Insert To and Cc headers as if you were doing a wide reply." - (interactive) - (let ((headers (message-with-reply-buffer - (message-get-reply-headers t)))) - (message-carefully-insert-headers headers))) - -(defcustom message-header-synonyms - '((To Cc Bcc) - (Original-To)) - "List of lists of header synonyms. -E.g., if this list contains a member list with elements `Cc' and `To', -then `message-carefully-insert-headers' will not insert a `To' header -when the message is already `Cc'ed to the recipient." - :version "22.1" - :group 'message-headers - :link '(custom-manual "(message)Message Headers") - :type '(repeat sexp)) - -(defun message-carefully-insert-headers (headers) - "Insert the HEADERS, an alist, into the message buffer. -Does not insert the headers when they are already present there -or in the synonym headers, defined by `message-header-synonyms'." - ;; FIXME: Should compare only the address and not the full name. Comparison - ;; should be done case-folded (and with `string=' rather than - ;; `string-match'). - ;; (mail-strip-quoted-names "Foo Bar , bla@fasel (Bla Fasel)") - (dolist (header headers) - (let* ((header-name (symbol-name (car header))) - (new-header (cdr header)) - (synonyms (loop for synonym in message-header-synonyms - when (memq (car header) synonym) return synonym)) - (old-header - (loop for synonym in synonyms - for old-header = (mail-fetch-field (symbol-name synonym)) - when (and old-header (string-match new-header old-header)) - return synonym))) - (if old-header - (message "already have `%s' in `%s'" new-header old-header) - (when (and (message-position-on-field header-name) - (setq old-header (mail-fetch-field header-name)) - (not (string-match "\\` *\\'" old-header))) - (insert ", ")) - (insert new-header))))) - -(defun message-widen-reply () - "Widen the reply to include maximum recipients." - (interactive) - (let ((follow-to - (and message-reply-buffer - (buffer-name message-reply-buffer) - (save-excursion - (set-buffer message-reply-buffer) - (message-get-reply-headers t))))) - (save-excursion - (save-restriction - (message-narrow-to-headers) - (dolist (elem follow-to) - (message-remove-header (symbol-name (car elem))) - (goto-char (point-min)) - (insert (symbol-name (car elem)) ": " - (cdr elem) "\n")))))) - -(defun message-insert-newsgroups () - "Insert the Newsgroups header from the article being replied to." - (interactive) - (when (and (message-position-on-field "Newsgroups") - (mail-fetch-field "newsgroups") - (not (string-match "\\` *\\'" (mail-fetch-field "newsgroups")))) - (insert ",")) - (insert (or (message-fetch-reply-field "newsgroups") ""))) - - - -;;; Various commands - -(defun message-delete-not-region (beg end) - "Delete everything in the body of the current message outside of the region." - (interactive "r") - (let (citeprefix) - (save-excursion - (goto-char beg) - ;; snarf citation prefix, if appropriate - (unless (eq (point) (progn (beginning-of-line) (point))) - (when (looking-at message-cite-prefix-regexp) - (setq citeprefix (match-string 0)))) - (goto-char end) - (delete-region (point) (if (not (message-goto-signature)) - (point) - (forward-line -2) - (point))) - (insert "\n") - (goto-char beg) - (delete-region beg (progn (message-goto-body) - (forward-line 2) - (point))) - (when citeprefix - (insert citeprefix)))) - (when (message-goto-signature) - (forward-line -2))) - -(defun message-kill-to-signature () - "Deletes all text up to the signature." - (interactive) - (let ((point (point))) - (message-goto-signature) - (unless (eobp) - (end-of-line -1)) - (kill-region point (point)) - (unless (bolp) - (insert "\n")))) - -(defun message-newline-and-reformat (&optional arg not-break) - "Insert four newlines, and then reformat if inside quoted text. -Prefix arg means justify as well." - (interactive (list (if current-prefix-arg 'full))) - (let (quoted point beg end leading-space bolp) - (setq point (point)) - (beginning-of-line) - (setq beg (point)) - (setq bolp (= beg point)) - ;; Find first line of the paragraph. - (if not-break - (while (and (not (eobp)) - (not (looking-at message-cite-prefix-regexp)) - (looking-at paragraph-start)) - (forward-line 1))) - ;; Find the prefix - (when (looking-at message-cite-prefix-regexp) - (setq quoted (match-string 0)) - (goto-char (match-end 0)) - (looking-at "[ \t]*") - (setq leading-space (match-string 0))) - (if (and quoted - (not not-break) - (not bolp) - (< (- point beg) (length quoted))) - ;; break inside the cite prefix. - (setq quoted nil - end nil)) - (if quoted - (progn - (forward-line 1) - (while (and (not (eobp)) - (not (looking-at paragraph-separate)) - (looking-at message-cite-prefix-regexp) - (equal quoted (match-string 0))) - (goto-char (match-end 0)) - (looking-at "[ \t]*") - (if (> (length leading-space) (length (match-string 0))) - (setq leading-space (match-string 0))) - (forward-line 1)) - (setq end (point)) - (goto-char beg) - (while (and (if (bobp) nil (forward-line -1) t) - (not (looking-at paragraph-start)) - (looking-at message-cite-prefix-regexp) - (equal quoted (match-string 0))) - (setq beg (point)) - (goto-char (match-end 0)) - (looking-at "[ \t]*") - (if (> (length leading-space) (length (match-string 0))) - (setq leading-space (match-string 0))))) - (while (and (not (eobp)) - (not (looking-at paragraph-separate)) - (not (looking-at message-cite-prefix-regexp))) - (forward-line 1)) - (setq end (point)) - (goto-char beg) - (while (and (if (bobp) nil (forward-line -1) t) - (not (looking-at paragraph-start)) - (not (looking-at message-cite-prefix-regexp))) - (setq beg (point)))) - (goto-char point) - (save-restriction - (narrow-to-region beg end) - (if not-break - (setq point nil) - (if bolp - (newline) - (newline) - (newline)) - (setq point (point)) - ;; (newline 2) doesn't mark both newline's as hard, so call - ;; newline twice. -jas - (newline) - (newline) - (delete-region (point) (re-search-forward "[ \t]*")) - (when (and quoted (not bolp)) - (insert quoted leading-space))) - (undo-boundary) - (if quoted - (let* ((adaptive-fill-regexp - (regexp-quote (concat quoted leading-space))) - (adaptive-fill-first-line-regexp - adaptive-fill-regexp )) - (fill-paragraph arg)) - (fill-paragraph arg)) - (if point (goto-char point))))) - -(defun message-fill-paragraph (&optional arg) - "Like `fill-paragraph'." - (interactive (list (if current-prefix-arg 'full))) - (if (if (boundp 'filladapt-mode) filladapt-mode) - nil - (message-newline-and-reformat arg t) - t)) - -;; Is it better to use `mail-header-end'? -(defun message-point-in-header-p () - "Return t if point is in the header." - (save-excursion - (let ((p (point))) - (goto-char (point-min)) - (not (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "\n") - p t))))) - -(defun message-do-auto-fill () - "Like `do-auto-fill', but don't fill in message header." - (unless (message-point-in-header-p) - (do-auto-fill))) - -(defun message-insert-signature (&optional force) - "Insert a signature. See documentation for variable `message-signature'." - (interactive (list 0)) - (let* ((signature - (cond - ((and (null message-signature) - (eq force 0)) - (save-excursion - (goto-char (point-max)) - (not (re-search-backward message-signature-separator nil t)))) - ((and (null message-signature) - force) - t) - ((functionp message-signature) - (funcall message-signature)) - ((listp message-signature) - (eval message-signature)) - (t message-signature))) - (signature - (cond ((stringp signature) - signature) - ((and (eq t signature) - message-signature-file - (file-exists-p message-signature-file)) - signature)))) - (when signature - (goto-char (point-max)) - ;; Insert the signature. - (unless (bolp) - (insert "\n")) - (when message-signature-insert-empty-line - (insert "\n")) - (insert "-- \n") - (if (eq signature t) - (insert-file-contents message-signature-file) - (insert signature)) - (goto-char (point-max)) - (or (bolp) (insert "\n"))))) - -(defun message-insert-importance-high () - "Insert header to mark message as important." - (interactive) - (save-excursion - (save-restriction - (message-narrow-to-headers) - (message-remove-header "Importance")) - (message-goto-eoh) - (insert "Importance: high\n"))) - -(defun message-insert-importance-low () - "Insert header to mark message as unimportant." - (interactive) - (save-excursion - (save-restriction - (message-narrow-to-headers) - (message-remove-header "Importance")) - (message-goto-eoh) - (insert "Importance: low\n"))) - -(defun message-insert-or-toggle-importance () - "Insert a \"Importance: high\" header, or cycle through the header values. -The three allowed values according to RFC 1327 are `high', `normal' -and `low'." - (interactive) - (save-excursion - (let ((valid '("high" "normal" "low")) - (new "high") - cur) - (save-restriction - (message-narrow-to-headers) - (when (setq cur (message-fetch-field "Importance")) - (message-remove-header "Importance") - (setq new (cond ((string= cur "high") - "low") - ((string= cur "low") - "normal") - (t - "high"))))) - (message-goto-eoh) - (insert (format "Importance: %s\n" new))))) - -(defun message-insert-disposition-notification-to () - "Request a disposition notification (return receipt) to this message. -Note that this should not be used in newsgroups." - (interactive) - (save-excursion - (save-restriction - (message-narrow-to-headers) - (message-remove-header "Disposition-Notification-To")) - (message-goto-eoh) - (insert (format "Disposition-Notification-To: %s\n" - (or (message-field-value "Reply-to") - (message-field-value "From") - (message-make-from)))))) - -(defun message-elide-region (b e) - "Elide the text in the region. -An ellipsis (from `message-elide-ellipsis') will be inserted where the -text was killed." - (interactive "r") - (kill-region b e) - (insert message-elide-ellipsis)) - -(defvar message-caesar-translation-table nil) - -(defun message-caesar-region (b e &optional n) - "Caesar rotate region B to E by N, default 13, for decrypting netnews." - (interactive - (list - (min (point) (or (mark t) (point))) - (max (point) (or (mark t) (point))) - (when current-prefix-arg - (prefix-numeric-value current-prefix-arg)))) - - (setq n (if (numberp n) (mod n 26) 13)) ;canonize N - (unless (or (zerop n) ; no action needed for a rot of 0 - (= b e)) ; no region to rotate - ;; We build the table, if necessary. - (when (or (not message-caesar-translation-table) - (/= (aref message-caesar-translation-table ?a) (+ ?a n))) - (setq message-caesar-translation-table - (message-make-caesar-translation-table n))) - (translate-region b e message-caesar-translation-table))) - -(defun message-make-caesar-translation-table (n) - "Create a rot table with offset N." - (let ((i -1) - (table (make-string 256 0))) - (while (< (incf i) 256) - (aset table i i)) - (concat - (substring table 0 ?A) - (substring table (+ ?A n) (+ ?A n (- 26 n))) - (substring table ?A (+ ?A n)) - (substring table (+ ?A 26) ?a) - (substring table (+ ?a n) (+ ?a n (- 26 n))) - (substring table ?a (+ ?a n)) - (substring table (+ ?a 26) 255)))) - -(defun message-caesar-buffer-body (&optional rotnum) - "Caesar rotate all letters in the current buffer by 13 places. -Used to encode/decode possibly offensive messages (commonly in rec.humor). -With prefix arg, specifies the number of places to rotate each letter forward. -Mail and USENET news headers are not rotated." - (interactive (if current-prefix-arg - (list (prefix-numeric-value current-prefix-arg)) - (list nil))) - (save-excursion - (save-restriction - (when (message-goto-body) - (narrow-to-region (point) (point-max))) - (message-caesar-region (point-min) (point-max) rotnum)))) - -(defun message-pipe-buffer-body (program) - "Pipe the message body in the current buffer through PROGRAM." - (save-excursion - (save-restriction - (when (message-goto-body) - (narrow-to-region (point) (point-max))) - (shell-command-on-region - (point-min) (point-max) program nil t)))) - -(defun message-rename-buffer (&optional enter-string) - "Rename the *message* buffer to \"*message* RECIPIENT\". -If the function is run with a prefix, it will ask for a new buffer -name, rather than giving an automatic name." - (interactive "Pbuffer name: ") - (save-excursion - (save-restriction - (goto-char (point-min)) - (narrow-to-region (point) - (search-forward mail-header-separator nil 'end)) - (let* ((mail-to (or - (if (message-news-p) (message-fetch-field "Newsgroups") - (message-fetch-field "To")) - "")) - (mail-trimmed-to - (if (string-match "," mail-to) - (concat (substring mail-to 0 (match-beginning 0)) ", ...") - mail-to)) - (name-default (concat "*message* " mail-trimmed-to)) - (name (if enter-string - (read-string "New buffer name: " name-default) - name-default))) - (rename-buffer name t))))) - -(defun message-fill-yanked-message (&optional justifyp) - "Fill the paragraphs of a message yanked into this one. -Numeric argument means justify as well." - (interactive "P") - (save-excursion - (goto-char (point-min)) - (search-forward (concat "\n" mail-header-separator "\n") nil t) - (let ((fill-prefix message-yank-prefix)) - (fill-individual-paragraphs (point) (point-max) justifyp)))) - -(defun message-indent-citation () - "Modify text just inserted from a message to be cited. -The inserted text should be the region. -When this function returns, the region is again around the modified text. - -Normally, indent each nonblank line `message-indentation-spaces' spaces. -However, if `message-yank-prefix' is non-nil, insert that prefix on each line." - (let ((start (point))) - ;; Remove unwanted headers. - (when message-ignored-cited-headers - (let (all-removed) - (save-restriction - (narrow-to-region - (goto-char start) - (if (search-forward "\n\n" nil t) - (1- (point)) - (point))) - (message-remove-header message-ignored-cited-headers t) - (when (= (point-min) (point-max)) - (setq all-removed t)) - (goto-char (point-max))) - (if all-removed - (goto-char start) - (forward-line 1)))) - ;; Delete blank lines at the start of the buffer. - (while (and (point-min) - (eolp) - (not (eobp))) - (message-delete-line)) - ;; Delete blank lines at the end of the buffer. - (goto-char (point-max)) - (unless (eolp) - (insert "\n")) - (while (and (zerop (forward-line -1)) - (looking-at "$")) - (message-delete-line)) - ;; Do the indentation. - (if (null message-yank-prefix) - (indent-rigidly start (mark t) message-indentation-spaces) - (save-excursion - (goto-char start) - (while (< (point) (mark t)) - (if (or (looking-at ">") (looking-at "^$")) - (insert message-yank-cited-prefix) - (insert message-yank-prefix)) - (forward-line 1)))) - (goto-char start))) - -(defun message-yank-original (&optional arg) - "Insert the message being replied to, if any. -Puts point before the text and mark after. -Normally indents each nonblank line ARG spaces (default 3). However, -if `message-yank-prefix' is non-nil, insert that prefix on each line. - -This function uses `message-cite-function' to do the actual citing. - -Just \\[universal-argument] as argument means don't indent, insert no -prefix, and don't delete any headers." - (interactive "P") - (let ((modified (buffer-modified-p))) - (when (and message-reply-buffer - message-cite-function) - (delete-windows-on message-reply-buffer t) - (push-mark (save-excursion - (insert-buffer-substring message-reply-buffer) - (unless (bolp) - (insert ?\n)) - (point))) - (unless arg - (funcall message-cite-function) - (unless (eq (char-before (mark t)) ?\n) - (let ((pt (point))) - (goto-char (mark t)) - (insert-before-markers ?\n) - (goto-char pt)))) - (unless modified - (setq message-checksum (message-checksum)))))) - -(defun message-yank-buffer (buffer) - "Insert BUFFER into the current buffer and quote it." - (interactive "bYank buffer: ") - (let ((message-reply-buffer (get-buffer buffer))) - (save-window-excursion - (message-yank-original)))) - -(defun message-buffers () - "Return a list of active message buffers." - (let (buffers) - (save-excursion - (dolist (buffer (buffer-list t)) - (set-buffer buffer) - (when (and (eq major-mode 'message-mode) - (null message-sent-message-via)) - (push (buffer-name buffer) buffers)))) - (nreverse buffers))) - -(defun message-cite-original-without-signature () - "Cite function in the standard Message manner. -This function strips off the signature from the original message." - (let* ((start (point)) - (end (mark t)) - (functions - (when message-indent-citation-function - (if (listp message-indent-citation-function) - message-indent-citation-function - (list message-indent-citation-function)))) - ;; This function may be called by `gnus-summary-yank-message' and - ;; may insert a different article from the original. So, we will - ;; modify the value of `message-reply-headers' with that article. - (message-reply-headers - (save-restriction - (narrow-to-region start end) - (message-narrow-to-head-1) - (vector 0 - (or (message-fetch-field "subject") "none") - (or (message-fetch-field "from") "nobody") - (message-fetch-field "date") - (message-fetch-field "message-id" t) - (message-fetch-field "references") - 0 0 "")))) - (mml-quote-region start end) - ;; Allow undoing. - (undo-boundary) - (goto-char end) - (when (re-search-backward message-signature-separator start t) - ;; Also peel off any blank lines before the signature. - (forward-line -1) - (while (looking-at "^[ \t]*$") - (forward-line -1)) - (forward-line 1) - (delete-region (point) end) - (unless (search-backward "\n\n" start t) - ;; Insert a blank line if it is peeled off. - (insert "\n"))) - (goto-char start) - (while functions - (funcall (pop functions))) - (when message-citation-line-function - (unless (bolp) - (insert "\n")) - (funcall message-citation-line-function)))) - -(eval-when-compile (defvar mail-citation-hook)) ;Compiler directive -(defun message-cite-original () - "Cite function in the standard Message manner." - (if (and (boundp 'mail-citation-hook) - mail-citation-hook) - (run-hooks 'mail-citation-hook) - (let* ((start (point)) - (end (mark t)) - (functions - (when message-indent-citation-function - (if (listp message-indent-citation-function) - message-indent-citation-function - (list message-indent-citation-function)))) - ;; This function may be called by `gnus-summary-yank-message' and - ;; may insert a different article from the original. So, we will - ;; modify the value of `message-reply-headers' with that article. - (message-reply-headers - (save-restriction - (narrow-to-region start end) - (message-narrow-to-head-1) - (vector 0 - (or (message-fetch-field "subject") "none") - (or (message-fetch-field "from") "nobody") - (message-fetch-field "date") - (message-fetch-field "message-id" t) - (message-fetch-field "references") - 0 0 "")))) - (mml-quote-region start end) - (goto-char start) - (while functions - (funcall (pop functions))) - (when message-citation-line-function - (unless (bolp) - (insert "\n")) - (funcall message-citation-line-function))))) - -(defun message-insert-citation-line () - "Insert a simple citation line." - (when message-reply-headers - (insert (mail-header-from message-reply-headers) " writes:") - (newline) - (newline))) - -(defun message-position-on-field (header &rest afters) - (let ((case-fold-search t)) - (save-restriction - (narrow-to-region - (goto-char (point-min)) - (progn - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$")) - (match-beginning 0))) - (goto-char (point-min)) - (if (re-search-forward (concat "^" (regexp-quote header) ":") nil t) - (progn - (re-search-forward "^[^ \t]" nil 'move) - (beginning-of-line) - (skip-chars-backward "\n") - t) - (while (and afters - (not (re-search-forward - (concat "^" (regexp-quote (car afters)) ":") - nil t))) - (pop afters)) - (when afters - (re-search-forward "^[^ \t]" nil 'move) - (beginning-of-line)) - (insert header ": \n") - (forward-char -1) - nil)))) - -(defun message-remove-signature () - "Remove the signature from the text between point and mark. -The text will also be indented the normal way." - (save-excursion - (let ((start (point)) - mark) - (if (not (re-search-forward message-signature-separator (mark t) t)) - ;; No signature here, so we just indent the cited text. - (message-indent-citation) - ;; Find the last non-empty line. - (forward-line -1) - (while (looking-at "[ \t]*$") - (forward-line -1)) - (forward-line 1) - (setq mark (set-marker (make-marker) (point))) - (goto-char start) - (message-indent-citation) - ;; Enable undoing the deletion. - (undo-boundary) - (delete-region mark (mark t)) - (set-marker mark nil))))) - - - -;;; -;;; Sending messages -;;; - -(defun message-send-and-exit (&optional arg) - "Send message like `message-send', then, if no errors, exit from mail buffer." - (interactive "P") - (let ((buf (current-buffer)) - (actions message-exit-actions)) - (when (and (message-send arg) - (buffer-name buf)) - (if message-kill-buffer-on-exit - (kill-buffer buf) - (bury-buffer buf) - (when (eq buf (current-buffer)) - (message-bury buf))) - (message-do-actions actions) - t))) - -(defun message-dont-send () - "Don't send the message you have been editing. -Instead, just auto-save the buffer and then bury it." - (interactive) - (set-buffer-modified-p t) - (save-buffer) - (let ((actions message-postpone-actions)) - (message-bury (current-buffer)) - (message-do-actions actions))) - -(defun message-kill-buffer () - "Kill the current buffer." - (interactive) - (when (or (not (buffer-modified-p)) - (yes-or-no-p "Message modified; kill anyway? ")) - (let ((actions message-kill-actions) - (draft-article message-draft-article) - (auto-save-file-name buffer-auto-save-file-name) - (file-name buffer-file-name) - (modified (buffer-modified-p))) - (setq buffer-file-name nil) - (kill-buffer (current-buffer)) - (when (and (or (and auto-save-file-name - (file-exists-p auto-save-file-name)) - (and file-name - (file-exists-p file-name))) - (progn - ;; If the message buffer has lived in a dedicated window, - ;; `kill-buffer' has killed the frame. Thus the - ;; `yes-or-no-p' may show up in a lowered frame. Make sure - ;; that the user can see the question by raising the - ;; current frame: - (raise-frame) - (yes-or-no-p (format "Remove the backup file%s? " - (if modified " too" ""))))) - (ignore-errors - (delete-file auto-save-file-name)) - (let ((message-draft-article draft-article)) - (message-disassociate-draft))) - (message-do-actions actions)))) - -(defun message-bury (buffer) - "Bury this mail BUFFER." - (let ((newbuf (other-buffer buffer))) - (bury-buffer buffer) - (if (and (window-dedicated-p (selected-window)) - (not (null (delq (selected-frame) (visible-frame-list))))) - (delete-frame (selected-frame)) - (switch-to-buffer newbuf)))) - -(defun message-send (&optional arg) - "Send the message in the current buffer. -If `message-interactive' is non-nil, wait for success indication or -error messages, and inform user. -Otherwise any failure is reported in a message back to the user from -the mailer. -The usage of ARG is defined by the instance that called Message. -It should typically alter the sending method in some way or other." - (interactive "P") - ;; Make it possible to undo the coming changes. - (undo-boundary) - (let ((inhibit-read-only t)) - (put-text-property (point-min) (point-max) 'read-only nil)) - (message-fix-before-sending) - (run-hooks 'message-send-hook) - (message message-sending-message) - (let ((alist message-send-method-alist) - (success t) - elem sent dont-barf-on-no-method - (message-options message-options)) - (message-options-set-recipient) - (while (and success - (setq elem (pop alist))) - (when (funcall (cadr elem)) - (when (and (or (not (memq (car elem) - message-sent-message-via)) - (message-fetch-field "supersedes") - (if (or (message-gnksa-enable-p 'multiple-copies) - (not (eq (car elem) 'news))) - (y-or-n-p - (format - "Already sent message via %s; resend? " - (car elem))) - (error "Denied posting -- multiple copies"))) - (setq success (funcall (caddr elem) arg))) - (setq sent t)))) - (unless (or sent - (not success) - (let ((fcc (message-fetch-field "Fcc")) - (gcc (message-fetch-field "Gcc"))) - (when (or fcc gcc) - (or (eq message-allow-no-recipients 'always) - (and (not (eq message-allow-no-recipients 'never)) - (setq dont-barf-on-no-method - (gnus-y-or-n-p - (format "No receiver, perform %s anyway? " - (cond ((and fcc gcc) "Fcc and Gcc") - (fcc "Fcc") - (t "Gcc")))))))))) - (error "No methods specified to send by")) - (when (or dont-barf-on-no-method - (and success sent)) - (message-do-fcc) - (save-excursion - (run-hooks 'message-sent-hook)) - (message "Sending...done") - ;; Mark the buffer as unmodified and delete auto-save. - (set-buffer-modified-p nil) - (delete-auto-save-file-if-necessary t) - (message-disassociate-draft) - ;; Delete other mail buffers and stuff. - (message-do-send-housekeeping) - (message-do-actions message-send-actions) - ;; Return success. - t))) - -(defun message-send-via-mail (arg) - "Send the current message via mail." - (message-send-mail arg)) - -(defun message-send-via-news (arg) - "Send the current message via news." - (funcall message-send-news-function arg)) - -(defmacro message-check (type &rest forms) - "Eval FORMS if TYPE is to be checked." - `(or (message-check-element ,type) - (save-excursion - ,@forms))) - -(put 'message-check 'lisp-indent-function 1) -(put 'message-check 'edebug-form-spec '(form body)) - -(defun message-text-with-property (prop) - "Return a list of all points where the text has PROP." - (let ((points nil) - (point (point-min))) - (save-excursion - (while (< point (point-max)) - (when (get-text-property point prop) - (push point points)) - (incf point))) - (nreverse points))) - -(defun message-fix-before-sending () - "Do various things to make the message nice before sending it." - ;; Make sure there's a newline at the end of the message. - (goto-char (point-max)) - (unless (bolp) - (insert "\n")) - ;; Make the hidden headers visible. - (let ((points (message-text-with-property 'message-hidden))) - (when points - (goto-char (car points)) - (dolist (point points) - (add-text-properties point (1+ point) - '(invisible nil intangible nil))))) - ;; Make invisible text visible. - ;; It doesn't seem as if this is useful, since the invisible property - ;; is clobbered by an after-change hook anyhow. - (message-check 'invisible-text - (let ((points (message-text-with-property 'invisible))) - (when points - (goto-char (car points)) - (dolist (point points) - (put-text-property point (1+ point) 'invisible nil) - (message-overlay-put (message-make-overlay point (1+ point)) - 'face 'highlight)) - (unless (yes-or-no-p - "Invisible text found and made visible; continue sending? ") - (error "Invisible text found and made visible"))))) - (message-check 'illegible-text - (let (found choice) - (message-goto-body) - (skip-chars-forward mm-7bit-chars) - (while (not (eobp)) - (when (let ((char (char-after))) - (or (< (mm-char-int char) 128) - (and (mm-multibyte-p) - (memq (char-charset char) - '(eight-bit-control eight-bit-graphic - control-1)) - (not (get-text-property - (point) 'untranslated-utf-8))))) - (message-overlay-put (message-make-overlay (point) (1+ (point))) - 'face 'highlight) - (setq found t)) - (forward-char) - (skip-chars-forward mm-7bit-chars)) - (when found - (setq choice - (gnus-multiple-choice - "Non-printable characters found. Continue sending?" - `((?d "Remove non-printable characters and send") - (?r ,(format - "Replace non-printable characters with \"%s\" and send" - message-replacement-char)) - (?i "Ignore non-printable characters and send") - (?e "Continue editing")))) - (if (eq choice ?e) - (error "Non-printable characters")) - (message-goto-body) - (skip-chars-forward mm-7bit-chars) - (while (not (eobp)) - (when (let ((char (char-after))) - (or (< (mm-char-int char) 128) - (and (mm-multibyte-p) - ;; FIXME: Wrong for Emacs 23 (unicode) and for - ;; things like undecable utf-8. Should at least - ;; use find-coding-systems-region. - (memq (char-charset char) - '(eight-bit-control eight-bit-graphic - control-1)) - (not (get-text-property - (point) 'untranslated-utf-8))))) - (if (eq choice ?i) - (message-kill-all-overlays) - (delete-char 1) - (when (eq choice ?r) - (insert message-replacement-char)))) - (forward-char) - (skip-chars-forward mm-7bit-chars)))))) - -(defun message-add-action (action &rest types) - "Add ACTION to be performed when doing an exit of type TYPES." - (while types - (add-to-list (intern (format "message-%s-actions" (pop types))) - action))) - -(defun message-delete-action (action &rest types) - "Delete ACTION from lists of actions performed when doing an exit of type TYPES." - (let (var) - (while types - (set (setq var (intern (format "message-%s-actions" (pop types)))) - (delq action (symbol-value var)))))) - -(defun message-do-actions (actions) - "Perform all actions in ACTIONS." - ;; Now perform actions on successful sending. - (while actions - (ignore-errors - (cond - ;; A simple function. - ((functionp (car actions)) - (funcall (car actions))) - ;; Something to be evaled. - (t - (eval (car actions))))) - (pop actions))) - -(defun message-send-mail-partially () - "Send mail as message/partial." - ;; replace the header delimiter with a blank line - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "\n")) - (replace-match "\n") - (run-hooks 'message-send-mail-hook) - (let ((p (goto-char (point-min))) - (tembuf (message-generate-new-buffer-clone-locals " message temp")) - (curbuf (current-buffer)) - (id (message-make-message-id)) (n 1) - plist total header required-mail-headers) - (while (not (eobp)) - (if (< (point-max) (+ p message-send-mail-partially-limit)) - (goto-char (point-max)) - (goto-char (+ p message-send-mail-partially-limit)) - (beginning-of-line) - (if (<= (point) p) (forward-line 1))) ;; In case of bad message. - (push p plist) - (setq p (point))) - (setq total (length plist)) - (push (point-max) plist) - (setq plist (nreverse plist)) - (unwind-protect - (save-excursion - (setq p (pop plist)) - (while plist - (set-buffer curbuf) - (copy-to-buffer tembuf p (car plist)) - (set-buffer tembuf) - (goto-char (point-min)) - (if header - (progn - (goto-char (point-min)) - (narrow-to-region (point) (point)) - (insert header)) - (message-goto-eoh) - (setq header (buffer-substring (point-min) (point))) - (goto-char (point-min)) - (narrow-to-region (point) (point)) - (insert header) - (message-remove-header "Mime-Version") - (message-remove-header "Content-Type") - (message-remove-header "Content-Transfer-Encoding") - (message-remove-header "Message-ID") - (message-remove-header "Lines") - (goto-char (point-max)) - (insert "Mime-Version: 1.0\n") - (setq header (buffer-string))) - (goto-char (point-max)) - (insert (format "Content-Type: message/partial; id=\"%s\"; number=%d; total=%d\n\n" - id n total)) - (forward-char -1) - (let ((mail-header-separator "")) - (when (memq 'Message-ID message-required-mail-headers) - (insert "Message-ID: " (message-make-message-id) "\n")) - (when (memq 'Lines message-required-mail-headers) - (insert "Lines: " (message-make-lines) "\n")) - (message-goto-subject) - (end-of-line) - (insert (format " (%d/%d)" n total)) - (widen) - (mm-with-unibyte-current-buffer - (funcall (or message-send-mail-real-function - message-send-mail-function)))) - (setq n (+ n 1)) - (setq p (pop plist)) - (erase-buffer))) - (kill-buffer tembuf)))) - -(defun message-send-mail (&optional arg) - (require 'mail-utils) - (let* ((tembuf (message-generate-new-buffer-clone-locals " message temp")) - (case-fold-search nil) - (news (message-news-p)) - (mailbuf (current-buffer)) - (message-this-is-mail t) - (message-posting-charset - (if (fboundp 'gnus-setup-posting-charset) - (gnus-setup-posting-charset nil) - message-posting-charset)) - (headers message-required-mail-headers)) - (save-restriction - (message-narrow-to-headers) - ;; Generate the Mail-Followup-To header if the header is not there... - (if (and (message-subscribed-p) - (not (mail-fetch-field "mail-followup-to"))) - (setq headers - (cons - (cons "Mail-Followup-To" (message-make-mail-followup-to)) - message-required-mail-headers)) - ;; otherwise, delete the MFT header if the field is empty - (when (equal "" (mail-fetch-field "mail-followup-to")) - (message-remove-header "^Mail-Followup-To:"))) - ;; Insert some headers. - (let ((message-deletable-headers - (if news nil message-deletable-headers))) - (message-generate-headers headers)) - ;; Check continuation headers. - (message-check 'continuation-headers - (goto-char (point-min)) - (while (re-search-forward "^[^ \t\n][^ \t\n:]*[ \t\n]" nil t) - (goto-char (match-beginning 0)) - (if (y-or-n-p "Fix continuation lines? ") - (insert " ") - (forward-line 1) - (unless (y-or-n-p "Send anyway? ") - (error "Failed to send the message"))))) - ;; Let the user do all of the above. - (run-hooks 'message-header-hook)) - (unwind-protect - (save-excursion - (set-buffer tembuf) - (erase-buffer) - ;; Avoid copying text props (except hard newlines). - (insert (with-current-buffer mailbuf - (mml-buffer-substring-no-properties-except-hard-newlines - (point-min) (point-max)))) - ;; Remove some headers. - (message-encode-message-body) - (save-restriction - (message-narrow-to-headers) - ;; We (re)generate the Lines header. - (when (memq 'Lines message-required-mail-headers) - (message-generate-headers '(Lines))) - ;; Remove some headers. - (message-remove-header message-ignored-mail-headers t) - (let ((mail-parse-charset message-default-charset)) - (mail-encode-encoded-word-buffer))) - (goto-char (point-max)) - ;; require one newline at the end. - (or (= (preceding-char) ?\n) - (insert ?\n)) - (message-cleanup-headers) - ;; FIXME: we're inserting the courtesy copy after encoding. - ;; This is wrong if the courtesy copy string contains - ;; non-ASCII characters. -- jh - (when - (save-restriction - (message-narrow-to-headers) - (and news - (or (message-fetch-field "cc") - (message-fetch-field "bcc") - (message-fetch-field "to")) - (let ((content-type (message-fetch-field - "content-type"))) - (and - (or - (not content-type) - (string= "text/plain" - (car - (mail-header-parse-content-type - content-type)))) - (not - (string= "base64" - (message-fetch-field - "content-transfer-encoding"))))))) - (message-insert-courtesy-copy)) - (if (or (not message-send-mail-partially-limit) - (< (buffer-size) message-send-mail-partially-limit) - (not (message-y-or-n-p - "The message size is too large, split? " - t - "\ -The message size, " - (/ (buffer-size) 1000) "KB, is too large. - -Some mail gateways (MTA's) bounce large messages. To avoid the -problem, answer `y', and the message will be split into several -smaller pieces, the size of each is about " - (/ message-send-mail-partially-limit 1000) - "KB except the last -one. - -However, some mail readers (MUA's) can't read split messages, i.e., -mails in message/partially format. Answer `n', and the message will be -sent in one piece. - -The size limit is controlled by `message-send-mail-partially-limit'. -If you always want Gnus to send messages in one piece, set -`message-send-mail-partially-limit' to nil. -"))) - (mm-with-unibyte-current-buffer - (message "Sending via mail...") - (funcall (or message-send-mail-real-function - message-send-mail-function))) - (message-send-mail-partially))) - (kill-buffer tembuf)) - (set-buffer mailbuf) - (push 'mail message-sent-message-via))) - -(defun message-send-mail-with-sendmail () - "Send off the prepared buffer with sendmail." - (let ((errbuf (if message-interactive - (message-generate-new-buffer-clone-locals - " sendmail errors") - 0)) - resend-to-addresses delimline) - (unwind-protect - (progn - (let ((case-fold-search t)) - (save-restriction - (message-narrow-to-headers) - (setq resend-to-addresses (message-fetch-field "resent-to"))) - ;; Change header-delimiter to be what sendmail expects. - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "\n")) - (replace-match "\n") - (backward-char 1) - (setq delimline (point-marker)) - (run-hooks 'message-send-mail-hook) - ;; Insert an extra newline if we need it to work around - ;; Sun's bug that swallows newlines. - (goto-char (1+ delimline)) - (when (eval message-mailer-swallows-blank-line) - (newline)) - (when message-interactive - (save-excursion - (set-buffer errbuf) - (erase-buffer)))) - (let* ((default-directory "/") - (coding-system-for-write message-send-coding-system) - (cpr (apply - 'call-process-region - (append - (list (point-min) (point-max) - (cond ((boundp 'sendmail-program) - sendmail-program) - ((file-exists-p "/usr/sbin/sendmail") - "/usr/sbin/sendmail") - ((file-exists-p "/usr/lib/sendmail") - "/usr/lib/sendmail") - ((file-exists-p "/usr/ucblib/sendmail") - "/usr/ucblib/sendmail") - (t "fakemail")) - nil errbuf nil "-oi") - ;; Always specify who from, - ;; since some systems have broken sendmails. - ;; But some systems are more broken with -f, so - ;; we'll let users override this. - (if (null message-sendmail-f-is-evil) - (list "-f" (message-sendmail-envelope-from))) - ;; These mean "report errors by mail" - ;; and "deliver in background". - (if (null message-interactive) '("-oem" "-odb")) - ;; Get the addresses from the message - ;; unless this is a resend. - ;; We must not do that for a resend - ;; because we would find the original addresses. - ;; For a resend, include the specific addresses. - (if resend-to-addresses - (list resend-to-addresses) - '("-t")))))) - (unless (or (null cpr) (and (numberp cpr) (zerop cpr))) - (error "Sending...failed with exit value %d" cpr))) - (when message-interactive - (save-excursion - (set-buffer errbuf) - (goto-char (point-min)) - (while (re-search-forward "\n\n* *" nil t) - (replace-match "; ")) - (if (not (zerop (buffer-size))) - (error "Sending...failed to %s" - (buffer-string)))))) - (when (bufferp errbuf) - (kill-buffer errbuf))))) - -(defun message-send-mail-with-qmail () - "Pass the prepared message buffer to qmail-inject. -Refer to the documentation for the variable `message-send-mail-function' -to find out how to use this." - ;; replace the header delimiter with a blank line - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "\n")) - (replace-match "\n") - (run-hooks 'message-send-mail-hook) - ;; send the message - (case - (let ((coding-system-for-write message-send-coding-system)) - (apply - 'call-process-region (point-min) (point-max) - message-qmail-inject-program nil nil nil - ;; qmail-inject's default behaviour is to look for addresses on the - ;; command line; if there're none, it scans the headers. - ;; yes, it does The Right Thing w.r.t. Resent-To and it's kin. - ;; - ;; in general, ALL of qmail-inject's defaults are perfect for simply - ;; reading a formatted (i. e., at least a To: or Resent-To header) - ;; message from stdin. - ;; - ;; qmail also has the advantage of not having been raped by - ;; various vendors, so we don't have to allow for that, either -- - ;; compare this with message-send-mail-with-sendmail and weep - ;; for sendmail's lost innocence. - ;; - ;; all this is way cool coz it lets us keep the arguments entirely - ;; free for -inject-arguments -- a big win for the user and for us - ;; since we don't have to play that double-guessing game and the user - ;; gets full control (no gestapo'ish -f's, for instance). --sj - (if (functionp message-qmail-inject-args) - (funcall message-qmail-inject-args) - message-qmail-inject-args))) - ;; qmail-inject doesn't say anything on it's stdout/stderr, - ;; we have to look at the retval instead - (0 nil) - (100 (error "qmail-inject reported permanent failure")) - (111 (error "qmail-inject reported transient failure")) - ;; should never happen - (t (error "qmail-inject reported unknown failure")))) - -(defun message-send-mail-with-mh () - "Send the prepared message buffer with mh." - (let ((mh-previous-window-config nil) - (name (mh-new-draft-name))) - (setq buffer-file-name name) - ;; MH wants to generate these headers itself. - (when message-mh-deletable-headers - (let ((headers message-mh-deletable-headers)) - (while headers - (goto-char (point-min)) - (and (re-search-forward - (concat "^" (symbol-name (car headers)) ": *") nil t) - (message-delete-line)) - (pop headers)))) - (run-hooks 'message-send-mail-hook) - ;; Pass it on to mh. - (mh-send-letter))) - -(defun message-smtpmail-send-it () - "Send the prepared message buffer with `smtpmail-send-it'. -This only differs from `smtpmail-send-it' that this command evaluates -`message-send-mail-hook' just before sending a message. It is useful -if your ISP requires the POP-before-SMTP authentication. See the Gnus -manual for details." - (run-hooks 'message-send-mail-hook) - (smtpmail-send-it)) - -(defun message-canlock-generate () - "Return a string that is non-trivial to guess. -Do not use this for anything important, it is cryptographically weak." - (require 'sha1) - (let (sha1-maximum-internal-length) - (sha1 (concat (message-unique-id) - (format "%x%x%x" (random) (random t) (random)) - (prin1-to-string (recent-keys)) - (prin1-to-string (garbage-collect)))))) - -(defun message-canlock-password () - "The password used by message for cancel locks. -This is the value of `canlock-password', if that option is non-nil. -Otherwise, generate and save a value for `canlock-password' first." - (unless canlock-password - (customize-save-variable 'canlock-password (message-canlock-generate)) - (setq canlock-password-for-verify canlock-password)) - canlock-password) - -(defun message-insert-canlock () - (when message-insert-canlock - (message-canlock-password) - (canlock-insert-header))) - -(defun message-send-news (&optional arg) - (let* ((tembuf (message-generate-new-buffer-clone-locals " *message temp*")) - (case-fold-search nil) - (method (if (functionp message-post-method) - (funcall message-post-method arg) - message-post-method)) - (newsgroups-field (save-restriction - (message-narrow-to-headers-or-head) - (message-fetch-field "Newsgroups"))) - (followup-field (save-restriction - (message-narrow-to-headers-or-head) - (message-fetch-field "Followup-To"))) - ;; BUG: We really need to get the charset for each name in the - ;; Newsgroups and Followup-To lines to allow crossposting - ;; between group namess with incompatible character sets. - ;; -- Per Abrahamsen 2001-10-08. - (group-field-charset - (gnus-group-name-charset method newsgroups-field)) - (followup-field-charset - (gnus-group-name-charset method (or followup-field ""))) - (rfc2047-header-encoding-alist - (append (when group-field-charset - (list (cons "Newsgroups" group-field-charset))) - (when followup-field-charset - (list (cons "Followup-To" followup-field-charset))) - rfc2047-header-encoding-alist)) - (messbuf (current-buffer)) - (message-syntax-checks - (if (and arg - (listp message-syntax-checks)) - (cons '(existing-newsgroups . disabled) - message-syntax-checks) - message-syntax-checks)) - (message-this-is-news t) - (message-posting-charset - (gnus-setup-posting-charset newsgroups-field)) - result) - (if (not (message-check-news-body-syntax)) - nil - (save-restriction - (message-narrow-to-headers) - ;; Insert some headers. - (message-generate-headers message-required-news-headers) - (message-insert-canlock) - ;; Let the user do all of the above. - (run-hooks 'message-header-hook)) - ;; Note: This check will be disabled by the ".*" default value for - ;; gnus-group-name-charset-group-alist. -- Pa 2001-10-07. - (when (and group-field-charset - (listp message-syntax-checks)) - (setq message-syntax-checks - (cons '(valid-newsgroups . disabled) - message-syntax-checks))) - (message-cleanup-headers) - (if (not (let ((message-post-method method)) - (message-check-news-syntax))) - nil - (unwind-protect - (save-excursion - (set-buffer tembuf) - (buffer-disable-undo) - (erase-buffer) - ;; Avoid copying text props (except hard newlines). - (insert - (with-current-buffer messbuf - (mml-buffer-substring-no-properties-except-hard-newlines - (point-min) (point-max)))) - (message-encode-message-body) - ;; Remove some headers. - (save-restriction - (message-narrow-to-headers) - ;; We (re)generate the Lines header. - (when (memq 'Lines message-required-mail-headers) - (message-generate-headers '(Lines))) - ;; Remove some headers. - (message-remove-header message-ignored-news-headers t) - (let ((mail-parse-charset message-default-charset)) - (mail-encode-encoded-word-buffer))) - (goto-char (point-max)) - ;; require one newline at the end. - (or (= (preceding-char) ?\n) - (insert ?\n)) - (let ((case-fold-search t)) - ;; Remove the delimiter. - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "\n")) - (replace-match "\n") - (backward-char 1)) - (run-hooks 'message-send-news-hook) - (gnus-open-server method) - (message "Sending news via %s..." (gnus-server-string method)) - (setq result (let ((mail-header-separator "")) - (gnus-request-post method)))) - (kill-buffer tembuf)) - (set-buffer messbuf) - (if result - (push 'news message-sent-message-via) - (message "Couldn't send message via news: %s" - (nnheader-get-report (car method))) - nil))))) - -;;; -;;; Header generation & syntax checking. -;;; - -(defun message-check-element (type) - "Return non-nil if this TYPE is not to be checked." - (if (eq message-syntax-checks 'dont-check-for-anything-just-trust-me) - t - (let ((able (assq type message-syntax-checks))) - (and (consp able) - (eq (cdr able) 'disabled))))) - -(defun message-check-news-syntax () - "Check the syntax of the message." - (save-excursion - (save-restriction - (widen) - ;; We narrow to the headers and check them first. - (save-excursion - (save-restriction - (message-narrow-to-headers) - (message-check-news-header-syntax)))))) - -(defun message-check-news-header-syntax () - (and - ;; Check Newsgroups header. - (message-check 'newsgroups - (let ((group (message-fetch-field "newsgroups"))) - (or - (and group - (not (string-match "\\`[ \t]*\\'" group))) - (ignore - (message - "The newsgroups field is empty or missing. Posting is denied."))))) - ;; Check the Subject header. - (message-check 'subject - (let* ((case-fold-search t) - (subject (message-fetch-field "subject"))) - (or - (and subject - (not (string-match "\\`[ \t]*\\'" subject))) - (ignore - (message - "The subject field is empty or missing. Posting is denied."))))) - ;; Check for commands in Subject. - (message-check 'subject-cmsg - (if (string-match "^cmsg " (message-fetch-field "subject")) - (y-or-n-p - "The control code \"cmsg\" is in the subject. Really post? ") - t)) - ;; Check long header lines. - (message-check 'long-header-lines - (let ((start (point)) - (header nil) - (length 0) - found) - (while (and (not found) - (re-search-forward "^\\([^ \t:]+\\): " nil t)) - (if (> (- (point) (match-beginning 0)) 998) - (setq found t - length (- (point) (match-beginning 0))) - (setq header (match-string-no-properties 1))) - (setq start (match-beginning 0)) - (forward-line 1)) - (if found - (y-or-n-p (format "Your %s header is too long (%d). Really post? " - header length)) - t))) - ;; Check for multiple identical headers. - (message-check 'multiple-headers - (let (found) - (while (and (not found) - (re-search-forward "^[^ \t:]+: " nil t)) - (save-excursion - (or (re-search-forward - (concat "^" - (regexp-quote - (setq found - (buffer-substring - (match-beginning 0) (- (match-end 0) 2)))) - ":") - nil t) - (setq found nil)))) - (if found - (y-or-n-p (format "Multiple %s headers. Really post? " found)) - t))) - ;; Check for Version and Sendsys. - (message-check 'sendsys - (if (re-search-forward "^Sendsys:\\|^Version:" nil t) - (y-or-n-p - (format "The article contains a %s command. Really post? " - (buffer-substring (match-beginning 0) - (1- (match-end 0))))) - t)) - ;; See whether we can shorten Followup-To. - (message-check 'shorten-followup-to - (let ((newsgroups (message-fetch-field "newsgroups")) - (followup-to (message-fetch-field "followup-to")) - to) - (when (and newsgroups - (string-match "," newsgroups) - (not followup-to) - (not - (zerop - (length - (setq to (completing-read - "Followups to (default no Followup-To header): " - (mapcar #'list - (cons "poster" - (message-tokenize-header - newsgroups))))))))) - (goto-char (point-min)) - (insert "Followup-To: " to "\n")) - t)) - ;; Check "Shoot me". - (message-check 'shoot - (if (re-search-forward - "Message-ID.*.i-did-not-set--mail-host-address--so-tickle-me" nil t) - (y-or-n-p "You appear to have a misconfigured system. Really post? ") - t)) - ;; Check for Approved. - (message-check 'approved - (if (re-search-forward "^Approved:" nil t) - (y-or-n-p "The article contains an Approved header. Really post? ") - t)) - ;; Check the Message-ID header. - (message-check 'message-id - (let* ((case-fold-search t) - (message-id (message-fetch-field "message-id" t))) - (or (not message-id) - ;; Is there an @ in the ID? - (and (string-match "@" message-id) - ;; Is there a dot in the ID? - (string-match "@[^.]*\\." message-id) - ;; Does the ID end with a dot? - (not (string-match "\\.>" message-id))) - (y-or-n-p - (format "The Message-ID looks strange: \"%s\". Really post? " - message-id))))) - ;; Check the Newsgroups & Followup-To headers. - (message-check 'existing-newsgroups - (let* ((case-fold-search t) - (newsgroups (message-fetch-field "newsgroups")) - (followup-to (message-fetch-field "followup-to")) - (groups (message-tokenize-header - (if followup-to - (concat newsgroups "," followup-to) - newsgroups))) - (post-method (if (functionp message-post-method) - (funcall message-post-method) - message-post-method)) - ;; KLUDGE to handle nnvirtual groups. Doing this right - ;; would probably involve a new nnoo function. - ;; -- Per Abrahamsen , 2001-10-17. - (method (if (and (consp post-method) - (eq (car post-method) 'nnvirtual) - gnus-message-group-art) - (let ((group (car (nnvirtual-find-group-art - (car gnus-message-group-art) - (cdr gnus-message-group-art))))) - (gnus-find-method-for-group group)) - post-method)) - (known-groups - (mapcar (lambda (n) - (gnus-group-name-decode - (gnus-group-real-name n) - (gnus-group-name-charset method n))) - (gnus-groups-from-server method))) - errors) - (while groups - (when (and (not (equal (car groups) "poster")) - (not (member (car groups) known-groups)) - (not (member (car groups) errors))) - (push (car groups) errors)) - (pop groups)) - (cond - ;; Gnus is not running. - ((or (not (and (boundp 'gnus-active-hashtb) - gnus-active-hashtb)) - (not (boundp 'gnus-read-active-file))) - t) - ;; We don't have all the group names. - ((and (or (not gnus-read-active-file) - (eq gnus-read-active-file 'some)) - errors) - (y-or-n-p - (format - "Really use %s possibly unknown group%s: %s? " - (if (= (length errors) 1) "this" "these") - (if (= (length errors) 1) "" "s") - (mapconcat 'identity errors ", ")))) - ;; There were no errors. - ((not errors) - t) - ;; There are unknown groups. - (t - (y-or-n-p - (format - "Really post to %s unknown group%s: %s? " - (if (= (length errors) 1) "this" "these") - (if (= (length errors) 1) "" "s") - (mapconcat 'identity errors ", "))))))) - ;; Check continuation headers. - (message-check 'continuation-headers - (goto-char (point-min)) - (let ((do-posting t)) - (while (re-search-forward "^[^ \t\n][^ \t\n:]*[ \t\n]" nil t) - (goto-char (match-beginning 0)) - (if (y-or-n-p "Fix continuation lines? ") - (insert " ") - (forward-line 1) - (unless (y-or-n-p "Send anyway? ") - (setq do-posting nil)))) - do-posting)) - ;; Check the Newsgroups & Followup-To headers for syntax errors. - (message-check 'valid-newsgroups - (let ((case-fold-search t) - (headers '("Newsgroups" "Followup-To")) - header error) - (while (and headers (not error)) - (when (setq header (mail-fetch-field (car headers))) - (if (or - (not - (string-match - "\\`\\([-+_&.a-zA-Z0-9]+\\)?\\(,[-+_&.a-zA-Z0-9]+\\)*\\'" - header)) - (memq - nil (mapcar - (lambda (g) - (not (string-match "\\.\\'\\|\\.\\." g))) - (message-tokenize-header header ",")))) - (setq error t))) - (unless error - (pop headers))) - (if (not error) - t - (y-or-n-p - (format "The %s header looks odd: \"%s\". Really post? " - (car headers) header))))) - (message-check 'repeated-newsgroups - (let ((case-fold-search t) - (headers '("Newsgroups" "Followup-To")) - header error groups group) - (while (and headers - (not error)) - (when (setq header (mail-fetch-field (pop headers))) - (setq groups (message-tokenize-header header ",")) - (while (setq group (pop groups)) - (when (member group groups) - (setq error group - groups nil))))) - (if (not error) - t - (y-or-n-p - (format "Group %s is repeated in headers. Really post? " error))))) - ;; Check the From header. - (message-check 'from - (let* ((case-fold-search t) - (from (message-fetch-field "from")) - ad) - (cond - ((not from) - (message "There is no From line. Posting is denied.") - nil) - ((or (not (string-match - "@[^\\.]*\\." - (setq ad (nth 1 (mail-extract-address-components - from))))) ;larsi@ifi - (string-match "\\.\\." ad) ;larsi@ifi..uio - (string-match "@\\." ad) ;larsi@.ifi.uio - (string-match "\\.$" ad) ;larsi@ifi.uio. - (not (string-match "^[^@]+@[^@]+$" ad)) ;larsi.ifi.uio - (string-match "(.*).*(.*)" from)) ;(lars) (lars) - (message - "Denied posting -- the From looks strange: \"%s\"." from) - nil) - ((let ((addresses (rfc822-addresses from))) - (while (and addresses - (not (eq (string-to-char (car addresses)) ?\())) - (setq addresses (cdr addresses))) - addresses) - (message - "Denied posting -- bad From address: \"%s\"." from) - nil) - (t t)))) - ;; Check the Reply-To header. - (message-check 'reply-to - (let* ((case-fold-search t) - (reply-to (message-fetch-field "reply-to")) - ad) - (cond - ((not reply-to) - t) - ((string-match "," reply-to) - (y-or-n-p - (format "Multiple Reply-To addresses: \"%s\". Really post? " - reply-to))) - ((or (not (string-match - "@[^\\.]*\\." - (setq ad (nth 1 (mail-extract-address-components - reply-to))))) ;larsi@ifi - (string-match "\\.\\." ad) ;larsi@ifi..uio - (string-match "@\\." ad) ;larsi@.ifi.uio - (string-match "\\.$" ad) ;larsi@ifi.uio. - (not (string-match "^[^@]+@[^@]+$" ad)) ;larsi.ifi.uio - (string-match "(.*).*(.*)" reply-to)) ;(lars) (lars) - (y-or-n-p - (format - "The Reply-To looks strange: \"%s\". Really post? " - reply-to))) - (t t)))))) - -(defun message-check-news-body-syntax () - (and - ;; Check for long lines. - (message-check 'long-lines - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$")) - (forward-line 1) - (while (and - (or (looking-at - "<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)") - (let ((p (point))) - (end-of-line) - (< (- (point) p) 80))) - (zerop (forward-line 1)))) - (or (bolp) - (eobp) - (y-or-n-p - "You have lines longer than 79 characters. Really post? "))) - ;; Check whether the article is empty. - (message-check 'empty - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$")) - (forward-line 1) - (let ((b (point))) - (goto-char (point-max)) - (re-search-backward message-signature-separator nil t) - (beginning-of-line) - (or (re-search-backward "[^ \n\t]" b t) - (if (message-gnksa-enable-p 'empty-article) - (y-or-n-p "Empty article. Really post? ") - (message "Denied posting -- Empty article.") - nil)))) - ;; Check for control characters. - (message-check 'control-chars - (if (re-search-forward - (mm-string-as-multibyte "[\000-\007\013\015-\032\034-\037\200-\237]") - nil t) - (y-or-n-p - "The article contains control characters. Really post? ") - t)) - ;; Check excessive size. - (message-check 'size - (if (> (buffer-size) 60000) - (y-or-n-p - (format "The article is %d octets long. Really post? " - (buffer-size))) - t)) - ;; Check whether any new text has been added. - (message-check 'new-text - (or - (not message-checksum) - (not (eq (message-checksum) message-checksum)) - (if (message-gnksa-enable-p 'quoted-text-only) - (y-or-n-p - "It looks like no new text has been added. Really post? ") - (message "Denied posting -- no new text has been added.") - nil))) - ;; Check the length of the signature. - (message-check 'signature - (goto-char (point-max)) - (if (> (count-lines (point) (point-max)) 5) - (y-or-n-p - (format - "Your .sig is %d lines; it should be max 4. Really post? " - (1- (count-lines (point) (point-max))))) - t)) - ;; Ensure that text follows last quoted portion. - (message-check 'quoting-style - (goto-char (point-max)) - (let ((no-problem t)) - (when (search-backward-regexp "^>[^\n]*\n" nil t) - (setq no-problem (search-forward-regexp "^[ \t]*[^>\n]" nil t))) - (if no-problem - t - (if (message-gnksa-enable-p 'quoted-text-only) - (y-or-n-p "Your text should follow quoted text. Really post? ") - ;; Ensure that - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$")) - (if (search-forward-regexp "^[ \t]*[^>\n]" nil t) - (y-or-n-p "Your text should follow quoted text. Really post? ") - (message "Denied posting -- only quoted text.") - nil))))))) - -(defun message-checksum () - "Return a \"checksum\" for the current buffer." - (let ((sum 0)) - (save-excursion - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$")) - (while (not (eobp)) - (when (not (looking-at "[ \t\n]")) - (setq sum (logxor (ash sum 1) (if (natnump sum) 0 1) - (char-after)))) - (forward-char 1))) - sum)) - -(defun message-do-fcc () - "Process Fcc headers in the current buffer." - (let ((case-fold-search t) - (buf (current-buffer)) - list file - (mml-externalize-attachments message-fcc-externalize-attachments)) - (save-excursion - (save-restriction - (message-narrow-to-headers) - (setq file (message-fetch-field "fcc" t))) - (when file - (set-buffer (get-buffer-create " *message temp*")) - (erase-buffer) - (insert-buffer-substring buf) - (message-encode-message-body) - (save-restriction - (message-narrow-to-headers) - (while (setq file (message-fetch-field "fcc" t)) - (push file list) - (message-remove-header "fcc" nil t)) - (let ((mail-parse-charset message-default-charset) - (rfc2047-header-encoding-alist - (cons '("Newsgroups" . default) - rfc2047-header-encoding-alist))) - (mail-encode-encoded-word-buffer))) - (goto-char (point-min)) - (when (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$") - nil t) - (replace-match "" t t )) - ;; Process FCC operations. - (while list - (setq file (pop list)) - (if (string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" file) - ;; Pipe the article to the program in question. - (call-process-region (point-min) (point-max) shell-file-name - nil nil nil shell-command-switch - (match-string 1 file)) - ;; Save the article. - (setq file (expand-file-name file)) - (unless (file-exists-p (file-name-directory file)) - (make-directory (file-name-directory file) t)) - (if (and message-fcc-handler-function - (not (eq message-fcc-handler-function 'rmail-output))) - (funcall message-fcc-handler-function file) - (if (and (file-readable-p file) (mail-file-babyl-p file)) - (rmail-output file 1 nil t) - (let ((mail-use-rfc822 t)) - (rmail-output file 1 t t)))))) - (kill-buffer (current-buffer)))))) - -(defun message-output (filename) - "Append this article to Unix/babyl mail file FILENAME." - (if (and (file-readable-p filename) - (mail-file-babyl-p filename)) - (gnus-output-to-rmail filename t) - (gnus-output-to-mail filename t))) - -(defun message-cleanup-headers () - "Do various automatic cleanups of the headers." - ;; Remove empty lines in the header. - (save-restriction - (message-narrow-to-headers) - ;; Remove blank lines. - (while (re-search-forward "^[ \t]*\n" nil t) - (replace-match "" t t)) - - ;; Correct Newsgroups and Followup-To headers: Change sequence of - ;; spaces to comma and eliminate spaces around commas. Eliminate - ;; embedded line breaks. - (goto-char (point-min)) - (while (re-search-forward "^\\(Newsgroups\\|Followup-To\\): +" nil t) - (save-restriction - (narrow-to-region - (point) - (if (re-search-forward "^[^ \t]" nil t) - (match-beginning 0) - (forward-line 1) - (point))) - (goto-char (point-min)) - (while (re-search-forward "\n[ \t]+" nil t) - (replace-match " " t t)) ;No line breaks (too confusing) - (goto-char (point-min)) - (while (re-search-forward "[ \t\n]*,[ \t\n]*\\|[ \t]+" nil t) - (replace-match "," t t)) - (goto-char (point-min)) - ;; Remove trailing commas. - (when (re-search-forward ",+$" nil t) - (replace-match "" t t)))))) - -(eval-when-compile (require 'parse-time)) -(defun message-make-date (&optional now) - "Make a valid data header. -If NOW, use that time instead." - (require 'parse-time) - (let* ((now (or now (current-time))) - (zone (nth 8 (decode-time now))) - (sign "+")) - (when (< zone 0) - (setq sign "-") - (setq zone (- zone))) - (concat - ;; The day name of the %a spec is locale-specific. Pfff. - (format "%s, " (capitalize (car (rassoc (nth 6 (decode-time now)) - parse-time-weekdays)))) - (format-time-string "%d" now) - ;; The month name of the %b spec is locale-specific. Pfff. - (format " %s " - (capitalize (car (rassoc (nth 4 (decode-time now)) - parse-time-months)))) - (format-time-string "%Y %H:%M:%S " now) - ;; We do all of this because XEmacs doesn't have the %z spec. - (format "%s%02d%02d" sign (/ zone 3600) (/ (% zone 3600) 60))))) - -(defun message-make-message-id () - "Make a unique Message-ID." - (concat "<" (message-unique-id) - (let ((psubject (save-excursion (message-fetch-field "subject"))) - (psupersedes - (save-excursion (message-fetch-field "supersedes")))) - (if (or - (and message-reply-headers - (mail-header-references message-reply-headers) - (mail-header-subject message-reply-headers) - psubject - (not (string= - (message-strip-subject-re - (mail-header-subject message-reply-headers)) - (message-strip-subject-re psubject)))) - (and psupersedes - (string-match "_-_@" psupersedes))) - "_-_" "")) - "@" (message-make-fqdn) ">")) - -(defvar message-unique-id-char nil) - -;; If you ever change this function, make sure the new version -;; cannot generate IDs that the old version could. -;; You might for example insert a "." somewhere (not next to another dot -;; or string boundary), or modify the "fsf" string. -(defun message-unique-id () - ;; Don't use microseconds from (current-time), they may be unsupported. - ;; Instead we use this randomly inited counter. - (setq message-unique-id-char - (% (1+ (or message-unique-id-char (logand (random t) (1- (lsh 1 20))))) - ;; (current-time) returns 16-bit ints, - ;; and 2^16*25 just fits into 4 digits i base 36. - (* 25 25))) - (let ((tm (current-time))) - (concat - (if (or (memq system-type '(ms-dos emx vax-vms)) - ;; message-number-base36 doesn't handle bigints. - (floatp (user-uid))) - (let ((user (downcase (user-login-name)))) - (while (string-match "[^a-z0-9_]" user) - (aset user (match-beginning 0) ?_)) - user) - (message-number-base36 (user-uid) -1)) - (message-number-base36 (+ (car tm) - (lsh (% message-unique-id-char 25) 16)) 4) - (message-number-base36 (+ (nth 1 tm) - (lsh (/ message-unique-id-char 25) 16)) 4) - ;; Append a given name, because while the generated ID is unique - ;; to this newsreader, other newsreaders might otherwise generate - ;; the same ID via another algorithm. - ".fsf"))) - -(defun message-number-base36 (num len) - (if (if (< len 0) - (<= num 0) - (= len 0)) - "" - (concat (message-number-base36 (/ num 36) (1- len)) - (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210" - (% num 36)))))) - -(defun message-make-organization () - "Make an Organization header." - (let* ((organization - (when message-user-organization - (if (functionp message-user-organization) - (funcall message-user-organization) - message-user-organization)))) - (with-temp-buffer - (mm-enable-multibyte) - (cond ((stringp organization) - (insert organization)) - ((and (eq t organization) - message-user-organization-file - (file-exists-p message-user-organization-file)) - (insert-file-contents message-user-organization-file))) - (goto-char (point-min)) - (while (re-search-forward "[\t\n]+" nil t) - (replace-match "" t t)) - (unless (zerop (buffer-size)) - (buffer-string))))) - -(defun message-make-lines () - "Count the number of lines and return numeric string." - (save-excursion - (save-restriction - (widen) - (message-goto-body) - (int-to-string (count-lines (point) (point-max)))))) - -(defun message-make-references () - "Return the References header for this message." - (when message-reply-headers - (let ((message-id (mail-header-message-id message-reply-headers)) - (references (mail-header-references message-reply-headers)) - new-references) - (if (or references message-id) - (concat (or references "") (and references " ") - (or message-id "")) - nil)))) - -(defun message-make-in-reply-to () - "Return the In-Reply-To header for this message." - (when message-reply-headers - (let ((from (mail-header-from message-reply-headers)) - (date (mail-header-date message-reply-headers)) - (msg-id (mail-header-message-id message-reply-headers))) - (when from - (let ((name (mail-extract-address-components from))) - (concat - msg-id (if msg-id " (") - (if (car name) - (if (string-match "[^\000-\177]" (car name)) - ;; Quote a string containing non-ASCII characters. - ;; It will make the RFC2047 encoder cause an error - ;; if there are special characters. - (let ((default-enable-multibyte-characters t)) - (with-temp-buffer - (insert (car name)) - (goto-char (point-min)) - (while (search-forward "\"" nil t) - (when (prog2 - (backward-char) - (zerop (% (skip-chars-backward "\\\\") 2)) - (goto-char (match-beginning 0))) - (insert "\\")) - (forward-char)) - ;; Those quotes will be removed by the RFC2047 encoder. - (concat "\"" (buffer-string) "\""))) - (car name)) - (nth 1 name)) - "'s message of \"" - (if (or (not date) (string= date "")) - "(unknown date)" date) - "\"" (if msg-id ")"))))))) - -(defun message-make-distribution () - "Make a Distribution header." - (let ((orig-distribution (message-fetch-reply-field "distribution"))) - (cond ((functionp message-distribution-function) - (funcall message-distribution-function)) - (t orig-distribution)))) - -(defun message-make-expires () - "Return an Expires header based on `message-expires'." - (let ((current (current-time)) - (future (* 1.0 message-expires 60 60 24))) - ;; Add the future to current. - (setcar current (+ (car current) (round (/ future (expt 2 16))))) - (setcar (cdr current) (+ (nth 1 current) (% (round future) (expt 2 16)))) - (message-make-date current))) - -(defun message-make-path () - "Return uucp path." - (let ((login-name (user-login-name))) - (cond ((null message-user-path) - (concat (system-name) "!" login-name)) - ((stringp message-user-path) - ;; Support GENERICPATH. Suggested by vixie@decwrl.dec.com. - (concat message-user-path "!" login-name)) - (t login-name)))) - -(defun message-make-from () - "Make a From header." - (let* ((style message-from-style) - (login (message-make-address)) - (fullname - (or (and (boundp 'user-full-name) - user-full-name) - (user-full-name)))) - (when (string= fullname "&") - (setq fullname (user-login-name))) - (with-temp-buffer - (mm-enable-multibyte) - (cond - ((or (null style) - (equal fullname "")) - (insert login)) - ((or (eq style 'angles) - (and (not (eq style 'parens)) - ;; Use angles if no quoting is needed, or if parens would - ;; need quoting too. - (or (not (string-match "[^- !#-'*+/-9=?A-Z^-~]" fullname)) - (let ((tmp (concat fullname nil))) - (while (string-match "([^()]*)" tmp) - (aset tmp (match-beginning 0) ?-) - (aset tmp (1- (match-end 0)) ?-)) - (string-match "[\\()]" tmp))))) - (insert fullname) - (goto-char (point-min)) - ;; Look for a character that cannot appear unquoted - ;; according to RFC 822. - (when (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" nil 1) - ;; Quote fullname, escaping specials. - (goto-char (point-min)) - (insert "\"") - (while (re-search-forward "[\"\\]" nil 1) - (replace-match "\\\\\\&" t)) - (insert "\"")) - (insert " <" login ">")) - (t ; 'parens or default - (insert login " (") - (let ((fullname-start (point))) - (insert fullname) - (goto-char fullname-start) - ;; RFC 822 says \ and nonmatching parentheses - ;; must be escaped in comments. - ;; Escape every instance of ()\ ... - (while (re-search-forward "[()\\]" nil 1) - (replace-match "\\\\\\&" t)) - ;; ... then undo escaping of matching parentheses, - ;; including matching nested parentheses. - (goto-char fullname-start) - (while (re-search-forward - "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)" - nil 1) - (replace-match "\\1(\\3)" t) - (goto-char fullname-start))) - (insert ")"))) - (buffer-string)))) - -(defun message-make-sender () - "Return the \"real\" user address. -This function tries to ignore all user modifications, and -give as trustworthy answer as possible." - (concat (user-login-name) "@" (system-name))) - -(defun message-make-address () - "Make the address of the user." - (or (message-user-mail-address) - (concat (user-login-name) "@" (message-make-domain)))) - -(defun message-user-mail-address () - "Return the pertinent part of `user-mail-address'." - (when (and user-mail-address - (string-match "@.*\\." user-mail-address)) - (if (string-match " " user-mail-address) - (nth 1 (mail-extract-address-components user-mail-address)) - user-mail-address))) - -(defun message-sendmail-envelope-from () - "Return the envelope from." - (cond ((eq message-sendmail-envelope-from 'header) - (nth 1 (mail-extract-address-components - (message-fetch-field "from")))) - ((stringp message-sendmail-envelope-from) - message-sendmail-envelope-from) - (t - (message-make-address)))) - -(defun message-make-fqdn () - "Return user's fully qualified domain name." - (let* ((system-name (system-name)) - (user-mail (message-user-mail-address)) - (user-domain - (if (and user-mail - (string-match "@\\(.*\\)\\'" user-mail)) - (match-string 1 user-mail))) - (case-fold-search t)) - (cond - ((and message-user-fqdn - (stringp message-user-fqdn) - (string-match message-valid-fqdn-regexp message-user-fqdn) - (not (string-match message-bogus-system-names message-user-fqdn))) - ;; `message-user-fqdn' seems to be valid - message-user-fqdn) - ((and (string-match message-valid-fqdn-regexp system-name) - (not (string-match message-bogus-system-names system-name))) - ;; `system-name' returned the right result. - system-name) - ;; Try `mail-host-address'. - ((and (boundp 'mail-host-address) - (stringp mail-host-address) - (string-match message-valid-fqdn-regexp mail-host-address) - (not (string-match message-bogus-system-names mail-host-address))) - mail-host-address) - ;; We try `user-mail-address' as a backup. - ((and user-domain - (stringp user-domain) - (string-match message-valid-fqdn-regexp user-domain) - (not (string-match message-bogus-system-names user-domain))) - user-domain) - ;; Default to this bogus thing. - (t - (concat system-name - ".i-did-not-set--mail-host-address--so-tickle-me"))))) - -(defun message-make-host-name () - "Return the name of the host." - (let ((fqdn (message-make-fqdn))) - (string-match "^[^.]+\\." fqdn) - (substring fqdn 0 (1- (match-end 0))))) - -(defun message-make-domain () - "Return the domain name." - (or mail-host-address - (message-make-fqdn))) - -(defun message-to-list-only () - "Send a message to the list only. -Remove all addresses but the list address from To and Cc headers." - (interactive) - (let ((listaddr (message-make-mail-followup-to t))) - (when listaddr - (save-excursion - (message-remove-header "to") - (message-remove-header "cc") - (message-position-on-field "To" "X-Draft-From") - (insert listaddr))))) - -(defun message-make-mail-followup-to (&optional only-show-subscribed) - "Return the Mail-Followup-To header. -If passed the optional argument ONLY-SHOW-SUBSCRIBED only return the -subscribed address (and not the additional To and Cc header contents)." - (let* ((case-fold-search t) - (to (message-fetch-field "To")) - (cc (message-fetch-field "cc")) - (msg-recipients (concat to (and to cc ", ") cc)) - (recipients - (mapcar 'mail-strip-quoted-names - (message-tokenize-header msg-recipients))) - (file-regexps - (if message-subscribed-address-file - (let (begin end item re) - (save-excursion - (with-temp-buffer - (insert-file-contents message-subscribed-address-file) - (while (not (eobp)) - (setq begin (point)) - (forward-line 1) - (setq end (point)) - (if (bolp) (setq end (1- end))) - (setq item (regexp-quote (buffer-substring begin end))) - (if re (setq re (concat re "\\|" item)) - (setq re (concat "\\`\\(" item)))) - (and re (list (concat re "\\)\\'")))))))) - (mft-regexps (apply 'append message-subscribed-regexps - (mapcar 'regexp-quote - message-subscribed-addresses) - file-regexps - (mapcar 'funcall - message-subscribed-address-functions)))) - (save-match-data - (let ((subscribed-lists nil) - (list - (loop for recipient in recipients - when (loop for regexp in mft-regexps - when (string-match regexp recipient) return t) - return recipient))) - (when list - (if only-show-subscribed - list - msg-recipients)))))) - -(defun message-idna-to-ascii-rhs-1 (header) - "Interactively potentially IDNA encode domain names in HEADER." - (let ((field (message-fetch-field header)) - rhs ace address) - (when field - (dolist (rhs - (mm-delete-duplicates - (mapcar (lambda (rhs) (or (cadr (split-string rhs "@")) "")) - (mapcar 'downcase - (mapcar - 'car (mail-header-parse-addresses field)))))) - (setq ace (downcase (idna-to-ascii rhs))) - (when (and (not (equal rhs ace)) - (or (not (eq message-use-idna 'ask)) - (y-or-n-p (format "Replace %s with %s in %s:? " - rhs ace header)))) - (goto-char (point-min)) - (while (re-search-forward (concat "^" header ":") nil t) - (message-narrow-to-field) - (while (search-forward (concat "@" rhs) nil t) - (replace-match (concat "@" ace) t t)) - (goto-char (point-max)) - (widen))))))) - -(defun message-idna-to-ascii-rhs () - "Possibly IDNA encode non-ASCII domain names in From:, To: and Cc: headers. -See `message-idna-encode'." - (interactive) - (when message-use-idna - (save-excursion - (save-restriction - (message-narrow-to-head) - (message-idna-to-ascii-rhs-1 "From") - (message-idna-to-ascii-rhs-1 "To") - (message-idna-to-ascii-rhs-1 "Reply-To") - (message-idna-to-ascii-rhs-1 "Mail-Reply-To") - (message-idna-to-ascii-rhs-1 "Mail-Followup-To") - (message-idna-to-ascii-rhs-1 "Cc"))))) - -(defun message-generate-headers (headers) - "Prepare article HEADERS. -Headers already prepared in the buffer are not modified." - (setq headers (append headers message-required-headers)) - (save-restriction - (message-narrow-to-headers) - (let* ((Date (message-make-date)) - (Message-ID (message-make-message-id)) - (Organization (message-make-organization)) - (From (message-make-from)) - (Path (message-make-path)) - (Subject nil) - (Newsgroups nil) - (In-Reply-To (message-make-in-reply-to)) - (References (message-make-references)) - (To nil) - (Distribution (message-make-distribution)) - (Lines (message-make-lines)) - (User-Agent message-newsreader) - (Expires (message-make-expires)) - (case-fold-search t) - (optionalp nil) - header value elem header-string) - ;; First we remove any old generated headers. - (let ((headers message-deletable-headers)) - (unless (buffer-modified-p) - (setq headers (delq 'Message-ID (copy-sequence headers)))) - (while headers - (goto-char (point-min)) - (and (re-search-forward - (concat "^" (symbol-name (car headers)) ": *") nil t) - (get-text-property (1+ (match-beginning 0)) 'message-deletable) - (message-delete-line)) - (pop headers))) - ;; Go through all the required headers and see if they are in the - ;; articles already. If they are not, or are empty, they are - ;; inserted automatically - except for Subject, Newsgroups and - ;; Distribution. - (while headers - (goto-char (point-min)) - (setq elem (pop headers)) - (if (consp elem) - (if (eq (car elem) 'optional) - (setq header (cdr elem) - optionalp t) - (setq header (car elem))) - (setq header elem)) - (setq header-string (if (stringp header) - header - (symbol-name header))) - (when (or (not (re-search-forward - (concat "^" - (regexp-quote (downcase header-string)) - ":") - nil t)) - (progn - ;; The header was found. We insert a space after the - ;; colon, if there is none. - (if (/= (char-after) ? ) (insert " ") (forward-char 1)) - ;; Find out whether the header is empty. - (looking-at "[ \t]*\n[^ \t]"))) - ;; So we find out what value we should insert. - (setq value - (cond - ((and (consp elem) - (eq (car elem) 'optional) - (not (member header-string message-inserted-headers))) - ;; This is an optional header. If the cdr of this - ;; is something that is nil, then we do not insert - ;; this header. - (setq header (cdr elem)) - (or (and (functionp (cdr elem)) - (funcall (cdr elem))) - (and (boundp (cdr elem)) - (symbol-value (cdr elem))))) - ((consp elem) - ;; The element is a cons. Either the cdr is a - ;; string to be inserted verbatim, or it is a - ;; function, and we insert the value returned from - ;; this function. - (or (and (stringp (cdr elem)) - (cdr elem)) - (and (functionp (cdr elem)) - (funcall (cdr elem))))) - ((and (boundp header) - (symbol-value header)) - ;; The element is a symbol. We insert the value - ;; of this symbol, if any. - (symbol-value header)) - ((not (message-check-element - (intern (downcase (symbol-name header))))) - ;; We couldn't generate a value for this header, - ;; so we just ask the user. - (read-from-minibuffer - (format "Empty header for %s; enter value: " header))))) - ;; Finally insert the header. - (when (and value - (not (equal value ""))) - (save-excursion - (if (bolp) - (progn - ;; This header didn't exist, so we insert it. - (goto-char (point-max)) - (let ((formatter - (cdr (assq header message-header-format-alist)))) - (if formatter - (funcall formatter header value) - (insert header-string ": " value)) - ;; We check whether the value was ended by a - ;; newline. If now, we insert one. - (unless (bolp) - (insert "\n")) - (forward-line -1))) - ;; The value of this header was empty, so we clear - ;; totally and insert the new value. - (delete-region (point) (gnus-point-at-eol)) - ;; If the header is optional, and the header was - ;; empty, we con't insert it anyway. - (unless optionalp - (push header-string message-inserted-headers) - (insert value))) - ;; Add the deletable property to the headers that require it. - (and (memq header message-deletable-headers) - (progn (beginning-of-line) (looking-at "[^:]+: ")) - (add-text-properties - (point) (match-end 0) - '(message-deletable t face italic) (current-buffer))))))) - ;; Insert new Sender if the From is strange. - (let ((from (message-fetch-field "from")) - (sender (message-fetch-field "sender")) - (secure-sender (message-make-sender))) - (when (and from - (not (message-check-element 'sender)) - (not (string= - (downcase - (cadr (mail-extract-address-components from))) - (downcase secure-sender))) - (or (null sender) - (not - (string= - (downcase - (cadr (mail-extract-address-components sender))) - (downcase secure-sender))))) - (goto-char (point-min)) - ;; Rename any old Sender headers to Original-Sender. - (when (re-search-forward "^\\(Original-\\)*Sender:" nil t) - (beginning-of-line) - (insert "Original-") - (beginning-of-line)) - (when (or (message-news-p) - (string-match "@.+\\.." secure-sender)) - (insert "Sender: " secure-sender "\n")))) - ;; Check for IDNA - (message-idna-to-ascii-rhs)))) - -(defun message-insert-courtesy-copy () - "Insert a courtesy message in mail copies of combined messages." - (let (newsgroups) - (save-excursion - (save-restriction - (message-narrow-to-headers) - (when (setq newsgroups (message-fetch-field "newsgroups")) - (goto-char (point-max)) - (insert "Posted-To: " newsgroups "\n"))) - (forward-line 1) - (when message-courtesy-message - (cond - ((string-match "%s" message-courtesy-message) - (insert (format message-courtesy-message newsgroups))) - (t - (insert message-courtesy-message))))))) - -;;; -;;; Setting up a message buffer -;;; - -(defun message-fill-address (header value) - (save-restriction - (narrow-to-region (point) (point)) - (insert (capitalize (symbol-name header)) - ": " - (if (consp value) (car value) value) - "\n") - (narrow-to-region (point-min) (1- (point-max))) - (let (quoted last) - (goto-char (point-min)) - (while (not (eobp)) - (skip-chars-forward "^,\"" (point-max)) - (if (or (eq (char-after) ?,) - (eobp)) - (when (not quoted) - (if (and (> (current-column) 78) - last) - (progn - (save-excursion - (goto-char last) - (insert "\n\t")) - (setq last (1+ (point)))) - (setq last (1+ (point))))) - (setq quoted (not quoted))) - (unless (eobp) - (forward-char 1)))) - (goto-char (point-max)) - (widen) - (forward-line 1))) - -(defun message-split-line () - "Split current line, moving portion beyond point vertically down. -If the current line has `message-yank-prefix', insert it on the new line." - (interactive "*") - (condition-case nil - (split-line message-yank-prefix) ;; Emacs 22.1+ supports arg. - (error - (split-line)))) - -(defun message-fill-header (header value) - (let ((begin (point)) - (fill-column 78) - (fill-prefix "\t")) - (insert (capitalize (symbol-name header)) - ": " - (if (consp value) (car value) value) - "\n") - (save-restriction - (narrow-to-region begin (point)) - (fill-region-as-paragraph begin (point)) - ;; Tapdance around looong Message-IDs. - (forward-line -1) - (when (looking-at "[ \t]*$") - (message-delete-line)) - (goto-char begin) - (re-search-forward ":" nil t) - (when (looking-at "\n[ \t]+") - (replace-match " " t t)) - (goto-char (point-max))))) - -(defun message-shorten-1 (list cut surplus) - "Cut SURPLUS elements out of LIST, beginning with CUTth one." - (setcdr (nthcdr (- cut 2) list) - (nthcdr (+ (- cut 2) surplus 1) list))) - -(defun message-shorten-references (header references) - "Trim REFERENCES to be 21 Message-ID long or less, and fold them. -If folding is disallowed, also check that the REFERENCES are less -than 988 characters long, and if they are not, trim them until they are." - (let ((maxcount 21) - (count 0) - (cut 2) - refs) - (with-temp-buffer - (insert references) - (goto-char (point-min)) - ;; Cons a list of valid references. - (while (re-search-forward "<[^>]+>" nil t) - (push (match-string 0) refs)) - (setq refs (nreverse refs) - count (length refs))) - - ;; If the list has more than MAXCOUNT elements, trim it by - ;; removing the CUTth element and the required number of - ;; elements that follow. - (when (> count maxcount) - (let ((surplus (- count maxcount))) - (message-shorten-1 refs cut surplus) - (decf count surplus))) - - ;; If folding is disallowed, make sure the total length (including - ;; the spaces between) will be less than MAXSIZE characters. - ;; - ;; Only disallow folding for News messages. At this point the headers - ;; have not been generated, thus we use message-this-is-news directly. - (when (and message-this-is-news message-cater-to-broken-inn) - (let ((maxsize 988) - (totalsize (+ (apply #'+ (mapcar #'length refs)) - (1- count))) - (surplus 0) - (ptr (nthcdr (1- cut) refs))) - ;; Decide how many elements to cut off... - (while (> totalsize maxsize) - (decf totalsize (1+ (length (car ptr)))) - (incf surplus) - (setq ptr (cdr ptr))) - ;; ...and do it. - (when (> surplus 0) - (message-shorten-1 refs cut surplus)))) - - ;; Finally, collect the references back into a string and insert - ;; it into the buffer. - (let ((refstring (mapconcat #'identity refs " "))) - (if (and message-this-is-news message-cater-to-broken-inn) - (insert (capitalize (symbol-name header)) ": " - refstring "\n") - (message-fill-header header refstring))))) - -(defun message-position-point () - "Move point to where the user probably wants to find it." - (message-narrow-to-headers) - (cond - ((re-search-forward "^[^:]+:[ \t]*$" nil t) - (search-backward ":" ) - (widen) - (forward-char 1) - (if (eq (char-after) ? ) - (forward-char 1) - (insert " "))) - (t - (goto-char (point-max)) - (widen) - (forward-line 1) - (unless (looking-at "$") - (forward-line 2))) - (sit-for 0))) - -(defcustom message-beginning-of-line t - "Whether \\\\[message-beginning-of-line]\ - goes to beginning of header values." - :version "22.1" - :group 'message-buffers - :link '(custom-manual "(message)Movement") - :type 'boolean) - -(defun message-beginning-of-line (&optional n) - "Move point to beginning of header value or to beginning of line. -The prefix argument N is passed directly to `beginning-of-line'. - -This command is identical to `beginning-of-line' if point is -outside the message header or if the option `message-beginning-of-line' -is nil. - -If point is in the message header and on a (non-continued) header -line, move point to the beginning of the header value or the beginning of line, -whichever is closer. If point is already at beginning of line, move point to -beginning of header value. Therefore, repeated calls will toggle point -between beginning of field and beginning of line." - (interactive "p") - (let ((zrs 'zmacs-region-stays)) - (when (and (interactive-p) (boundp zrs)) - (set zrs t))) - (if (and message-beginning-of-line - (message-point-in-header-p)) - (let* ((here (point)) - (bol (progn (beginning-of-line n) (point))) - (eol (gnus-point-at-eol)) - (eoh (re-search-forward ": *" eol t))) - (goto-char - (if (and eoh (or (< eoh here) (= bol here))) - eoh bol))) - (beginning-of-line n))) - -(defun message-buffer-name (type &optional to group) - "Return a new (unique) buffer name based on TYPE and TO." - (cond - ;; Generate a new buffer name The Message Way. - ((memq message-generate-new-buffers '(unique t)) - (generate-new-buffer-name - (concat "*" type - (if to - (concat " to " - (or (car (mail-extract-address-components to)) - to) "") - "") - (if (and group (not (string= group ""))) (concat " on " group) "") - "*"))) - ;; Check whether `message-generate-new-buffers' is a function, - ;; and if so, call it. - ((functionp message-generate-new-buffers) - (funcall message-generate-new-buffers type to group)) - ((eq message-generate-new-buffers 'unsent) - (generate-new-buffer-name - (concat "*unsent " type - (if to - (concat " to " - (or (car (mail-extract-address-components to)) - to) "") - "") - (if (and group (not (string= group ""))) (concat " on " group) "") - "*"))) - ;; Search for the existing message buffer with the specified name. - (t - (let* ((new (if (eq message-generate-new-buffers 'standard) - (generate-new-buffer-name (concat "*" type " message*")) - (let ((message-generate-new-buffers 'unique)) - (message-buffer-name type to group)))) - (regexp (concat "\\`" - (regexp-quote - (if (string-match "<[0-9]+>\\'" new) - (substring new 0 (match-beginning 0)) - new)) - "\\(?:<\\([0-9]+\\)>\\)?\\'")) - (case-fold-search nil)) - (or (cdar - (last - (sort - (delq nil - (mapcar - (lambda (b) - (when (and (string-match regexp (setq b (buffer-name b))) - (eq (with-current-buffer b major-mode) - 'message-mode)) - (cons (string-to-number (or (match-string 1 b) "1")) - b))) - (buffer-list))) - 'car-less-than-car))) - new))))) - -(defun message-pop-to-buffer (name &optional switch-function) - "Pop to buffer NAME, and warn if it already exists and is modified." - (let ((buffer (get-buffer name))) - (if (and buffer - (buffer-name buffer)) - (let ((window (get-buffer-window buffer 0))) - (if window - ;; Raise the frame already displaying the message buffer. - (progn - (gnus-select-frame-set-input-focus (window-frame window)) - (select-window window)) - (funcall (or switch-function 'pop-to-buffer) buffer) - (set-buffer buffer)) - (when (and (buffer-modified-p) - (not (prog1 - (y-or-n-p - "Message already being composed; erase? ") - (message nil)))) - (error "Message being composed"))) - (funcall (or switch-function 'pop-to-buffer) name) - (set-buffer name)) - (erase-buffer) - (message-mode))) - -(defun message-do-send-housekeeping () - "Kill old message buffers." - ;; We might have sent this buffer already. Delete it from the - ;; list of buffers. - (setq message-buffer-list (delq (current-buffer) message-buffer-list)) - (while (and message-max-buffers - message-buffer-list - (>= (length message-buffer-list) message-max-buffers)) - ;; Kill the oldest buffer -- unless it has been changed. - (let ((buffer (pop message-buffer-list))) - (when (and (buffer-name buffer) - (not (buffer-modified-p buffer))) - (kill-buffer buffer)))) - ;; Rename the buffer. - (if message-send-rename-function - (funcall message-send-rename-function) - ;; Note: mail-abbrevs of XEmacs renames buffer name behind Gnus. - (when (string-match - "\\`\\*\\(sent \\|unsent \\)?\\(.+\\)\\*[^\\*]*\\|\\`mail to " - (buffer-name)) - (let ((name (match-string 2 (buffer-name))) - to group) - (if (not (or (null name) - (string-equal name "mail") - (string-equal name "posting"))) - (setq name (concat "*sent " name "*")) - (message-narrow-to-headers) - (setq to (message-fetch-field "to")) - (setq group (message-fetch-field "newsgroups")) - (widen) - (setq name - (cond - (to (concat "*sent mail to " - (or (car (mail-extract-address-components to)) - to) "*")) - ((and group (not (string= group ""))) - (concat "*sent posting on " group "*")) - (t "*sent mail*")))) - (unless (string-equal name (buffer-name)) - (rename-buffer name t))))) - ;; Push the current buffer onto the list. - (when message-max-buffers - (setq message-buffer-list - (nconc message-buffer-list (list (current-buffer)))))) - -(defun message-mail-user-agent () - (let ((mua (cond - ((not message-mail-user-agent) nil) - ((eq message-mail-user-agent t) mail-user-agent) - (t message-mail-user-agent)))) - (if (memq mua '(message-user-agent gnus-user-agent)) - nil - mua))) - -(defun message-setup (headers &optional replybuffer actions - continue switch-function) - (let ((mua (message-mail-user-agent)) - subject to field yank-action) - (if (not (and message-this-is-mail mua)) - (message-setup-1 headers replybuffer actions) - (if replybuffer - (setq yank-action (list 'insert-buffer replybuffer))) - (setq headers (copy-sequence headers)) - (setq field (assq 'Subject headers)) - (when field - (setq subject (cdr field)) - (setq headers (delq field headers))) - (setq field (assq 'To headers)) - (when field - (setq to (cdr field)) - (setq headers (delq field headers))) - (let ((mail-user-agent mua)) - (compose-mail to subject - (mapcar (lambda (item) - (cons - (format "%s" (car item)) - (cdr item))) - headers) - continue switch-function yank-action actions))))) - -(defun message-headers-to-generate (headers included-headers excluded-headers) - "Return a list that includes all headers from HEADERS. -If INCLUDED-HEADERS is a list, just include those headers. If it is -t, include all headers. In any case, headers from EXCLUDED-HEADERS -are not included." - (let ((result nil) - header-name) - (dolist (header headers) - (setq header-name (cond - ((and (consp header) - (eq (car header) 'optional)) - ;; On the form (optional . Header) - (cdr header)) - ((consp header) - ;; On the form (Header . function) - (car header)) - (t - ;; Just a Header. - header))) - (when (and (not (memq header-name excluded-headers)) - (or (eq included-headers t) - (memq header-name included-headers))) - (push header result))) - (nreverse result))) - -(defun message-setup-1 (headers &optional replybuffer actions) - (dolist (action actions) - (condition-case nil - (add-to-list 'message-send-actions - `(apply ',(car action) ',(cdr action))))) - (setq message-reply-buffer replybuffer) - (goto-char (point-min)) - ;; Insert all the headers. - (mail-header-format - (let ((h headers) - (alist message-header-format-alist)) - (while h - (unless (assq (caar h) message-header-format-alist) - (push (list (caar h)) alist)) - (pop h)) - alist) - headers) - (delete-region (point) (progn (forward-line -1) (point))) - (when message-default-headers - (insert message-default-headers) - (or (bolp) (insert ?\n))) - (put-text-property - (point) - (progn - (insert mail-header-separator "\n") - (1- (point))) - 'read-only nil) - (forward-line -1) - (when (message-news-p) - (when message-default-news-headers - (insert message-default-news-headers) - (or (bolp) (insert ?\n))) - (when message-generate-headers-first - (message-generate-headers - (message-headers-to-generate - (append message-required-news-headers - message-required-headers) - message-generate-headers-first - '(Lines Subject))))) - (when (message-mail-p) - (when message-default-mail-headers - (insert message-default-mail-headers) - (or (bolp) (insert ?\n))) - (when message-generate-headers-first - (message-generate-headers - (message-headers-to-generate - (append message-required-mail-headers - message-required-headers) - message-generate-headers-first - '(Lines Subject))))) - (run-hooks 'message-signature-setup-hook) - (message-insert-signature) - (save-restriction - (message-narrow-to-headers) - (run-hooks 'message-header-setup-hook)) - (set-buffer-modified-p nil) - (setq buffer-undo-list nil) - (run-hooks 'message-setup-hook) - ;; Do this last to give it precedence over posting styles, etc. - (when (message-mail-p) - (save-restriction - (message-narrow-to-headers) - (if message-alternative-emails - (message-use-alternative-email-as-from)))) - (message-position-point) - (undo-boundary)) - -(defun message-set-auto-save-file-name () - "Associate the message buffer with a file in the drafts directory." - (when message-auto-save-directory - (unless (file-directory-p - (directory-file-name message-auto-save-directory)) - (make-directory message-auto-save-directory t)) - (if (gnus-alive-p) - (setq message-draft-article - (nndraft-request-associate-buffer "drafts")) - (setq buffer-file-name (expand-file-name - (if (memq system-type - '(ms-dos ms-windows windows-nt - cygwin cygwin32 win32 w32 - mswindows)) - "message" - "*message*") - message-auto-save-directory)) - (setq buffer-auto-save-file-name (make-auto-save-file-name))) - (clear-visited-file-modtime) - (setq buffer-file-coding-system message-draft-coding-system))) - -(defun message-disassociate-draft () - "Disassociate the message buffer from the drafts directory." - (when message-draft-article - (nndraft-request-expire-articles - (list message-draft-article) "nndraft:drafts" nil t))) - -(defun message-insert-headers () - "Generate the headers for the article." - (interactive) - (save-excursion - (save-restriction - (message-narrow-to-headers) - (when (message-news-p) - (message-generate-headers - (delq 'Lines - (delq 'Subject - (copy-sequence message-required-news-headers))))) - (when (message-mail-p) - (message-generate-headers - (delq 'Lines - (delq 'Subject - (copy-sequence message-required-mail-headers)))))))) - - - -;;; -;;; Commands for interfacing with message -;;; - -;;;###autoload -(defun message-mail (&optional to subject - other-headers continue switch-function - yank-action send-actions) - "Start editing a mail message to be sent. -OTHER-HEADERS is an alist of header/value pairs. CONTINUE says whether -to continue editing a message already being composed. SWITCH-FUNCTION -is a function used to switch to and display the mail buffer." - (interactive) - (let ((message-this-is-mail t) replybuffer) - (unless (message-mail-user-agent) - (message-pop-to-buffer - ;; Search for the existing message buffer if `continue' is non-nil. - (let ((message-generate-new-buffers - (when (or (not continue) - (eq message-generate-new-buffers 'standard) - (functionp message-generate-new-buffers)) - message-generate-new-buffers))) - (message-buffer-name "mail" to)) - switch-function)) - ;; FIXME: message-mail should do something if YANK-ACTION is not - ;; insert-buffer. - (and (consp yank-action) (eq (car yank-action) 'insert-buffer) - (setq replybuffer (nth 1 yank-action))) - (message-setup - (nconc - `((To . ,(or to "")) (Subject . ,(or subject ""))) - (when other-headers other-headers)) - replybuffer send-actions continue switch-function) - ;; FIXME: Should return nil if failure. - t)) - -;;;###autoload -(defun message-news (&optional newsgroups subject) - "Start editing a news article to be sent." - (interactive) - (let ((message-this-is-news t)) - (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups)) - (message-setup `((Newsgroups . ,(or newsgroups "")) - (Subject . ,(or subject "")))))) - -(defun message-get-reply-headers (wide &optional to-address address-headers) - (let (follow-to mct never-mct to cc author mft recipients) - ;; Find all relevant headers we need. - (save-restriction - (message-narrow-to-headers-or-head) - ;; Gmane renames "To". Look at "Original-To", too, if it is present in - ;; message-header-synonyms. - (setq to (or (message-fetch-field "to") - (and (loop for synonym in message-header-synonyms - when (memq 'Original-To synonym) - return t) - (message-fetch-field "original-to"))) - cc (message-fetch-field "cc") - mct (message-fetch-field "mail-copies-to") - author (or (message-fetch-field "mail-reply-to") - (message-fetch-field "reply-to") - (message-fetch-field "from") - "") - mft (and message-use-mail-followup-to - (message-fetch-field "mail-followup-to")))) - - ;; Handle special values of Mail-Copies-To. - (when mct - (cond ((or (equal (downcase mct) "never") - (equal (downcase mct) "nobody")) - (setq never-mct t) - (setq mct nil)) - ((or (equal (downcase mct) "always") - (equal (downcase mct) "poster")) - (setq mct author)))) - - (save-match-data - ;; Build (textual) list of new recipient addresses. - (cond - ((not wide) - (setq recipients (concat ", " author))) - (address-headers - (dolist (header address-headers) - (let ((value (message-fetch-field header))) - (when value - (setq recipients (concat recipients ", " value)))))) - ((and mft - (string-match "[^ \t,]" mft) - (or (not (eq message-use-mail-followup-to 'ask)) - (message-y-or-n-p "Obey Mail-Followup-To? " t "\ -You should normally obey the Mail-Followup-To: header. In this -article, it has the value of - -" mft " - -which directs your response to " (if (string-match "," mft) - "the specified addresses" - "that address only") ". - -Most commonly, Mail-Followup-To is used by a mailing list poster to -express that responses should be sent to just the list, and not the -poster as well. - -If a message is posted to several mailing lists, Mail-Followup-To may -also be used to direct the following discussion to one list only, -because discussions that are spread over several lists tend to be -fragmented and very difficult to follow. - -Also, some source/announcement lists are not intended for discussion; -responses here are directed to other addresses. - -You may customize the variable `message-use-mail-followup-to', if you -want to get rid of this query permanently."))) - (setq recipients (concat ", " mft))) - (to-address - (setq recipients (concat ", " to-address)) - ;; If the author explicitly asked for a copy, we don't deny it to them. - (if mct (setq recipients (concat recipients ", " mct)))) - (t - (setq recipients (if never-mct "" (concat ", " author))) - (if to (setq recipients (concat recipients ", " to))) - (if cc (setq recipients (concat recipients ", " cc))) - (if mct (setq recipients (concat recipients ", " mct))))) - (if (>= (length recipients) 2) - ;; Strip the leading ", ". - (setq recipients (substring recipients 2))) - ;; Squeeze whitespace. - (while (string-match "[ \t][ \t]+" recipients) - (setq recipients (replace-match " " t t recipients))) - ;; Remove addresses that match `rmail-dont-reply-to-names'. - (let ((rmail-dont-reply-to-names message-dont-reply-to-names)) - (setq recipients (rmail-dont-reply-to recipients))) - ;; Perhaps "Mail-Copies-To: never" removed the only address? - (if (string-equal recipients "") - (setq recipients author)) - ;; Convert string to a list of (("foo@bar" . "Name ") ...). - (setq recipients - (mapcar - (lambda (addr) - (cons (downcase (mail-strip-quoted-names addr)) addr)) - (message-tokenize-header recipients))) - ;; Remove first duplicates. (Why not all duplicates? Is this a bug?) - (let ((s recipients)) - (while s - (setq recipients (delq (assoc (car (pop s)) s) recipients)))) - - ;; Remove hierarchical lists that are contained within each other, - ;; if message-hierarchical-addresses is defined. - (when message-hierarchical-addresses - (let ((plain-addrs (mapcar 'car recipients)) - subaddrs recip) - (while plain-addrs - (setq subaddrs (assoc (car plain-addrs) - message-hierarchical-addresses) - plain-addrs (cdr plain-addrs)) - (when subaddrs - (setq subaddrs (cdr subaddrs)) - (while subaddrs - (setq recip (assoc (car subaddrs) recipients) - subaddrs (cdr subaddrs)) - (if recip - (setq recipients (delq recip recipients)))))))) - - ;; Build the header alist. Allow the user to be asked whether - ;; or not to reply to all recipients in a wide reply. - (setq follow-to (list (cons 'To (cdr (pop recipients))))) - (when (and recipients - (or (not message-wide-reply-confirm-recipients) - (y-or-n-p "Reply to all recipients? "))) - (setq recipients (mapconcat - (lambda (addr) (cdr addr)) recipients ", ")) - (if (string-match "^ +" recipients) - (setq recipients (substring recipients (match-end 0)))) - (push (cons 'Cc recipients) follow-to))) - follow-to)) - -(defcustom message-simplify-subject-functions - '(message-strip-list-identifiers - message-strip-subject-re - message-strip-subject-trailing-was - message-strip-subject-encoded-words) - "List of functions taking a string argument that simplify subjects. -The functions are applied when replying to a message. - -Useful functions to put in this list include: -`message-strip-list-identifiers', `message-strip-subject-re', -`message-strip-subject-trailing-was', and -`message-strip-subject-encoded-words'." - :version "22.1" ;; Gnus 5.10.9 - :group 'message-various - :type '(repeat function)) - -(defun message-simplify-subject (subject &optional functions) - "Return simplified SUBJECT." - (unless functions - ;; Simplify fully: - (setq functions message-simplify-subject-functions)) - (when (and (memq 'message-strip-list-identifiers functions) - gnus-list-identifiers) - (setq subject (message-strip-list-identifiers subject))) - (when (memq 'message-strip-subject-re functions) - (setq subject (concat "Re: " (message-strip-subject-re subject)))) - (when (and (memq 'message-strip-subject-trailing-was functions) - message-subject-trailing-was-query) - (setq subject (message-strip-subject-trailing-was subject))) - (when (memq 'message-strip-subject-encoded-words functions) - (setq subject (message-strip-subject-encoded-words subject))) - subject) - -;;;###autoload -(defun message-reply (&optional to-address wide) - "Start editing a reply to the article in the current buffer." - (interactive) - (require 'gnus-sum) ; for gnus-list-identifiers - (let ((cur (current-buffer)) - from subject date reply-to to cc - references message-id follow-to - (inhibit-point-motion-hooks t) - (message-this-is-mail t) - gnus-warning) - (save-restriction - (message-narrow-to-head-1) - ;; Allow customizations to have their say. - (if (not wide) - ;; This is a regular reply. - (when (functionp message-reply-to-function) - (save-excursion - (setq follow-to (funcall message-reply-to-function)))) - ;; This is a followup. - (when (functionp message-wide-reply-to-function) - (save-excursion - (setq follow-to - (funcall message-wide-reply-to-function))))) - (setq message-id (message-fetch-field "message-id" t) - references (message-fetch-field "references") - date (message-fetch-field "date") - from (or (message-fetch-field "from") "nobody") - subject (or (message-fetch-field "subject") "none")) - - ;; Strip list identifiers, "Re: ", and "was:" - (setq subject (message-simplify-subject subject)) - - (when (and (setq gnus-warning (message-fetch-field "gnus-warning")) - (string-match "<[^>]+>" gnus-warning)) - (setq message-id (match-string 0 gnus-warning))) - - (unless follow-to - (setq follow-to (message-get-reply-headers wide to-address)))) - - (unless (message-mail-user-agent) - (message-pop-to-buffer - (message-buffer-name - (if wide "wide reply" "reply") from - (if wide to-address nil)))) - - (setq message-reply-headers - (vector 0 subject from date message-id references 0 0 "")) - - (message-setup - `((Subject . ,subject) - ,@follow-to) - cur))) - -;;;###autoload -(defun message-wide-reply (&optional to-address) - "Make a \"wide\" reply to the message in the current buffer." - (interactive) - (message-reply to-address t)) - -;;;###autoload -(defun message-followup (&optional to-newsgroups) - "Follow up to the message in the current buffer. -If TO-NEWSGROUPS, use that as the new Newsgroups line." - (interactive) - (require 'gnus-sum) ; for gnus-list-identifiers - (let ((cur (current-buffer)) - from subject date reply-to mrt mct - references message-id follow-to - (inhibit-point-motion-hooks t) - (message-this-is-news t) - followup-to distribution newsgroups gnus-warning posted-to) - (save-restriction - (narrow-to-region - (goto-char (point-min)) - (if (search-forward "\n\n" nil t) - (1- (point)) - (point-max))) - (when (functionp message-followup-to-function) - (setq follow-to - (funcall message-followup-to-function))) - (setq from (message-fetch-field "from") - date (message-fetch-field "date") - subject (or (message-fetch-field "subject") "none") - references (message-fetch-field "references") - message-id (message-fetch-field "message-id" t) - followup-to (message-fetch-field "followup-to") - newsgroups (message-fetch-field "newsgroups") - posted-to (message-fetch-field "posted-to") - reply-to (message-fetch-field "reply-to") - mrt (message-fetch-field "mail-reply-to") - distribution (message-fetch-field "distribution") - mct (message-fetch-field "mail-copies-to")) - (when (and (setq gnus-warning (message-fetch-field "gnus-warning")) - (string-match "<[^>]+>" gnus-warning)) - (setq message-id (match-string 0 gnus-warning))) - ;; Remove bogus distribution. - (when (and (stringp distribution) - (let ((case-fold-search t)) - (string-match "world" distribution))) - (setq distribution nil)) - ;; Strip list identifiers, "Re: ", and "was:" - (setq subject (message-simplify-subject subject)) - (widen)) - - (message-pop-to-buffer (message-buffer-name "followup" from newsgroups)) - - (setq message-reply-headers - (vector 0 subject from date message-id references 0 0 "")) - - (message-setup - `((Subject . ,subject) - ,@(cond - (to-newsgroups - (list (cons 'Newsgroups to-newsgroups))) - (follow-to follow-to) - ((and followup-to message-use-followup-to) - (list - (cond - ((equal (downcase followup-to) "poster") - (if (or (eq message-use-followup-to 'use) - (message-y-or-n-p "Obey Followup-To: poster? " t "\ -You should normally obey the Followup-To: header. - -`Followup-To: poster' sends your response via e-mail instead of news. - -A typical situation where `Followup-To: poster' is used is when the poster -does not read the newsgroup, so he wouldn't see any replies sent to it. - -You may customize the variable `message-use-followup-to', if you -want to get rid of this query permanently.")) - (progn - (setq message-this-is-news nil) - (cons 'To (or mrt reply-to from ""))) - (cons 'Newsgroups newsgroups))) - (t - (if (or (equal followup-to newsgroups) - (not (eq message-use-followup-to 'ask)) - (message-y-or-n-p - (concat "Obey Followup-To: " followup-to "? ") t "\ -You should normally obey the Followup-To: header. - - `Followup-To: " followup-to "' -directs your response to " (if (string-match "," followup-to) - "the specified newsgroups" - "that newsgroup only") ". - -If a message is posted to several newsgroups, Followup-To is often -used to direct the following discussion to one newsgroup only, -because discussions that are spread over several newsgroup tend to -be fragmented and very difficult to follow. - -Also, some source/announcement newsgroups are not intended for discussion; -responses here are directed to other newsgroups. - -You may customize the variable `message-use-followup-to', if you -want to get rid of this query permanently.")) - (cons 'Newsgroups followup-to) - (cons 'Newsgroups newsgroups)))))) - (posted-to - `((Newsgroups . ,posted-to))) - (t - `((Newsgroups . ,newsgroups)))) - ,@(and distribution (list (cons 'Distribution distribution))) - ,@(when (and mct - (not (or (equal (downcase mct) "never") - (equal (downcase mct) "nobody")))) - (list (cons 'Cc (if (or (equal (downcase mct) "always") - (equal (downcase mct) "poster")) - (or mrt reply-to from "") - mct))))) - - cur))) - -(defun message-is-yours-p () - "Non-nil means current article is yours. -If you have added 'cancel-messages to `message-shoot-gnksa-feet', all articles -are yours except those that have Cancel-Lock header not belonging to you. -Instead of shooting GNKSA feet, you should modify `message-alternative-emails' -regexp to match all of yours addresses." - ;; Canlock-logic as suggested by Per Abrahamsen - ;; - ;; - ;; IF article has cancel-lock THEN - ;; IF we can verify it THEN - ;; issue cancel - ;; ELSE - ;; error: cancellock: article is not yours - ;; ELSE - ;; Use old rules, comparing sender... - (save-excursion - (save-restriction - (message-narrow-to-head-1) - (if (message-fetch-field "Cancel-Lock") - (if (null (canlock-verify)) - t - (error "Failed to verify Cancel-lock: This article is not yours")) - (let (sender from) - (or - (message-gnksa-enable-p 'cancel-messages) - (and (setq sender (message-fetch-field "sender")) - (string-equal (downcase sender) - (downcase (message-make-sender)))) - ;; Email address in From field equals to our address - (and (setq from (message-fetch-field "from")) - (string-equal - (downcase (cadr (mail-extract-address-components from))) - (downcase (cadr (mail-extract-address-components - (message-make-from)))))) - ;; Email address in From field matches - ;; 'message-alternative-emails' regexp - (and from - message-alternative-emails - (string-match - message-alternative-emails - (cadr (mail-extract-address-components from)))))))))) - -;;;###autoload -(defun message-cancel-news (&optional arg) - "Cancel an article you posted. -If ARG, allow editing of the cancellation message." - (interactive "P") - (unless (message-news-p) - (error "This is not a news article; canceling is impossible")) - (let (from newsgroups message-id distribution buf) - (save-excursion - ;; Get header info from original article. - (save-restriction - (message-narrow-to-head-1) - (setq from (message-fetch-field "from") - newsgroups (message-fetch-field "newsgroups") - message-id (message-fetch-field "message-id" t) - distribution (message-fetch-field "distribution"))) - ;; Make sure that this article was written by the user. - (unless (message-is-yours-p) - (error "This article is not yours")) - (when (yes-or-no-p "Do you really want to cancel this article? ") - ;; Make control message. - (if arg - (message-news) - (setq buf (set-buffer (get-buffer-create " *message cancel*")))) - (erase-buffer) - (insert "Newsgroups: " newsgroups "\n" - "From: " from "\n" - "Subject: cmsg cancel " message-id "\n" - "Control: cancel " message-id "\n" - (if distribution - (concat "Distribution: " distribution "\n") - "") - mail-header-separator "\n" - message-cancel-message) - (run-hooks 'message-cancel-hook) - (unless arg - (message "Canceling your article...") - (if (let ((message-syntax-checks - 'dont-check-for-anything-just-trust-me)) - (funcall message-send-news-function)) - (message "Canceling your article...done")) - (kill-buffer buf)))))) - -;;;###autoload -(defun message-supersede () - "Start composing a message to supersede the current message. -This is done simply by taking the old article and adding a Supersedes -header line with the old Message-ID." - (interactive) - (let ((cur (current-buffer))) - ;; Check whether the user owns the article that is to be superseded. - (unless (message-is-yours-p) - (error "This article is not yours")) - ;; Get a normal message buffer. - (message-pop-to-buffer (message-buffer-name "supersede")) - (insert-buffer-substring cur) - (mime-to-mml) - (message-narrow-to-head-1) - ;; Remove unwanted headers. - (when message-ignored-supersedes-headers - (message-remove-header message-ignored-supersedes-headers t)) - (goto-char (point-min)) - (if (not (re-search-forward "^Message-ID: " nil t)) - (error "No Message-ID in this article") - (replace-match "Supersedes: " t t)) - (goto-char (point-max)) - (insert mail-header-separator) - (widen) - (forward-line 1))) - -;;;###autoload -(defun message-recover () - "Reread contents of current buffer from its last auto-save file." - (interactive) - (let ((file-name (make-auto-save-file-name))) - (cond ((save-window-excursion - (if (not (eq system-type 'vax-vms)) - (with-output-to-temp-buffer "*Directory*" - (with-current-buffer standard-output - (fundamental-mode)) ; for Emacs 20.4+ - (buffer-disable-undo standard-output) - (let ((default-directory "/")) - (call-process - "ls" nil standard-output nil "-l" file-name)))) - (yes-or-no-p (format "Recover auto save file %s? " file-name))) - (let ((buffer-read-only nil)) - (erase-buffer) - (insert-file-contents file-name nil))) - (t (error "message-recover cancelled"))))) - -;;; Washing Subject: - -(defun message-wash-subject (subject) - "Remove junk like \"Re:\", \"(fwd)\", etc. added to subject string SUBJECT. -Previous forwarders, replyers, etc. may add it." - (with-temp-buffer - (insert subject) - (goto-char (point-min)) - ;; strip Re/Fwd stuff off the beginning - (while (re-search-forward - "\\([Rr][Ee]:\\|[Ff][Ww][Dd]\\(\\[[0-9]*\\]\\)?:\\|[Ff][Ww]:\\)" nil t) - (replace-match "")) - - ;; and gnus-style forwards [foo@bar.com] subject - (goto-char (point-min)) - (while (re-search-forward "\\[[^ \t]*\\(@\\|\\.\\)[^ \t]*\\]" nil t) - (replace-match "")) - - ;; and off the end - (goto-char (point-max)) - (while (re-search-backward "([Ff][Ww][Dd])" nil t) - (replace-match "")) - - ;; and finally, any whitespace that was left-over - (goto-char (point-min)) - (while (re-search-forward "^[ \t]+" nil t) - (replace-match "")) - (goto-char (point-max)) - (while (re-search-backward "[ \t]+$" nil t) - (replace-match "")) - - (buffer-string))) - -;;; Forwarding messages. - -(defvar message-forward-decoded-p nil - "Non-nil means the original message is decoded.") - -(defun message-forward-subject-name-subject (subject) - "Generate a SUBJECT for a forwarded message. -The form is: [Source] Subject, where if the original message was mail, -Source is the name of the sender, and if the original message was -news, Source is the list of newsgroups is was posted to." - (let* ((group (message-fetch-field "newsgroups")) - (from (message-fetch-field "from")) - (prefix - (if group - (gnus-group-decoded-name group) - (or (and from (car (gnus-extract-address-components from))) - "(nowhere)")))) - (concat "[" - (if message-forward-decoded-p - prefix - (mail-decode-encoded-word-string prefix)) - "] " subject))) - -(defun message-forward-subject-author-subject (subject) - "Generate a SUBJECT for a forwarded message. -The form is: [Source] Subject, where if the original message was mail, -Source is the sender, and if the original message was news, Source is -the list of newsgroups is was posted to." - (let* ((group (message-fetch-field "newsgroups")) - (prefix - (if group - (gnus-group-decoded-name group) - (or (message-fetch-field "from") - "(nowhere)")))) - (concat "[" - (if message-forward-decoded-p - prefix - (mail-decode-encoded-word-string prefix)) - "] " subject))) - -(defun message-forward-subject-fwd (subject) - "Generate a SUBJECT for a forwarded message. -The form is: Fwd: Subject, where Subject is the original subject of -the message." - (if (string-match "^Fwd: " subject) - subject - (concat "Fwd: " subject))) - -(defun message-make-forward-subject () - "Return a Subject header suitable for the message in the current buffer." - (save-excursion - (save-restriction - (message-narrow-to-head-1) - (let ((funcs message-make-forward-subject-function) - (subject (message-fetch-field "Subject"))) - (setq subject - (if subject - (if message-forward-decoded-p - subject - (mail-decode-encoded-word-string subject)) - "")) - (if message-wash-forwarded-subjects - (setq subject (message-wash-subject subject))) - ;; Make sure funcs is a list. - (and funcs - (not (listp funcs)) - (setq funcs (list funcs))) - ;; Apply funcs in order, passing subject generated by previous - ;; func to the next one. - (while funcs - (when (functionp (car funcs)) - (setq subject (funcall (car funcs) subject))) - (setq funcs (cdr funcs))) - subject)))) - -(eval-when-compile - (defvar gnus-article-decoded-p)) - - -;;;###autoload -(defun message-forward (&optional news digest) - "Forward the current message via mail. -Optional NEWS will use news to forward instead of mail. -Optional DIGEST will use digest to forward." - (interactive "P") - (let* ((cur (current-buffer)) - (message-forward-decoded-p - (if (local-variable-p 'gnus-article-decoded-p (current-buffer)) - gnus-article-decoded-p ;; In an article buffer. - message-forward-decoded-p)) - (subject (message-make-forward-subject))) - (if news - (message-news nil subject) - (message-mail nil subject)) - (message-forward-make-body cur digest))) - -(defun message-forward-make-body-plain (forward-buffer) - (insert - "\n-------------------- Start of forwarded message --------------------\n") - (let ((b (point)) e) - (insert - (with-temp-buffer - (mm-disable-multibyte) - (insert - (with-current-buffer forward-buffer - (mm-with-unibyte-current-buffer (buffer-string)))) - (mm-enable-multibyte) - (mime-to-mml) - (goto-char (point-min)) - (when (looking-at "From ") - (replace-match "X-From-Line: ")) - (buffer-string))) - (setq e (point)) - (insert - "\n-------------------- End of forwarded message --------------------\n") - (when message-forward-ignored-headers - (save-restriction - (narrow-to-region b e) - (goto-char b) - (narrow-to-region (point) - (or (search-forward "\n\n" nil t) (point))) - (message-remove-header message-forward-ignored-headers t))))) - -(defun message-forward-make-body-mime (forward-buffer) - (insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n") - (let ((b (point)) e) - (save-restriction - (narrow-to-region (point) (point)) - (mml-insert-buffer forward-buffer) - (goto-char (point-min)) - (when (looking-at "From ") - (replace-match "X-From-Line: ")) - (goto-char (point-max))) - (setq e (point)) - (insert "<#/part>\n"))) - -(defun message-forward-make-body-mml (forward-buffer) - (insert "\n\n<#mml type=message/rfc822 disposition=inline>\n") - (let ((b (point)) e) - (if (not message-forward-decoded-p) - (insert - (with-temp-buffer - (mm-disable-multibyte) - (insert - (with-current-buffer forward-buffer - (mm-with-unibyte-current-buffer (buffer-string)))) - (mm-enable-multibyte) - (mime-to-mml) - (goto-char (point-min)) - (when (looking-at "From ") - (replace-match "X-From-Line: ")) - (buffer-string))) - (save-restriction - (narrow-to-region (point) (point)) - (mml-insert-buffer forward-buffer) - (goto-char (point-min)) - (when (looking-at "From ") - (replace-match "X-From-Line: ")) - (goto-char (point-max)))) - (setq e (point)) - (insert "<#/mml>\n") - (when (and (not message-forward-decoded-p) - message-forward-ignored-headers) - (save-restriction - (narrow-to-region b e) - (goto-char b) - (narrow-to-region (point) - (or (search-forward "\n\n" nil t) (point))) - (message-remove-header message-forward-ignored-headers t))))) - -(defun message-forward-make-body-digest-plain (forward-buffer) - (insert - "\n-------------------- Start of forwarded message --------------------\n") - (let ((b (point)) e) - (mml-insert-buffer forward-buffer) - (setq e (point)) - (insert - "\n-------------------- End of forwarded message --------------------\n"))) - -(defun message-forward-make-body-digest-mime (forward-buffer) - (insert "\n<#multipart type=digest>\n") - (let ((b (point)) e) - (insert-buffer-substring forward-buffer) - (setq e (point)) - (insert "<#/multipart>\n") - (save-restriction - (narrow-to-region b e) - (goto-char b) - (narrow-to-region (point) - (or (search-forward "\n\n" nil t) (point))) - (delete-region (point-min) (point-max))))) - -(defun message-forward-make-body-digest (forward-buffer) - (if message-forward-as-mime - (message-forward-make-body-digest-mime forward-buffer) - (message-forward-make-body-digest-plain forward-buffer))) - -;;;###autoload -(defun message-forward-make-body (forward-buffer &optional digest) - ;; Put point where we want it before inserting the forwarded - ;; message. - (if message-forward-before-signature - (message-goto-body) - (goto-char (point-max))) - (if digest - (message-forward-make-body-digest forward-buffer) - (if message-forward-as-mime - (if (and message-forward-show-mml - (not (and (eq message-forward-show-mml 'best) - (with-current-buffer forward-buffer - (goto-char (point-min)) - (re-search-forward - "Content-Type: *multipart/\\(signed\\|encrypted\\)" - nil t))))) - (message-forward-make-body-mml forward-buffer) - (message-forward-make-body-mime forward-buffer)) - (message-forward-make-body-plain forward-buffer))) - (message-position-point)) - -;;;###autoload -(defun message-forward-rmail-make-body (forward-buffer) - (save-window-excursion - (set-buffer forward-buffer) - ;; Rmail doesn't have rmail-msg-restore-non-pruned-header in Emacs - ;; 20. FIXIT, or we drop support for rmail in Emacs 20. - (if (rmail-msg-is-pruned) - (rmail-msg-restore-non-pruned-header))) - (message-forward-make-body forward-buffer)) - -(eval-when-compile (defvar rmail-enable-mime-composing)) - -;; Fixme: Should have defcustom. -;;;###autoload -(defun message-insinuate-rmail () - "Let RMAIL use message to forward." - (interactive) - (setq rmail-enable-mime-composing t) - (setq rmail-insert-mime-forwarded-message-function - 'message-forward-rmail-make-body)) - -;;;###autoload -(defun message-resend (address) - "Resend the current article to ADDRESS." - (interactive - (list (message-read-from-minibuffer "Resend message to: "))) - (message "Resending message to %s..." address) - (save-excursion - (let ((cur (current-buffer)) - beg) - ;; We first set up a normal mail buffer. - (unless (message-mail-user-agent) - (set-buffer (get-buffer-create " *message resend*")) - (erase-buffer)) - (let ((message-this-is-mail t) - message-setup-hook) - (message-setup `((To . ,address)))) - ;; Insert our usual headers. - (message-generate-headers '(From Date To Message-ID)) - (message-narrow-to-headers) - ;; Remove X-Draft-From header etc. - (message-remove-header message-ignored-mail-headers t) - ;; Rename them all to "Resent-*". - (goto-char (point-min)) - (while (re-search-forward "^[A-Za-z]" nil t) - (forward-char -1) - (insert "Resent-")) - (widen) - (forward-line) - (delete-region (point) (point-max)) - (setq beg (point)) - ;; Insert the message to be resent. - (insert-buffer-substring cur) - (goto-char (point-min)) - (search-forward "\n\n") - (forward-char -1) - (save-restriction - (narrow-to-region beg (point)) - (message-remove-header message-ignored-resent-headers t) - (goto-char (point-max))) - (insert mail-header-separator) - ;; Rename all old ("Also-")Resent headers. - (while (re-search-backward "^\\(Also-\\)*Resent-" beg t) - (beginning-of-line) - (insert "Also-")) - ;; Quote any "From " lines at the beginning. - (goto-char beg) - (when (looking-at "From ") - (replace-match "X-From-Line: ")) - ;; Send it. - (let ((message-inhibit-body-encoding t) - message-required-mail-headers - rfc2047-encode-encoded-words) - (message-send-mail)) - (kill-buffer (current-buffer))) - (message "Resending message to %s...done" address))) - -;;;###autoload -(defun message-bounce () - "Re-mail the current message. -This only makes sense if the current message is a bounce message that -contains some mail you have written which has been bounced back to -you." - (interactive) - (let ((handles (mm-dissect-buffer t)) - boundary) - (message-pop-to-buffer (message-buffer-name "bounce")) - (if (stringp (car handles)) - ;; This is a MIME bounce. - (mm-insert-part (car (last handles))) - ;; This is a non-MIME bounce, so we try to remove things - ;; manually. - (mm-insert-part handles) - (undo-boundary) - (goto-char (point-min)) - (re-search-forward "\n\n+" nil t) - (setq boundary (point)) - ;; We remove everything before the bounced mail. - (if (or (re-search-forward message-unsent-separator nil t) - (progn - (search-forward "\n\n" nil 'move) - (re-search-backward "^Return-Path:.*\n" boundary t))) - (progn - (forward-line 1) - (delete-region (point-min) - (if (re-search-forward "^[^ \n\t]+:" nil t) - (match-beginning 0) - (point)))) - (goto-char boundary) - (when (re-search-backward "^.?From .*\n" nil t) - (delete-region (match-beginning 0) (match-end 0))))) - (mime-to-mml) - (save-restriction - (message-narrow-to-head-1) - (message-remove-header message-ignored-bounced-headers t) - (goto-char (point-max)) - (insert mail-header-separator)) - (message-position-point))) - -;;; -;;; Interactive entry points for new message buffers. -;;; - -;;;###autoload -(defun message-mail-other-window (&optional to subject) - "Like `message-mail' command, but display mail buffer in another window." - (interactive) - (unless (message-mail-user-agent) - (let ((pop-up-windows t) - (special-display-buffer-names nil) - (special-display-regexps nil) - (same-window-buffer-names nil) - (same-window-regexps nil)) - (message-pop-to-buffer (message-buffer-name "mail" to)))) - (let ((message-this-is-mail t)) - (message-setup `((To . ,(or to "")) (Subject . ,(or subject ""))) - nil nil nil 'switch-to-buffer-other-window))) - -;;;###autoload -(defun message-mail-other-frame (&optional to subject) - "Like `message-mail' command, but display mail buffer in another frame." - (interactive) - (unless (message-mail-user-agent) - (let ((pop-up-frames t) - (special-display-buffer-names nil) - (special-display-regexps nil) - (same-window-buffer-names nil) - (same-window-regexps nil)) - (message-pop-to-buffer (message-buffer-name "mail" to)))) - (let ((message-this-is-mail t)) - (message-setup `((To . ,(or to "")) (Subject . ,(or subject ""))) - nil nil nil 'switch-to-buffer-other-frame))) - -;;;###autoload -(defun message-news-other-window (&optional newsgroups subject) - "Start editing a news article to be sent." - (interactive) - (let ((pop-up-windows t) - (special-display-buffer-names nil) - (special-display-regexps nil) - (same-window-buffer-names nil) - (same-window-regexps nil)) - (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups))) - (let ((message-this-is-news t)) - (message-setup `((Newsgroups . ,(or newsgroups "")) - (Subject . ,(or subject "")))))) - -;;;###autoload -(defun message-news-other-frame (&optional newsgroups subject) - "Start editing a news article to be sent." - (interactive) - (let ((pop-up-frames t) - (special-display-buffer-names nil) - (special-display-regexps nil) - (same-window-buffer-names nil) - (same-window-regexps nil)) - (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups))) - (let ((message-this-is-news t)) - (message-setup `((Newsgroups . ,(or newsgroups "")) - (Subject . ,(or subject "")))))) - -;;; underline.el - -;; This code should be moved to underline.el (from which it is stolen). - -;;;###autoload -(defun bold-region (start end) - "Bold all nonblank characters in the region. -Works by overstriking characters. -Called from program, takes two arguments START and END -which specify the range to operate on." - (interactive "r") - (save-excursion - (let ((end1 (make-marker))) - (move-marker end1 (max start end)) - (goto-char (min start end)) - (while (< (point) end1) - (or (looking-at "[_\^@- ]") - (insert (char-after) "\b")) - (forward-char 1))))) - -;;;###autoload -(defun unbold-region (start end) - "Remove all boldness (overstruck characters) in the region. -Called from program, takes two arguments START and END -which specify the range to operate on." - (interactive "r") - (save-excursion - (let ((end1 (make-marker))) - (move-marker end1 (max start end)) - (goto-char (min start end)) - (while (re-search-forward "\b" end1 t) - (if (eq (char-after) (char-after (- (point) 2))) - (delete-char -2)))))) - -(defun message-exchange-point-and-mark () - "Exchange point and mark, but don't activate region if it was inactive." - (unless (prog1 - (message-mark-active-p) - (exchange-point-and-mark)) - (setq mark-active nil))) - -(defalias 'message-make-overlay 'make-overlay) -(defalias 'message-delete-overlay 'delete-overlay) -(defalias 'message-overlay-put 'overlay-put) -(defun message-kill-all-overlays () - (if (featurep 'xemacs) - (map-extents (lambda (extent ignore) (delete-extent extent))) - (mapcar #'delete-overlay (overlays-in (point-min) (point-max))))) - -;; Support for toolbar -(eval-when-compile - (defvar tool-bar-mode)) - -;; Note: The :set function in the `message-tool-bar*' variables will only -;; affect _new_ message buffers. We might add a function that walks thru all -;; message-mode buffers and force the update. -(defun message-tool-bar-update (&optional symbol value) - "Update message mode toolbar. -Setter function for custom variables." - (setq-default message-tool-bar-map nil) - (when symbol - ;; When used as ":set" function: - (set-default symbol value))) - -(defcustom message-tool-bar (if (eq gmm-tool-bar-style 'gnome) - 'message-tool-bar-gnome - 'message-tool-bar-retro) - "Specifies the message mode tool bar. - -It can be either a list or a symbol refering to a list. See -`gmm-tool-bar-from-list' for the format of the list. The -default key map is `message-mode-map'. - -Pre-defined symbols include `message-tool-bar-gnome' and -`message-tool-bar-retro'." - :type '(repeat gmm-tool-bar-list-item) - :type '(choice (const :tag "GNOME style" message-tool-bar-gnome) - (const :tag "Retro look" message-tool-bar-retro) - (repeat :tag "User defined list" gmm-tool-bar-item) - (symbol)) - :version "22.1" ;; Gnus 5.10.9 - :initialize 'custom-initialize-default - :set 'message-tool-bar-update - :group 'message) - -(defcustom message-tool-bar-gnome - '((ispell-message "spell" nil - :visible (or (not (boundp 'flyspell-mode)) - (not flyspell-mode))) - (flyspell-buffer "spell" t - :visible (and (boundp 'flyspell-mode) - flyspell-mode) - :help "Flyspell whole buffer") - (gmm-ignore "separator") - (message-send-and-exit "mail/send") - (message-dont-send "mail/save-draft") - (message-kill-buffer "close") ;; stock_cancel - (mml-attach-file "attach" mml-mode-map) - (mml-preview "mail/preview" mml-mode-map) - ;; (mml-secure-message-sign-encrypt "lock" mml-mode-map :visible nil) - (message-insert-importance-high "important" nil :visible nil) - (message-insert-importance-low "unimportant" nil :visible nil) - (message-insert-disposition-notification-to "receipt" nil :visible nil) - (gmm-customize-mode "preferences" t :help "Edit mode preferences") - (message-info "help" t :help "Message manual")) - "List of items for the message tool bar (GNOME style). - -See `gmm-tool-bar-from-list' for details on the format of the list." - :type '(repeat gmm-tool-bar-item) - :version "22.1" ;; Gnus 5.10.9 - :initialize 'custom-initialize-default - :set 'message-tool-bar-update - :group 'message) - -(defcustom message-tool-bar-retro - '(;; Old Emacs 21 icon for consistency. - (message-send-and-exit "gnus/mail-send") - (message-kill-buffer "close") - (message-dont-send "cancel") - (mml-attach-file "attach" mml-mode-map) - (ispell-message "spell") - (mml-preview "preview" mml-mode-map) - (message-insert-importance-high "gnus/important") - (message-insert-importance-low "gnus/unimportant") - (message-insert-disposition-notification-to "gnus/receipt")) - "List of items for the message tool bar (retro style). - -See `gmm-tool-bar-from-list' for details on the format of the list." - :type '(repeat gmm-tool-bar-item) - :version "22.1" ;; Gnus 5.10.9 - :initialize 'custom-initialize-default - :set 'message-tool-bar-update - :group 'message) - -(defcustom message-tool-bar-zap-list - '(new-file open-file dired kill-buffer write-file - print-buffer customize help) - "List of icon items from the global tool bar. -These items are not displayed on the message mode tool bar. - -See `gmm-tool-bar-from-list' for the format of the list." - :type 'gmm-tool-bar-zap-list - :version "22.1" ;; Gnus 5.10.9 - :initialize 'custom-initialize-default - :set 'message-tool-bar-update - :group 'message) - -(defvar image-load-path) - -(defun message-make-tool-bar (&optional force) - "Make a message mode tool bar from `message-tool-bar-list'. -When FORCE, rebuild the tool bar." - (when (and (not (featurep 'xemacs)) - (boundp 'tool-bar-mode) - tool-bar-mode - (or (not message-tool-bar-map) force)) - (setq message-tool-bar-map - (let* ((load-path - (gmm-image-load-path-for-library "message" - "mail/save-draft.xpm" - nil t)) - (image-load-path (cons (car load-path) - (when (boundp 'image-load-path) - image-load-path)))) - (gmm-tool-bar-from-list message-tool-bar - message-tool-bar-zap-list - 'message-mode-map)))) - message-tool-bar-map) - -;;; Group name completion. - -(defcustom message-newgroups-header-regexp - "^\\(Newsgroups\\|Followup-To\\|Posted-To\\|Gcc\\):" - "Regexp that match headers that lists groups." - :group 'message - :type 'regexp) - -(defcustom message-completion-alist - (list (cons message-newgroups-header-regexp 'message-expand-group) - '("^\\(Resent-\\)?\\(To\\|B?Cc\\):" . message-expand-name) - '("^\\(Reply-To\\|From\\|Mail-Followup-To\\|Mail-Copies-To\\):" - . message-expand-name) - '("^\\(Disposition-Notification-To\\|Return-Receipt-To\\):" - . message-expand-name)) - "Alist of (RE . FUN). Use FUN for completion on header lines matching RE." - :version "22.1" - :group 'message - :type '(alist :key-type regexp :value-type function)) - -(defcustom message-tab-body-function nil - "*Function to execute when `message-tab' (TAB) is executed in the body. -If nil, the function bound in `text-mode-map' or `global-map' is executed." - :version "22.1" - :group 'message - :link '(custom-manual "(message)Various Commands") - :type '(choice (const nil) - function)) - -(defun message-tab () - "Complete names according to `message-completion-alist'. -Execute function specified by `message-tab-body-function' when not in -those headers." - (interactive) - (let ((alist message-completion-alist)) - (while (and alist - (let ((mail-abbrev-mode-regexp (caar alist))) - (not (mail-abbrev-in-expansion-header-p)))) - (setq alist (cdr alist))) - (funcall (or (cdar alist) message-tab-body-function - (lookup-key text-mode-map "\t") - (lookup-key global-map "\t") - 'indent-relative)))) - -(eval-and-compile - (condition-case nil - (with-temp-buffer - (let ((standard-output (current-buffer))) - (eval '(display-completion-list nil ""))) - (defalias 'message-display-completion-list 'display-completion-list)) - (error ;; Don't use `wrong-number-of-arguments' here because of XEmacs. - (defun message-display-completion-list (completions &optional ignore) - "Display the list of completions, COMPLETIONS, using `standard-output'." - (display-completion-list completions))))) - -(defun message-expand-group () - "Expand the group name under point." - (let* ((b (save-excursion - (save-restriction - (narrow-to-region - (save-excursion - (beginning-of-line) - (skip-chars-forward "^:") - (1+ (point))) - (point)) - (skip-chars-backward "^, \t\n") (point)))) - (completion-ignore-case t) - (string (buffer-substring b (progn (skip-chars-forward "^,\t\n ") - (point)))) - (hashtb (and (boundp 'gnus-active-hashtb) gnus-active-hashtb)) - (completions (all-completions string hashtb)) - comp) - (delete-region b (point)) - (cond - ((= (length completions) 1) - (if (string= (car completions) string) - (progn - (insert string) - (message "Only matching group")) - (insert (car completions)))) - ((and (setq comp (try-completion string hashtb)) - (not (string= comp string))) - (insert comp)) - (t - (insert string) - (if (not comp) - (message "No matching groups") - (save-selected-window - (pop-to-buffer "*Completions*") - (buffer-disable-undo) - (let ((buffer-read-only nil)) - (erase-buffer) - (let ((standard-output (current-buffer))) - (message-display-completion-list (sort completions 'string<) - string)) - (setq buffer-read-only nil) - (goto-char (point-min)) - (delete-region (point) (progn (forward-line 3) (point)))))))))) - -(defun message-expand-name () - (if (fboundp 'bbdb-complete-name) - (bbdb-complete-name) - (expand-abbrev))) - -;;; Help stuff. - -(defun message-talkative-question (ask question show &rest text) - "Call FUNCTION with argument QUESTION; optionally display TEXT... args. -If SHOW is non-nil, the arguments TEXT... are displayed in a temp buffer. -The following arguments may contain lists of values." - (if (and show - (setq text (message-flatten-list text))) - (save-window-excursion - (save-excursion - (with-output-to-temp-buffer " *MESSAGE information message*" - (set-buffer " *MESSAGE information message*") - (fundamental-mode) ; for Emacs 20.4+ - (mapcar 'princ text) - (goto-char (point-min)))) - (funcall ask question)) - (funcall ask question))) - -(defun message-flatten-list (list) - "Return a new, flat list that contains all elements of LIST. - -\(message-flatten-list '(1 (2 3 (4 5 (6))) 7)) -=> (1 2 3 4 5 6 7)" - (cond ((consp list) - (apply 'append (mapcar 'message-flatten-list list))) - (list - (list list)))) - -(defun message-generate-new-buffer-clone-locals (name &optional varstr) - "Create and return a buffer with name based on NAME using `generate-new-buffer'. -Then clone the local variables and values from the old buffer to the -new one, cloning only the locals having a substring matching the -regexp VARSTR." - (let ((oldbuf (current-buffer))) - (save-excursion - (set-buffer (generate-new-buffer name)) - (message-clone-locals oldbuf varstr) - (current-buffer)))) - -(defun message-clone-locals (buffer &optional varstr) - "Clone the local variables from BUFFER to the current buffer." - (let ((locals (save-excursion - (set-buffer buffer) - (buffer-local-variables))) - (regexp "^gnus\\|^nn\\|^message\\|^sendmail\\|^smtp\\|^user-mail-address")) - (mapcar - (lambda (local) - (when (and (consp local) - (car local) - (string-match regexp (symbol-name (car local))) - (or (null varstr) - (string-match varstr (symbol-name (car local))))) - (ignore-errors - (set (make-local-variable (car local)) - (cdr local))))) - locals))) - -;;; -;;; MIME functions -;;; - -(defvar message-inhibit-body-encoding nil) - -(defun message-encode-message-body () - (unless message-inhibit-body-encoding - (let ((mail-parse-charset (or mail-parse-charset - message-default-charset)) - (case-fold-search t) - lines content-type-p) - (message-goto-body) - (save-restriction - (narrow-to-region (point) (point-max)) - (let ((new (mml-generate-mime))) - (when new - (delete-region (point-min) (point-max)) - (insert new) - (goto-char (point-min)) - (if (eq (aref new 0) ?\n) - (delete-char 1) - (search-forward "\n\n") - (setq lines (buffer-substring (point-min) (1- (point)))) - (delete-region (point-min) (point)))))) - (save-restriction - (message-narrow-to-headers-or-head) - (message-remove-header "Mime-Version") - (goto-char (point-max)) - (insert "MIME-Version: 1.0\n") - (when lines - (insert lines)) - (setq content-type-p - (or mml-boundary - (re-search-backward "^Content-Type:" nil t)))) - (save-restriction - (message-narrow-to-headers-or-head) - (message-remove-first-header "Content-Type") - (message-remove-first-header "Content-Transfer-Encoding")) - ;; We always make sure that the message has a Content-Type - ;; header. This is because some broken MTAs and MUAs get - ;; awfully confused when confronted with a message with a - ;; MIME-Version header and without a Content-Type header. For - ;; instance, Solaris' /usr/bin/mail. - (unless content-type-p - (goto-char (point-min)) - ;; For unknown reason, MIME-Version doesn't exist. - (when (re-search-forward "^MIME-Version:" nil t) - (forward-line 1) - (insert "Content-Type: text/plain; charset=us-ascii\n")))))) - -(defun message-read-from-minibuffer (prompt &optional initial-contents) - "Read from the minibuffer while providing abbrev expansion." - (if (fboundp 'mail-abbrevs-setup) - (let ((mail-abbrev-mode-regexp "") - (minibuffer-setup-hook 'mail-abbrevs-setup) - (minibuffer-local-map message-minibuffer-local-map)) - (read-from-minibuffer prompt initial-contents)) - (let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook) - (minibuffer-local-map message-minibuffer-local-map)) - (read-string prompt initial-contents)))) - -(defun message-use-alternative-email-as-from () - "Set From field of the outgoing message to the first matching -address in `message-alternative-emails', looking at To, Cc and -From headers in the original article." - (require 'mail-utils) - (let* ((fields '("To" "Cc" "From")) - (emails - (split-string - (mail-strip-quoted-names - (mapconcat 'message-fetch-reply-field fields ",")) - "[ \f\t\n\r\v,]+")) - email) - (while emails - (if (string-match message-alternative-emails (car emails)) - (setq email (car emails) - emails nil)) - (pop emails)) - (unless (or (not email) (equal email user-mail-address)) - (message-remove-header "From") - (goto-char (point-max)) - (insert "From: " (let ((user-mail-address email)) (message-make-from)) - "\n")))) - -(defun message-options-get (symbol) - (cdr (assq symbol message-options))) - -(defun message-options-set (symbol value) - (let ((the-cons (assq symbol message-options))) - (if the-cons - (if value - (setcdr the-cons value) - (setq message-options (delq the-cons message-options))) - (and value - (push (cons symbol value) message-options)))) - value) - -(defun message-options-set-recipient () - (save-restriction - (message-narrow-to-headers-or-head) - (message-options-set 'message-sender - (mail-strip-quoted-names - (message-fetch-field "from"))) - (message-options-set 'message-recipients - (mail-strip-quoted-names - (let ((to (message-fetch-field "to")) - (cc (message-fetch-field "cc")) - (bcc (message-fetch-field "bcc"))) - (concat - (or to "") - (if (and to cc) ", ") - (or cc "") - (if (and (or to cc) bcc) ", ") - (or bcc ""))))))) - -(defun message-hide-headers () - "Hide headers based on the `message-hidden-headers' variable." - (let ((regexps (if (stringp message-hidden-headers) - (list message-hidden-headers) - message-hidden-headers)) - (inhibit-point-motion-hooks t) - (after-change-functions nil)) - (when regexps - (save-excursion - (save-restriction - (message-narrow-to-headers) - (goto-char (point-min)) - (while (not (eobp)) - (if (not (message-hide-header-p regexps)) - (message-next-header) - (let ((begin (point))) - (message-next-header) - (add-text-properties - begin (point) - '(invisible t message-hidden t)))))))))) - -(defun message-hide-header-p (regexps) - (let ((result nil) - (reverse nil)) - (when (eq (car regexps) 'not) - (setq reverse t) - (pop regexps)) - (dolist (regexp regexps) - (setq result (or result (looking-at regexp)))) - (if reverse - (not result) - result))) - -(when (featurep 'xemacs) - (require 'messagexmas) - (message-xmas-redefine)) - -(provide 'message) - -(run-hooks 'message-load-hook) - -;; Local Variables: -;; coding: iso-8859-1 -;; End: - -;; arch-tag: 94b32cac-4504-4b6c-8181-030ebf380ee0 -;;; message.el ends here diff --git a/xemacs-packages/gnus/lisp/messagexmas.el b/xemacs-packages/gnus/lisp/messagexmas.el deleted file mode 100644 index 09d67283..00000000 --- a/xemacs-packages/gnus/lisp/messagexmas.el +++ /dev/null @@ -1,183 +0,0 @@ -;;; messagexmas.el --- XEmacs extensions to message - -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2003, -;; 2005, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: mail, news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) -(require 'nnheader) - -(defvar message-xmas-dont-activate-region t - "If t, don't activate region after yanking.") - -(defvar message-xmas-glyph-directory nil - "*Directory where Message logos and icons are located. -If this variable is nil, Message will try to locate the directory -automatically.") - -(defvar message-use-toolbar (if (featurep 'toolbar) 'default) - "*Position to display the toolbar. Nil means do not use a toolbar. -If it is non-nil, it should be one of the symbols `default', `top', -`bottom', `right', and `left'. `default' means to use the default -toolbar, the rest mean to display the toolbar on the place which those -names show.") - -(defvar message-toolbar-thickness - (if (featurep 'toolbar) - (cons (specifier-instance default-toolbar-height) - (specifier-instance default-toolbar-width))) - "*Cons of the height and the width specifying the thickness of a toolbar. -The height is used for the toolbar displayed on the top or the bottom, -the width is used for the toolbar displayed on the right or the left.") - -(defvar message-toolbar - '([message-spell ispell-message t "Spell"] - [message-help (Info-goto-node "(Message)Top") t "Message help"]) - "The message buffer toolbar.") - -(defun message-xmas-find-glyph-directory (&optional package) - (setq package (or package "message")) - (let ((dir (symbol-value - (intern-soft (concat package "-xmas-glyph-directory"))))) - (if (and (stringp dir) (file-directory-p dir)) - dir - (nnheader-find-etc-directory package)))) - -(defun message-xmas-setup-toolbar (bar &optional force package) - (let ((dir (or (message-xmas-find-glyph-directory package) - (message-xmas-find-glyph-directory "gnus"))) - (xpm (if (featurep 'xpm) "xpm" "xbm")) - icon up down disabled name) - (unless package - (setq message-xmas-glyph-directory dir)) - (when dir - (while bar - (setq icon (aref (car bar) 0) - name (symbol-name icon) - bar (cdr bar)) - (when (or force - (not (boundp icon))) - (setq up (concat dir name "-up." xpm)) - (setq down (concat dir name "-down." xpm)) - (setq disabled (concat dir name "-disabled." xpm)) - (if (not (file-exists-p up)) - (setq bar nil - dir nil) - (set icon (toolbar-make-button-list - up (and (file-exists-p down) down) - (and (file-exists-p disabled) disabled))))))) - dir)) - -(defun message-setup-toolbar () - (when (featurep 'toolbar) - (if (and message-use-toolbar - (message-xmas-setup-toolbar message-toolbar)) - (let ((bar (or (intern-soft (format "%s-toolbar" message-use-toolbar)) - 'default-toolbar)) - (height (car message-toolbar-thickness)) - (width (cdr message-toolbar-thickness)) - (cur (current-buffer)) - bars) - (set-specifier (symbol-value bar) message-toolbar cur) - (set-specifier default-toolbar-height height cur) - (set-specifier default-toolbar-width width cur) - (set-specifier top-toolbar-height height cur) - (set-specifier bottom-toolbar-height height cur) - (set-specifier right-toolbar-width width cur) - (set-specifier left-toolbar-width width cur) - (if (eq bar 'default-toolbar) - (progn - (remove-specifier default-toolbar-visible-p cur) - (remove-specifier top-toolbar cur) - (remove-specifier top-toolbar-visible-p cur) - (remove-specifier bottom-toolbar cur) - (remove-specifier bottom-toolbar-visible-p cur) - (remove-specifier right-toolbar cur) - (remove-specifier right-toolbar-visible-p cur) - (remove-specifier left-toolbar cur) - (remove-specifier left-toolbar-visible-p cur)) - (set-specifier (symbol-value (intern (format "%s-visible-p" bar))) - t cur) - (setq bars (delq bar (list 'default-toolbar - 'bottom-toolbar 'top-toolbar - 'right-toolbar 'left-toolbar))) - (while bars - (set-specifier (symbol-value (intern (format "%s-visible-p" - (pop bars)))) - nil cur)))) - (let ((cur (current-buffer))) - (set-specifier default-toolbar-visible-p nil cur) - (set-specifier top-toolbar-visible-p nil cur) - (set-specifier bottom-toolbar-visible-p nil cur) - (set-specifier right-toolbar-visible-p nil cur) - (set-specifier left-toolbar-visible-p nil cur))))) - -(defun message-xmas-exchange-point-and-mark () - "Exchange point and mark, but allow for XEmacs' optional argument." - (exchange-point-and-mark message-xmas-dont-activate-region)) - -(defun message-xmas-maybe-fontify () - (when (featurep 'font-lock) - (font-lock-set-defaults))) - -(defun message-xmas-make-caesar-translation-table (n) - "Create a rot table with offset N." - (let ((i -1) - (table (make-string 256 0)) - (a (mm-char-int ?a)) - (A (mm-char-int ?A))) - (while (< (incf i) 256) - (aset table i i)) - (concat - (substring table 0 A) - (substring table (+ A n) (+ A n (- 26 n))) - (substring table A (+ A n)) - (substring table (+ A 26) a) - (substring table (+ a n) (+ a n (- 26 n))) - (substring table a (+ a n)) - (substring table (+ a 26) 255)))) - -(add-hook 'message-mode-hook 'message-xmas-maybe-fontify) - -(defun message-xmas-redefine () - "Redefine message functions for XEmacs." - (defalias 'message-exchange-point-and-mark - 'message-xmas-exchange-point-and-mark) - (defalias 'message-mark-active-p - 'region-exists-p) - (when (>= emacs-major-version 20) - (defalias 'message-make-caesar-translation-table - 'message-xmas-make-caesar-translation-table)) - (defalias 'message-make-overlay 'make-extent) - (defalias 'message-delete-overlay 'delete-extent) - (defalias 'message-overlay-put 'set-extent-property)) - -(message-xmas-redefine) - -(provide 'messagexmas) - -;;; arch-tag: 0ece0484-8757-4641-b2d4-17147dd5c5b5 -;;; messagexmas.el ends here diff --git a/xemacs-packages/gnus/lisp/messcompat.el b/xemacs-packages/gnus/lisp/messcompat.el deleted file mode 100644 index 2f603630..00000000 --- a/xemacs-packages/gnus/lisp/messcompat.el +++ /dev/null @@ -1,95 +0,0 @@ -;;; messcompat.el --- making message mode compatible with mail mode - -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: mail, news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; This file tries to provide backward compatibility with sendmail.el -;; for Message mode. It should be used by simply adding -;; -;; (require 'messcompat) -;; -;; to the .emacs file. Loading it after Message mode has been -;; loaded will have no effect. - -;;; Code: - -(require 'sendmail) - -(defvar message-from-style mail-from-style - "*Specifies how \"From\" headers look. - -If nil, they contain just the return address like: - king@grassland.com -If `parens', they look like: - king@grassland.com (Elvis Parsley) -If `angles', they look like: - Elvis Parsley - -Otherwise, most addresses look like `angles', but they look like -`parens' if `angles' would need quoting and `parens' would not.") - -(defvar message-interactive mail-interactive - "Non-nil means when sending a message wait for and display errors. -nil means let mailer mail back a message to report errors.") - -(defvar message-setup-hook mail-setup-hook - "Normal hook, run each time a new outgoing message is initialized. -The function `message-setup' runs this hook.") - -(if (boundp 'mail-mode-hook) - (defvar message-mode-hook mail-mode-hook - "Hook run in message mode buffers.")) - -(defvar message-indentation-spaces mail-indentation-spaces - "*Number of spaces to insert at the beginning of each cited line. -Used by `message-yank-original' via `message-yank-cite'.") - -(defvar message-signature mail-signature - "*String to be inserted at the end of the message buffer. -If t, the `message-signature-file' file will be inserted instead. -If a function, the result from the function will be used instead. -If a form, the result from the form will be used instead.") - -;; Deleted the autoload cookie because this crashes in loaddefs.el. -(defvar message-signature-file mail-signature-file - "*File containing the text inserted at end of the message buffer.") - -(defvar message-default-headers mail-default-headers - "*A string containing header lines to be inserted in outgoing messages. -It is inserted before you edit the message, so you can edit or delete -these lines.") - -(defvar message-send-hook mail-send-hook - "Hook run before sending messages.") - -(defvar message-send-mail-function send-mail-function - "Function to call to send the current buffer as mail. -The headers should be delimited by a line whose contents match the -variable `mail-header-separator'.") - -(provide 'messcompat) - -;;; arch-tag: a76673be-905e-4bbd-8966-615370494a7b -;;; messcompat.el ends here diff --git a/xemacs-packages/gnus/lisp/mm-bodies.el b/xemacs-packages/gnus/lisp/mm-bodies.el deleted file mode 100644 index 86a49477..00000000 --- a/xemacs-packages/gnus/lisp/mm-bodies.el +++ /dev/null @@ -1,310 +0,0 @@ -;;; mm-bodies.el --- Functions for decoding MIME things - -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; MORIOKA Tomohiko -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-and-compile - (or (fboundp 'base64-decode-region) - (require 'base64))) - -(eval-when-compile - (defvar mm-uu-decode-function) - (defvar mm-uu-binhex-decode-function)) - -(require 'mm-util) -(require 'rfc2047) -(require 'mm-encode) - -;; 8bit treatment gets any char except: 0x32 - 0x7f, LF, TAB, BEL, -;; BS, vertical TAB, form feed, and ^_ -;; -;; Note that CR is *not* included, as that would allow a non-paired CR -;; in the body contrary to RFC 2822: -;; -;; - CR and LF MUST only occur together as CRLF; they MUST NOT -;; appear independently in the body. - -(defvar mm-7bit-chars "\x20-\x7f\n\t\x7\x8\xb\xc\x1f") - -(defcustom mm-body-charset-encoding-alist - '((iso-2022-jp . 7bit) - (iso-2022-jp-2 . 7bit) - ;; We MUST encode UTF-16 because it can contain \0's which is - ;; known to break servers. - ;; Note: UTF-16 variants are invalid for text parts [RFC 2781], - ;; so this can't happen :-/. - ;; PPS: Yes, it can happen if the user specifies UTF-16 in the MML - ;; markup. - jh. - (utf-16 . base64) - (utf-16be . base64) - (utf-16le . base64)) - "Alist of MIME charsets to encodings. -Valid encodings are `7bit', `8bit', `quoted-printable' and `base64'." - :type '(repeat (cons (symbol :tag "charset") - (choice :tag "encoding" - (const 7bit) - (const 8bit) - (const quoted-printable) - (const base64)))) - :group 'mime) - -(defun mm-encode-body (&optional charset) - "Encode a body. -Should be called narrowed to the body that is to be encoded. -If there is more than one non-ASCII MULE charset in the body, then the -list of MULE charsets found is returned. -If CHARSET is non-nil, it is used as the MIME charset to encode the body. -If successful, the MIME charset is returned. -If no encoding was done, nil is returned." - (if (not (mm-multibyte-p)) - ;; In the non-Mule case, we search for non-ASCII chars and - ;; return the value of `mail-parse-charset' if any are found. - (or charset - (save-excursion - (goto-char (point-min)) - (if (re-search-forward "[^\x0-\x7f]" nil t) - (or mail-parse-charset - (message-options-get 'mm-encody-body-charset) - (message-options-set - 'mm-encody-body-charset - (mm-read-coding-system "Charset used in the article: "))) - ;; The logic in `mml-generate-mime-1' confirms that it's OK - ;; to return nil here. - nil))) - (save-excursion - (if charset - (progn - (mm-encode-coding-region (point-min) (point-max) - (mm-charset-to-coding-system charset)) - charset) - (goto-char (point-min)) - (let ((charsets (mm-find-mime-charset-region (point-min) (point-max) - mm-hack-charsets))) - (cond - ;; No encoding. - ((null charsets) - nil) - ;; Too many charsets. - ((> (length charsets) 1) - charsets) - ;; We encode. - (t - (prog1 - (setq charset (car charsets)) - (mm-encode-coding-region (point-min) (point-max) - (mm-charset-to-coding-system charset)))) - )))))) - -(defun mm-long-lines-p (length) - "Say whether any of the lines in the buffer is longer than LENGTH." - (save-excursion - (goto-char (point-min)) - (end-of-line) - (while (and (not (eobp)) - (not (> (current-column) length))) - (forward-line 1) - (end-of-line)) - (and (> (current-column) length) - (current-column)))) - -(defvar message-posting-charset) - -(defun mm-body-encoding (charset &optional encoding) - "Do Content-Transfer-Encoding and return the encoding of the current buffer." - (when (stringp encoding) - (setq encoding (intern (downcase encoding)))) - (let ((bits (mm-body-7-or-8)) - (longp (mm-long-lines-p 1000))) - (require 'message) - (cond - ((and (not longp) - (not (and mm-use-ultra-safe-encoding - (or (save-excursion (re-search-forward " $" nil t)) - (save-excursion (re-search-forward "^From " nil t))))) - (eq bits '7bit)) - bits) - ((and (not mm-use-ultra-safe-encoding) - (not longp) - (not (cdr (assq charset mm-body-charset-encoding-alist))) - (or (eq t (cdr message-posting-charset)) - (memq charset (cdr message-posting-charset)) - (eq charset mail-parse-charset))) - bits) - (t - (let ((encoding (or encoding - (cdr (assq charset mm-body-charset-encoding-alist)) - (mm-qp-or-base64)))) - (when mm-use-ultra-safe-encoding - (setq encoding (mm-safer-encoding encoding))) - (mm-encode-content-transfer-encoding encoding "text/plain") - encoding))))) - -(defun mm-body-7-or-8 () - "Say whether the body is 7bit or 8bit." - (if (save-excursion - (goto-char (point-min)) - (skip-chars-forward mm-7bit-chars) - (eobp)) - '7bit - '8bit)) - -;;; -;;; Functions for decoding -;;; - -(eval-when-compile (defvar mm-uu-yenc-decode-function)) - -(defun mm-decode-content-transfer-encoding (encoding &optional type) - "Decodes buffer encoded with ENCODING, returning success status. -If TYPE is `text/plain' CRLF->LF translation may occur." - (prog1 - (condition-case error - (cond - ((eq encoding 'quoted-printable) - (quoted-printable-decode-region (point-min) (point-max)) - t) - ((eq encoding 'base64) - (base64-decode-region - (point-min) - ;; Some mailers insert whitespace - ;; junk at the end which - ;; base64-decode-region dislikes. - ;; Also remove possible junk which could - ;; have been added by mailing list software. - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "^[\t ]*\r?\n" nil t) - (delete-region (match-beginning 0) (match-end 0))) - (goto-char (point-max)) - (when (re-search-backward "^[A-Za-z0-9+/]+=*[\t ]*$" nil t) - (forward-line)) - (point)))) - ((memq encoding '(7bit 8bit binary)) - ;; Do nothing. - t) - ((null encoding) - ;; Do nothing. - t) - ((memq encoding '(x-uuencode x-uue)) - (require 'mm-uu) - (funcall mm-uu-decode-function (point-min) (point-max)) - t) - ((eq encoding 'x-binhex) - (require 'mm-uu) - (funcall mm-uu-binhex-decode-function (point-min) (point-max)) - t) - ((eq encoding 'x-yenc) - (require 'mm-uu) - (funcall mm-uu-yenc-decode-function (point-min) (point-max)) - ) - ((functionp encoding) - (funcall encoding (point-min) (point-max)) - t) - (t - (message "Unknown encoding %s; defaulting to 8bit" encoding))) - (error - (message "Error while decoding: %s" error) - nil)) - (when (and - type - (memq encoding '(base64 x-uuencode x-uue x-binhex x-yenc)) - (string-match "\\`text/" type)) - (goto-char (point-min)) - (while (search-forward "\r\n" nil t) - (replace-match "\n" t t))))) - -(defun mm-decode-body (charset &optional encoding type) - "Decode the current article that has been encoded with ENCODING to CHARSET. -ENCODING is a MIME content transfer encoding. -CHARSET is the MIME charset with which to decode the data after transfer -decoding. If it is nil, default to `mail-parse-charset'." - (when (stringp charset) - (setq charset (intern (downcase charset)))) - (when (or (not charset) - (eq 'gnus-all mail-parse-ignored-charsets) - (memq 'gnus-all mail-parse-ignored-charsets) - (memq charset mail-parse-ignored-charsets)) - (setq charset mail-parse-charset)) - (save-excursion - (when encoding - (mm-decode-content-transfer-encoding encoding type)) - (when (and (featurep 'mule) ;; Fixme: Wrong test for unibyte session. - (not (eq charset 'gnus-decoded))) - (let ((coding-system (mm-charset-to-coding-system - ;; Allow overwrite using - ;; `mm-charset-override-alist'. - charset nil t))) - (if (and (not coding-system) - (listp mail-parse-ignored-charsets) - (memq 'gnus-unknown mail-parse-ignored-charsets)) - (setq coding-system - (mm-charset-to-coding-system mail-parse-charset))) - (when (and charset coding-system - ;; buffer-file-coding-system - ;;Article buffer is nil coding system - ;;in XEmacs - (mm-multibyte-p) - (or (not (eq coding-system 'ascii)) - (setq coding-system mail-parse-charset))) - (mm-decode-coding-region (point-min) (point-max) - coding-system)) - (setq buffer-file-coding-system - (if (boundp 'last-coding-system-used) - (symbol-value 'last-coding-system-used) - coding-system)))))) - -(defun mm-decode-string (string charset) - "Decode STRING with CHARSET." - (when (stringp charset) - (setq charset (intern (downcase charset)))) - (when (or (not charset) - (eq 'gnus-all mail-parse-ignored-charsets) - (memq 'gnus-all mail-parse-ignored-charsets) - (memq charset mail-parse-ignored-charsets)) - (setq charset mail-parse-charset)) - (or - (when (featurep 'mule) - (let ((coding-system (mm-charset-to-coding-system - charset - ;; Allow overwrite using - ;; `mm-charset-override-alist'. - nil t))) - (if (and (not coding-system) - (listp mail-parse-ignored-charsets) - (memq 'gnus-unknown mail-parse-ignored-charsets)) - (setq coding-system - (mm-charset-to-coding-system mail-parse-charset))) - (when (and charset coding-system - (mm-multibyte-p) - (or (not (eq coding-system 'ascii)) - (setq coding-system mail-parse-charset))) - (mm-decode-coding-string string coding-system)))) - string)) - -(provide 'mm-bodies) - -;;; arch-tag: 41104bb6-4443-4ca9-8d5c-ff87ecf27d8d -;;; mm-bodies.el ends here diff --git a/xemacs-packages/gnus/lisp/mm-decode.el b/xemacs-packages/gnus/lisp/mm-decode.el deleted file mode 100644 index b9700fb1..00000000 --- a/xemacs-packages/gnus/lisp/mm-decode.el +++ /dev/null @@ -1,1590 +0,0 @@ -;;; mm-decode.el --- Functions for decoding MIME things - -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; MORIOKA Tomohiko -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(require 'mail-parse) -(require 'mailcap) -(require 'mm-bodies) -(eval-when-compile (require 'cl) - (require 'term)) - -(eval-and-compile - (autoload 'executable-find "executable") - (autoload 'mm-inline-partial "mm-partial") - (autoload 'mm-inline-external-body "mm-extern") - (autoload 'mm-extern-cache-contents "mm-extern") - (autoload 'mm-insert-inline "mm-view")) - -(defvar gnus-current-window-configuration) - -(add-hook 'gnus-exit-gnus-hook 'mm-destroy-postponed-undisplay-list) - -(defgroup mime-display () - "Display of MIME in mail and news articles." - :link '(custom-manual "(emacs-mime)Display Customization") - :version "21.1" - :group 'mail - :group 'news - :group 'multimedia) - -(defgroup mime-security () - "MIME security in mail and news articles." - :link '(custom-manual "(emacs-mime)Display Customization") - :group 'mail - :group 'news - :group 'multimedia) - -;;; Convenience macros. - -(defmacro mm-handle-buffer (handle) - `(nth 0 ,handle)) -(defmacro mm-handle-type (handle) - `(nth 1 ,handle)) -(defsubst mm-handle-media-type (handle) - (if (stringp (car handle)) - (car handle) - (car (mm-handle-type handle)))) -(defsubst mm-handle-media-supertype (handle) - (car (split-string (mm-handle-media-type handle) "/"))) -(defsubst mm-handle-media-subtype (handle) - (cadr (split-string (mm-handle-media-type handle) "/"))) -(defmacro mm-handle-encoding (handle) - `(nth 2 ,handle)) -(defmacro mm-handle-undisplayer (handle) - `(nth 3 ,handle)) -(defmacro mm-handle-set-undisplayer (handle function) - `(setcar (nthcdr 3 ,handle) ,function)) -(defmacro mm-handle-disposition (handle) - `(nth 4 ,handle)) -(defmacro mm-handle-description (handle) - `(nth 5 ,handle)) -(defmacro mm-handle-cache (handle) - `(nth 6 ,handle)) -(defmacro mm-handle-set-cache (handle contents) - `(setcar (nthcdr 6 ,handle) ,contents)) -(defmacro mm-handle-id (handle) - `(nth 7 ,handle)) -(defmacro mm-handle-multipart-original-buffer (handle) - `(get-text-property 0 'buffer (car ,handle))) -(defmacro mm-handle-multipart-from (handle) - `(get-text-property 0 'from (car ,handle))) -(defmacro mm-handle-multipart-ctl-parameter (handle parameter) - `(get-text-property 0 ,parameter (car ,handle))) - -(defmacro mm-make-handle (&optional buffer type encoding undisplayer - disposition description cache - id) - `(list ,buffer ,type ,encoding ,undisplayer - ,disposition ,description ,cache ,id)) - -(defcustom mm-text-html-renderer - (cond ((locate-library "w3") 'w3) - ((executable-find "w3m") (if (locate-library "w3m") - 'w3m - 'w3m-standalone)) - ((executable-find "links") 'links) - ((executable-find "lynx") 'lynx) - (t 'html2text)) - "Render of HTML contents. -It is one of defined renderer types, or a rendering function. -The defined renderer types are: -`w3' : use Emacs/W3; -`w3m' : use emacs-w3m; -`w3m-standalone': use w3m; -`links': use links; -`lynx' : use lynx; -`html2text' : use html2text; -nil : use external viewer." - :version "22.1" - :type '(choice (const w3) - (const w3m) - (const w3m-standalone) - (const links) - (const lynx) - (const html2text) - (const nil) - (function)) - :group 'mime-display) - -(defvar mm-inline-text-html-renderer nil - "Function used for rendering inline HTML contents. -It is suggested to customize `mm-text-html-renderer' instead.") - -(defcustom mm-inline-text-html-with-images nil - "If non-nil, Gnus will allow retrieving images in HTML contents with -the tags. It has no effect on Emacs/w3. See also the -documentation for the `mm-w3m-safe-url-regexp' variable." - :version "22.1" - :type 'boolean - :group 'mime-display) - -(defcustom mm-w3m-safe-url-regexp "\\`cid:" - "Regexp matching URLs which are considered to be safe. -Some HTML mails might contain a nasty trick used by spammers, using -the tag which is far more evil than the [Click Here!] button. -It is most likely intended to check whether the ominous spam mail has -reached your eyes or not, in which case the spammer knows for sure -that your email address is valid. It is done by embedding an -identifier string into a URL that you might automatically retrieve -when displaying the image. The default value is \"\\\\`cid:\" which only -matches parts embedded to the Multipart/Related type MIME contents and -Gnus will never connect to the spammer's site arbitrarily. You may -set this variable to nil if you consider all urls to be safe." - :version "22.1" - :type '(choice (regexp :tag "Regexp") - (const :tag "All URLs are safe" nil)) - :group 'mime-display) - -(defcustom mm-inline-text-html-with-w3m-keymap t - "If non-nil, use emacs-w3m command keys in the article buffer." - :version "22.1" - :type 'boolean - :group 'mime-display) - -(defcustom mm-enable-external t - "Indicate whether external MIME handlers should be used. - -If t, all defined external MIME handlers are used. If nil, files are saved by -`mailcap-save-binary-file'. If it is the symbol `ask', you are prompted -before the external MIME handler is invoked." - :version "22.1" - :type '(choice (const :tag "Always" t) - (const :tag "Never" nil) - (const :tag "Ask" ask)) - :group 'mime-display) - -(defcustom mm-inline-media-tests - '(("image/p?jpeg" - mm-inline-image - (lambda (handle) - (mm-valid-and-fit-image-p 'jpeg handle))) - ("image/png" - mm-inline-image - (lambda (handle) - (mm-valid-and-fit-image-p 'png handle))) - ("image/gif" - mm-inline-image - (lambda (handle) - (mm-valid-and-fit-image-p 'gif handle))) - ("image/tiff" - mm-inline-image - (lambda (handle) - (mm-valid-and-fit-image-p 'tiff handle)) ) - ("image/xbm" - mm-inline-image - (lambda (handle) - (mm-valid-and-fit-image-p 'xbm handle))) - ("image/x-xbitmap" - mm-inline-image - (lambda (handle) - (mm-valid-and-fit-image-p 'xbm handle))) - ("image/xpm" - mm-inline-image - (lambda (handle) - (mm-valid-and-fit-image-p 'xpm handle))) - ("image/x-xpixmap" - mm-inline-image - (lambda (handle) - (mm-valid-and-fit-image-p 'xpm handle))) - ("image/bmp" - mm-inline-image - (lambda (handle) - (mm-valid-and-fit-image-p 'bmp handle))) - ("image/x-portable-bitmap" - mm-inline-image - (lambda (handle) - (mm-valid-and-fit-image-p 'pbm handle))) - ("text/plain" mm-inline-text identity) - ("text/enriched" mm-inline-text identity) - ("text/richtext" mm-inline-text identity) - ("text/x-patch" mm-display-patch-inline - (lambda (handle) - ;; If the diff-mode.el package is installed, the function is - ;; autoloaded. Checking (locate-library "diff-mode") would be trying - ;; to cater to broken installations. OTOH checking the function - ;; makes it possible to install another package which provides an - ;; alternative implementation of diff-mode. --Stef - (fboundp 'diff-mode))) - ("application/emacs-lisp" mm-display-elisp-inline identity) - ("application/x-emacs-lisp" mm-display-elisp-inline identity) - ("text/html" - mm-inline-text-html - (lambda (handle) - (or mm-inline-text-html-renderer - mm-text-html-renderer))) - ("text/x-vcard" - mm-inline-text-vcard - (lambda (handle) - (or (featurep 'vcard) - (locate-library "vcard")))) - ("message/delivery-status" mm-inline-text identity) - ("message/rfc822" mm-inline-message identity) - ("message/partial" mm-inline-partial identity) - ("message/external-body" mm-inline-external-body identity) - ("text/.*" mm-inline-text identity) - ("audio/wav" mm-inline-audio - (lambda (handle) - (and (or (featurep 'nas-sound) (featurep 'native-sound)) - (device-sound-enabled-p)))) - ("audio/au" - mm-inline-audio - (lambda (handle) - (and (or (featurep 'nas-sound) (featurep 'native-sound)) - (device-sound-enabled-p)))) - ("application/pgp-signature" ignore identity) - ("application/x-pkcs7-signature" ignore identity) - ("application/pkcs7-signature" ignore identity) - ("application/x-pkcs7-mime" ignore identity) - ("application/pkcs7-mime" ignore identity) - ("multipart/alternative" ignore identity) - ("multipart/mixed" ignore identity) - ("multipart/related" ignore identity) - ;; Disable audio and image - ("audio/.*" ignore ignore) - ("image/.*" ignore ignore) - ;; Default to displaying as text - (".*" mm-inline-text mm-readable-p)) - "Alist of media types/tests saying whether types can be displayed inline." - :type '(repeat (list (regexp :tag "MIME type") - (function :tag "Display function") - (function :tag "Display test"))) - :group 'mime-display) - -(defcustom mm-inlined-types - '("image/.*" "text/.*" "message/delivery-status" "message/rfc822" - "message/partial" "message/external-body" "application/emacs-lisp" - "application/x-emacs-lisp" - "application/pgp-signature" "application/x-pkcs7-signature" - "application/pkcs7-signature" "application/x-pkcs7-mime" - "application/pkcs7-mime" - ;; Mutt still uses this even though it has already been withdrawn. - "application/pgp") - "List of media types that are to be displayed inline. -See also `mm-inline-media-tests', which says how to display a media -type inline." - :type '(repeat regexp) - :group 'mime-display) - -(defcustom mm-keep-viewer-alive-types - '("application/postscript" "application/msword" "application/vnd.ms-excel" - "application/pdf" "application/x-dvi") - "List of media types for which the external viewer will not be killed -when selecting a different article." - :version "22.1" - :type '(repeat regexp) - :group 'mime-display) - -(defcustom mm-automatic-display - '("text/plain" "text/enriched" "text/richtext" "text/html" - "text/x-vcard" "image/.*" "message/delivery-status" "multipart/.*" - "message/rfc822" "text/x-patch" "application/pgp-signature" - "application/emacs-lisp" "application/x-emacs-lisp" - "application/x-pkcs7-signature" - "application/pkcs7-signature" "application/x-pkcs7-mime" - "application/pkcs7-mime" - ;; Mutt still uses this even though it has already been withdrawn. - "application/pgp\\'") - "A list of MIME types to be displayed automatically." - :type '(repeat regexp) - :group 'mime-display) - -(defcustom mm-attachment-override-types '("text/x-vcard" - "application/pkcs7-mime" - "application/x-pkcs7-mime" - "application/pkcs7-signature" - "application/x-pkcs7-signature") - "Types to have \"attachment\" ignored if they can be displayed inline." - :type '(repeat regexp) - :group 'mime-display) - -(defcustom mm-inline-override-types nil - "Types to be treated as attachments even if they can be displayed inline." - :type '(repeat regexp) - :group 'mime-display) - -(defcustom mm-automatic-external-display nil - "List of MIME type regexps that will be displayed externally automatically." - :type '(repeat regexp) - :group 'mime-display) - -(defcustom mm-discouraged-alternatives nil - "List of MIME types that are discouraged when viewing multipart/alternative. -Viewing agents are supposed to view the last possible part of a message, -as that is supposed to be the richest. However, users may prefer other -types instead, and this list says what types are most unwanted. If, -for instance, text/html parts are very unwanted, and text/richtext are -somewhat unwanted, then the value of this variable should be set -to: - - (\"text/html\" \"text/richtext\") - -Adding \"image/.*\" might also be useful. Spammers use it as the -prefered part of multipart/alternative messages. See also -`gnus-buttonized-mime-types', to which adding \"multipart/alternative\" -enables you to choose manually one of two types those mails include." - :type '(repeat regexp) ;; See `mm-preferred-alternative-precedence'. - :group 'mime-display) - -(defcustom mm-tmp-directory - (if (fboundp 'temp-directory) - (temp-directory) - (if (boundp 'temporary-file-directory) - temporary-file-directory - "/tmp/")) - "Where mm will store its temporary files." - :type 'directory - :group 'mime-display) - -(defcustom mm-inline-large-images nil - "If non-nil, then all images fit in the buffer." - :type 'boolean - :group 'mime-display) - -(defvar mm-file-name-rewrite-functions - '(mm-file-name-delete-control mm-file-name-delete-gotchas) - "*List of functions used for rewriting file names of MIME parts. -Each function takes a file name as input and returns a file name. - -Ready-made functions include -`mm-file-name-delete-control' -`mm-file-name-delete-gotchas' -`mm-file-name-delete-whitespace', -`mm-file-name-trim-whitespace', -`mm-file-name-collapse-whitespace', -`mm-file-name-replace-whitespace', -`capitalize', `downcase', `upcase', and -`upcase-initials'.") - -(defvar mm-path-name-rewrite-functions nil - "*List of functions for rewriting the full file names of MIME parts. -This is used when viewing parts externally, and is meant for -transforming the absolute name so that non-compliant programs can find -the file where it's saved. - -Each function takes a file name as input and returns a file name.") - -(defvar mm-file-name-replace-whitespace nil - "String used for replacing whitespace characters; default is `\"_\"'.") - -(defcustom mm-default-directory nil - "The default directory where mm will save files. -If not set, `default-directory' will be used." - :type '(choice directory (const :tag "Default" nil)) - :group 'mime-display) - -(defcustom mm-attachment-file-modes 384 - "Set the mode bits of saved attachments to this integer." - :version "22.1" - :type 'integer - :group 'mime-display) - -(defcustom mm-external-terminal-program "xterm" - "The program to start an external terminal." - :version "22.1" - :type 'string - :group 'mime-display) - -;;; Internal variables. - -(defvar mm-last-shell-command "") -(defvar mm-content-id-alist nil) -(defvar mm-postponed-undisplay-list nil) - -;; According to RFC2046, in particular, in a digest, the default -;; Content-Type value for a body part is changed from "text/plain" to -;; "message/rfc822". -(defvar mm-dissect-default-type "text/plain") - -(autoload 'mml2015-verify "mml2015") -(autoload 'mml2015-verify-test "mml2015") -(autoload 'mml-smime-verify "mml-smime") -(autoload 'mml-smime-verify-test "mml-smime") - -(defvar mm-verify-function-alist - '(("application/pgp-signature" mml2015-verify "PGP" mml2015-verify-test) - ("application/x-gnus-pgp-signature" mm-uu-pgp-signed-extract-1 "PGP" - mm-uu-pgp-signed-test) - ("application/pkcs7-signature" mml-smime-verify "S/MIME" - mml-smime-verify-test) - ("application/x-pkcs7-signature" mml-smime-verify "S/MIME" - mml-smime-verify-test))) - -(defcustom mm-verify-option 'never - "Option of verifying signed parts. -`never', not verify; `always', always verify; -`known', only verify known protocols. Otherwise, ask user." - :version "22.1" - :type '(choice (item always) - (item never) - (item :tag "only known protocols" known) - (item :tag "ask" nil)) - :group 'mime-security) - -(autoload 'mml2015-decrypt "mml2015") -(autoload 'mml2015-decrypt-test "mml2015") - -(defvar mm-decrypt-function-alist - '(("application/pgp-encrypted" mml2015-decrypt "PGP" mml2015-decrypt-test) - ("application/x-gnus-pgp-encrypted" mm-uu-pgp-encrypted-extract-1 "PGP" - mm-uu-pgp-encrypted-test))) - -(defcustom mm-decrypt-option nil - "Option of decrypting encrypted parts. -`never', not decrypt; `always', always decrypt; -`known', only decrypt known protocols. Otherwise, ask user." - :version "22.1" - :type '(choice (item always) - (item never) - (item :tag "only known protocols" known) - (item :tag "ask" nil)) - :group 'mime-security) - -(defvar mm-viewer-completion-map - (let ((map (make-sparse-keymap 'mm-viewer-completion-map))) - (set-keymap-parent map minibuffer-local-completion-map) - ;; Should we bind other key to minibuffer-complete-word? - (define-key map " " 'self-insert-command) - map) - "Keymap for input viewer with completion.") - -(defvar mm-viewer-completion-map - (let ((map (make-sparse-keymap 'mm-viewer-completion-map))) - (set-keymap-parent map minibuffer-local-completion-map) - ;; Should we bind other key to minibuffer-complete-word? - (define-key map " " 'self-insert-command) - map) - "Keymap for input viewer with completion.") - -;;; The functions. - -(defun mm-alist-to-plist (alist) - "Convert association list ALIST into the equivalent property-list form. -The plist is returned. This converts from - -\((a . 1) (b . 2) (c . 3)) - -into - -\(a 1 b 2 c 3) - -The original alist is not modified. See also `destructive-alist-to-plist'." - (let (plist) - (while alist - (let ((el (car alist))) - (setq plist (cons (cdr el) (cons (car el) plist)))) - (setq alist (cdr alist))) - (nreverse plist))) - -(defun mm-keep-viewer-alive-p (handle) - "Say whether external viewer for HANDLE should stay alive." - (let ((types mm-keep-viewer-alive-types) - (type (mm-handle-media-type handle)) - ty) - (catch 'found - (while (setq ty (pop types)) - (when (string-match ty type) - (throw 'found t)))))) - -(defun mm-handle-set-external-undisplayer (handle function) - "Set the undisplayer for HANDLE to FUNCTION. -Postpone undisplaying of viewers for types in -`mm-keep-viewer-alive-types'." - (if (mm-keep-viewer-alive-p handle) - (let ((new-handle (copy-sequence handle))) - (mm-handle-set-undisplayer new-handle function) - (mm-handle-set-undisplayer handle nil) - (push new-handle mm-postponed-undisplay-list)) - (mm-handle-set-undisplayer handle function))) - -(defun mm-destroy-postponed-undisplay-list () - (when mm-postponed-undisplay-list - (message "Destroying external MIME viewers") - (mm-destroy-parts mm-postponed-undisplay-list))) - -(defun mm-dissect-buffer (&optional no-strict-mime loose-mime from) - "Dissect the current buffer and return a list of MIME handles." - (save-excursion - (let (ct ctl type subtype cte cd description id result) - (save-restriction - (mail-narrow-to-head) - (when (or no-strict-mime - loose-mime - (mail-fetch-field "mime-version")) - (setq ct (mail-fetch-field "content-type") - ctl (and ct (mail-header-parse-content-type ct)) - cte (mail-fetch-field "content-transfer-encoding") - cd (mail-fetch-field "content-disposition") - description (mail-fetch-field "content-description") - id (mail-fetch-field "content-id")) - (unless from - (setq from (mail-fetch-field "from"))) - ;; FIXME: In some circumstances, this code is running within - ;; an unibyte macro. mail-extract-address-components - ;; creates unibyte buffers. This `if', though not a perfect - ;; solution, avoids most of them. - (if from - (setq from (cadr (mail-extract-address-components from)))))) - (when cte - (setq cte (mail-header-strip cte))) - (if (or (not ctl) - (not (string-match "/" (car ctl)))) - (mm-dissect-singlepart - (list mm-dissect-default-type) - (and cte (intern (downcase (mail-header-remove-whitespace - (mail-header-remove-comments - cte))))) - no-strict-mime - (and cd (mail-header-parse-content-disposition cd)) - description) - (setq type (split-string (car ctl) "/")) - (setq subtype (cadr type) - type (car type)) - (setq - result - (cond - ((equal type "multipart") - (let ((mm-dissect-default-type (if (equal subtype "digest") - "message/rfc822" - "text/plain")) - (start (cdr (assq 'start (cdr ctl))))) - (add-text-properties 0 (length (car ctl)) - (mm-alist-to-plist (cdr ctl)) (car ctl)) - - ;; what really needs to be done here is a way to link a - ;; MIME handle back to it's parent MIME handle (in a multilevel - ;; MIME article). That would probably require changing - ;; the mm-handle API so we simply store the multipart buffer - ;; name as a text property of the "multipart/whatever" string. - (add-text-properties 0 (length (car ctl)) - (list 'buffer (mm-copy-to-buffer) - 'from from - 'start start) - (car ctl)) - (cons (car ctl) (mm-dissect-multipart ctl from)))) - (t - (mm-possibly-verify-or-decrypt - (mm-dissect-singlepart - ctl - (and cte (intern (downcase (mail-header-remove-whitespace - (mail-header-remove-comments - cte))))) - no-strict-mime - (and cd (mail-header-parse-content-disposition cd)) - description id) - ctl)))) - (when id - (when (string-match " *<\\(.*\\)> *" id) - (setq id (match-string 1 id))) - (push (cons id result) mm-content-id-alist)) - result)))) - -(defun mm-dissect-singlepart (ctl cte &optional force cdl description id) - (when (or force - (if (equal "text/plain" (car ctl)) - (assoc 'format ctl) - t)) - (mm-make-handle - (mm-copy-to-buffer) ctl cte nil cdl description nil id))) - -(defun mm-dissect-multipart (ctl from) - (goto-char (point-min)) - (let* ((boundary (concat "\n--" (mail-content-type-get ctl 'boundary))) - (close-delimiter (concat (regexp-quote boundary) "--[ \t]*$")) - start parts - (end (save-excursion - (goto-char (point-max)) - (if (re-search-backward close-delimiter nil t) - (match-beginning 0) - (point-max))))) - (setq boundary (concat (regexp-quote boundary) "[ \t]*$")) - (while (and (< (point) end) (re-search-forward boundary end t)) - (goto-char (match-beginning 0)) - (when start - (save-excursion - (save-restriction - (narrow-to-region start (point)) - (setq parts (nconc (list (mm-dissect-buffer t nil from)) parts))))) - (end-of-line 2) - (or (looking-at boundary) - (forward-line 1)) - (setq start (point))) - (when (and start (< start end)) - (save-excursion - (save-restriction - (narrow-to-region start end) - (setq parts (nconc (list (mm-dissect-buffer t nil from)) parts))))) - (mm-possibly-verify-or-decrypt (nreverse parts) ctl))) - -(defun mm-copy-to-buffer () - "Copy the contents of the current buffer to a fresh buffer." - (let ((obuf (current-buffer)) - beg) - (goto-char (point-min)) - (search-forward-regexp "^\n" nil t) - (setq beg (point)) - (with-current-buffer - ;; Preserve the data's unibyteness (for url-insert-file-contents). - (let ((default-enable-multibyte-characters (mm-multibyte-p))) - (generate-new-buffer " *mm*")) - (insert-buffer-substring obuf beg) - (current-buffer)))) - -(defun mm-display-parts (handle &optional no-default) - (if (stringp (car handle)) - (mapcar 'mm-display-parts (cdr handle)) - (if (bufferp (car handle)) - (save-restriction - (narrow-to-region (point) (point)) - (mm-display-part handle) - (goto-char (point-max))) - (mapcar 'mm-display-parts handle)))) - -(defun mm-display-part (handle &optional no-default) - "Display the MIME part represented by HANDLE. -Returns nil if the part is removed; inline if displayed inline; -external if displayed external." - (save-excursion - (mailcap-parse-mailcaps) - (if (mm-handle-displayed-p handle) - (mm-remove-part handle) - (let* ((ehandle (if (equal (mm-handle-media-type handle) - "message/external-body") - (progn - (unless (mm-handle-cache handle) - (mm-extern-cache-contents handle)) - (mm-handle-cache handle)) - handle)) - (type (mm-handle-media-type ehandle)) - (method (mailcap-mime-info type)) - (filename (or (mail-content-type-get - (mm-handle-disposition handle) 'filename) - (mail-content-type-get - (mm-handle-type handle) 'name) - "")) - (external mm-enable-external)) - (if (and (mm-inlinable-p ehandle) - (mm-inlined-p ehandle)) - (progn - (forward-line 1) - (mm-display-inline handle) - 'inline) - (when (or method - (not no-default)) - (if (and (not method) - (equal "text" (car (split-string type "/")))) - (progn - (forward-line 1) - (mm-insert-inline handle (mm-get-part handle)) - 'inline) - (setq external - (and method ;; If nil, we always use "save". - (stringp method) ;; 'mailcap-save-binary-file - (or (eq mm-enable-external t) - (and (eq mm-enable-external 'ask) - (y-or-n-p - (concat - "Display part (" type - ") using external program" - ;; Can non-string method ever happen? - (if (stringp method) - (concat - " \"" (format method filename) "\"") - "") - "? ")))))) - (if external - (mm-display-external - handle (or method 'mailcap-save-binary-file)) - (mm-display-external - handle 'mailcap-save-binary-file))))))))) - -(defun mm-display-external (handle method) - "Display HANDLE using METHOD." - (let ((outbuf (current-buffer))) - (mm-with-unibyte-buffer - (if (functionp method) - (let ((cur (current-buffer))) - (if (eq method 'mailcap-save-binary-file) - (progn - (set-buffer (generate-new-buffer " *mm*")) - (setq method nil)) - (mm-insert-part handle) - (let ((win (get-buffer-window cur t))) - (when win - (select-window win))) - (switch-to-buffer (generate-new-buffer " *mm*"))) - (buffer-disable-undo) - (mm-set-buffer-file-coding-system mm-binary-coding-system) - (insert-buffer-substring cur) - (goto-char (point-min)) - (when method - (message "Viewing with %s" method)) - (let ((mm (current-buffer)) - (non-viewer (assq 'non-viewer - (mailcap-mime-info - (mm-handle-media-type handle) t)))) - (unwind-protect - (if method - (funcall method) - (mm-save-part handle)) - (when (and (not non-viewer) - method) - (mm-handle-set-undisplayer handle mm))))) - ;; The function is a string to be executed. - (mm-insert-part handle) - (let* ((dir (mm-make-temp-file - (expand-file-name "emm." mm-tmp-directory) 'dir)) - (filename (or - (mail-content-type-get - (mm-handle-disposition handle) 'filename) - (mail-content-type-get - (mm-handle-type handle) 'name))) - (mime-info (mailcap-mime-info - (mm-handle-media-type handle) t)) - (needsterm (or (assoc "needsterm" mime-info) - (assoc "needsterminal" mime-info))) - (copiousoutput (assoc "copiousoutput" mime-info)) - file buffer) - ;; We create a private sub-directory where we store our files. - (set-file-modes dir 448) - (if filename - (setq file (expand-file-name - (gnus-map-function mm-file-name-rewrite-functions - (file-name-nondirectory filename)) - dir)) - ;; Use nametemplate (defined in RFC1524) if it is specified - ;; in mailcap. - (let ((suffix (cdr (assoc "nametemplate" mime-info)))) - (if (and suffix - (string-match "\\`%s\\(\\..+\\)\\'" suffix)) - (setq suffix (match-string 1 suffix)) - ;; Otherwise, use a suffix according to - ;; `mailcap-mime-extensions'. - (setq suffix (car (rassoc (mm-handle-media-type handle) - mailcap-mime-extensions)))) - (setq file (mm-make-temp-file (expand-file-name "mm." dir) - nil suffix)))) - (let ((coding-system-for-write mm-binary-coding-system)) - (write-region (point-min) (point-max) file nil 'nomesg)) - (message "Viewing with %s" method) - (cond - (needsterm - (let ((command (mm-mailcap-command - method file (mm-handle-type handle)))) - (unwind-protect - (if window-system - (start-process "*display*" nil - mm-external-terminal-program - "-e" shell-file-name - shell-command-switch command) - (require 'term) - (require 'gnus-win) - (set-buffer - (setq buffer - (make-term "display" - shell-file-name - nil - shell-command-switch command))) - (term-mode) - (term-char-mode) - (set-process-sentinel - (get-buffer-process buffer) - `(lambda (process state) - (if (eq 'exit (process-status process)) - (gnus-configure-windows - ',gnus-current-window-configuration)))) - (gnus-configure-windows 'display-term)) - (mm-handle-set-external-undisplayer handle (cons file buffer))) - (message "Displaying %s..." command)) - 'external) - (copiousoutput - (with-current-buffer outbuf - (forward-line 1) - (mm-insert-inline - handle - (unwind-protect - (progn - (call-process shell-file-name nil - (setq buffer - (generate-new-buffer " *mm*")) - nil - shell-command-switch - (mm-mailcap-command - method file (mm-handle-type handle))) - (if (buffer-live-p buffer) - (with-current-buffer buffer - (buffer-string)))) - (progn - (ignore-errors (delete-file file)) - (ignore-errors (delete-directory - (file-name-directory file))) - (ignore-errors (kill-buffer buffer)))))) - 'inline) - (t - ;; Deleting the temp file should be postponed for some wrappers, - ;; shell scripts, and so on, which might exit right after having - ;; started a viewer command as a background job. - (let ((command (mm-mailcap-command - method file (mm-handle-type handle)))) - (unwind-protect - (progn - (start-process "*display*" - (setq buffer - (generate-new-buffer " *mm*")) - shell-file-name - shell-command-switch command) - (set-process-sentinel - (get-buffer-process buffer) - (lexical-let ;; Don't use `let'. - ;; Function used to remove temp file and directory. - ((fn `(lambda nil - ;; Don't use `ignore-errors'. - (condition-case nil - (delete-file ,file) - (error)) - (condition-case nil - (delete-directory - ,(file-name-directory file)) - (error)))) - ;; Form uses to kill the process buffer and - ;; remove the undisplayer. - (fm `(progn - (kill-buffer ,buffer) - ,(macroexpand - (list 'mm-handle-set-undisplayer - (list 'quote handle) - nil)))) - ;; Message to be issued when the process exits. - (done (format "Displaying %s...done" command)) - ;; In particular, the timer object (which is - ;; a vector in Emacs but is a list in XEmacs) - ;; requires that it is lexically scoped. - (timer (run-at-time 2.0 nil 'ignore))) - (if (boundp 'itimer-list) - (lambda (process state) - (when (eq 'exit (process-status process)) - (if (memq timer itimer-list) - (set-itimer-function timer fn) - (funcall fn)) - (ignore-errors (eval fm)) - (message "%s" done))) - (lambda (process state) - (when (eq 'exit (process-status process)) - (if (memq timer timer-list) - (timer-set-function timer fn) - (funcall fn)) - (ignore-errors (eval fm)) - (message "%s" done))))))) - (mm-handle-set-external-undisplayer - handle (cons file buffer))) - (message "Displaying %s..." command)) - 'external))))))) - -(defun mm-mailcap-command (method file type-list) - (let ((ctl (cdr type-list)) - (beg 0) - (uses-stdin t) - out sub total) - (while (string-match "%{\\([^}]+\\)}\\|'%s'\\|\"%s\"\\|%s\\|%t\\|%%" - method beg) - (push (substring method beg (match-beginning 0)) out) - (setq beg (match-end 0) - total (match-string 0 method) - sub (match-string 1 method)) - (cond - ((string= total "%%") - (push "%" out)) - ((or (string= total "%s") - ;; We do our own quoting. - (string= total "'%s'") - (string= total "\"%s\"")) - (setq uses-stdin nil) - (push (mm-quote-arg - (gnus-map-function mm-path-name-rewrite-functions file)) out)) - ((string= total "%t") - (push (mm-quote-arg (car type-list)) out)) - (t - (push (mm-quote-arg (or (cdr (assq (intern sub) ctl)) "")) out)))) - (push (substring method beg (length method)) out) - (when uses-stdin - (push "<" out) - (push (mm-quote-arg - (gnus-map-function mm-path-name-rewrite-functions file)) - out)) - (mapconcat 'identity (nreverse out) ""))) - -(defun mm-remove-parts (handles) - "Remove the displayed MIME parts represented by HANDLES." - (if (and (listp handles) - (bufferp (car handles))) - (mm-remove-part handles) - (let (handle) - (while (setq handle (pop handles)) - (cond - ((stringp handle) - (when (buffer-live-p (get-text-property 0 'buffer handle)) - (kill-buffer (get-text-property 0 'buffer handle)))) - ((and (listp handle) - (stringp (car handle))) - (mm-remove-parts (cdr handle))) - (t - (mm-remove-part handle))))))) - -(defun mm-destroy-parts (handles) - "Remove the displayed MIME parts represented by HANDLES." - (if (and (listp handles) - (bufferp (car handles))) - (mm-destroy-part handles) - (let (handle) - (while (setq handle (pop handles)) - (cond - ((stringp handle) - (when (buffer-live-p (get-text-property 0 'buffer handle)) - (kill-buffer (get-text-property 0 'buffer handle)))) - ((and (listp handle) - (stringp (car handle))) - (mm-destroy-parts handle)) - (t - (mm-destroy-part handle))))))) - -(defun mm-remove-part (handle) - "Remove the displayed MIME part represented by HANDLE." - (when (listp handle) - (let ((object (mm-handle-undisplayer handle))) - (ignore-errors - (cond - ;; Internally displayed part. - ((mm-annotationp object) - (delete-annotation object)) - ((or (functionp object) - (and (listp object) - (eq (car object) 'lambda))) - (funcall object)) - ;; Externally displayed part. - ((consp object) - (condition-case () - (while (get-buffer-process (cdr object)) - (interrupt-process (get-buffer-process (cdr object))) - (message "Waiting for external displayer to die...") - (sit-for 1)) - (quit) - (error)) - (ignore-errors (and (cdr object) (kill-buffer (cdr object)))) - (message "Waiting for external displayer to die...done") - (ignore-errors (delete-file (car object))) - (ignore-errors (delete-directory (file-name-directory - (car object))))) - ((bufferp object) - (when (buffer-live-p object) - (kill-buffer object))))) - (mm-handle-set-undisplayer handle nil)))) - -(defun mm-display-inline (handle) - (let* ((type (mm-handle-media-type handle)) - (function (cadr (mm-assoc-string-match mm-inline-media-tests type)))) - (funcall function handle) - (goto-char (point-min)))) - -(defun mm-assoc-string-match (alist type) - (dolist (elem alist) - (when (string-match (car elem) type) - (return elem)))) - -(defun mm-automatic-display-p (handle) - "Say whether the user wants HANDLE to be displayed automatically." - (let ((methods mm-automatic-display) - (type (mm-handle-media-type handle)) - method result) - (while (setq method (pop methods)) - (when (and (not (mm-inline-override-p handle)) - (string-match method type)) - (setq result t - methods nil))) - result)) - -(defun mm-inlinable-p (handle &optional type) - "Say whether HANDLE can be displayed inline. -TYPE is the mime-type of the object; it defaults to the one given -in HANDLE." - (unless type (setq type (mm-handle-media-type handle))) - (let ((alist mm-inline-media-tests) - test) - (while alist - (when (string-match (caar alist) type) - (setq test (caddar alist) - alist nil) - (setq test (funcall test handle))) - (pop alist)) - test)) - -(defun mm-inlined-p (handle) - "Say whether the user wants HANDLE to be displayed inline." - (let ((methods mm-inlined-types) - (type (mm-handle-media-type handle)) - method result) - (while (setq method (pop methods)) - (when (and (not (mm-inline-override-p handle)) - (string-match method type)) - (setq result t - methods nil))) - result)) - -(defun mm-attachment-override-p (handle) - "Say whether HANDLE should have attachment behavior overridden." - (let ((types mm-attachment-override-types) - (type (mm-handle-media-type handle)) - ty) - (catch 'found - (while (setq ty (pop types)) - (when (and (string-match ty type) - (mm-inlinable-p handle)) - (throw 'found t)))))) - -(defun mm-inline-override-p (handle) - "Say whether HANDLE should have inline behavior overridden." - (let ((types mm-inline-override-types) - (type (mm-handle-media-type handle)) - ty) - (catch 'found - (while (setq ty (pop types)) - (when (string-match ty type) - (throw 'found t)))))) - -(defun mm-automatic-external-display-p (type) - "Return the user-defined method for TYPE." - (let ((methods mm-automatic-external-display) - method result) - (while (setq method (pop methods)) - (when (string-match method type) - (setq result t - methods nil))) - result)) - -(defun mm-destroy-part (handle) - "Destroy the data structures connected to HANDLE." - (when (listp handle) - (mm-remove-part handle) - (when (buffer-live-p (mm-handle-buffer handle)) - (kill-buffer (mm-handle-buffer handle))))) - -(defun mm-handle-displayed-p (handle) - "Say whether HANDLE is displayed or not." - (mm-handle-undisplayer handle)) - -;;; -;;; Functions for outputting parts -;;; - -(defmacro mm-with-part (handle &rest forms) - "Run FORMS in the temp buffer containing the contents of HANDLE." - `(let* ((handle ,handle) - ;; The multibyteness of the temp buffer should be turned on - ;; if inserting a multibyte string. Contrarily, the buffer's - ;; multibyteness should be off if inserting a unibyte string, - ;; especially if a string contains 8bit data. - (default-enable-multibyte-characters - (with-current-buffer (mm-handle-buffer handle) - (mm-multibyte-p)))) - (with-temp-buffer - (insert-buffer-substring (mm-handle-buffer handle)) - (mm-disable-multibyte) - (mm-decode-content-transfer-encoding - (mm-handle-encoding handle) - (mm-handle-media-type handle)) - ,@forms))) -(put 'mm-with-part 'lisp-indent-function 1) -(put 'mm-with-part 'edebug-form-spec '(body)) - -(defun mm-get-part (handle &optional no-cache) - "Return the contents of HANDLE as a string. -If NO-CACHE is non-nil, cached contents of a message/external-body part -are ignored." - (if (and (not no-cache) - (equal (mm-handle-media-type handle) "message/external-body")) - (progn - (unless (mm-handle-cache handle) - (mm-extern-cache-contents handle)) - (with-current-buffer (mm-handle-buffer (mm-handle-cache handle)) - (buffer-string))) - (mm-with-part handle - (buffer-string)))) - -(defun mm-insert-part (handle &optional no-cache) - "Insert the contents of HANDLE in the current buffer. -If NO-CACHE is non-nil, cached contents of a message/external-body part -are ignored." - (save-excursion - (insert - (cond ((eq (mail-content-type-get (mm-handle-type handle) 'charset) - 'gnus-decoded) - (with-current-buffer (mm-handle-buffer handle) - (buffer-string))) - ((mm-multibyte-p) - (mm-string-to-multibyte (mm-get-part handle no-cache))) - (t - (mm-get-part handle no-cache)))))) - -(defun mm-file-name-delete-whitespace (file-name) - "Remove all whitespace characters from FILE-NAME." - (while (string-match "\\s-+" file-name) - (setq file-name (replace-match "" t t file-name))) - file-name) - -(defun mm-file-name-trim-whitespace (file-name) - "Remove leading and trailing whitespace characters from FILE-NAME." - (when (string-match "\\`\\s-+" file-name) - (setq file-name (substring file-name (match-end 0)))) - (when (string-match "\\s-+\\'" file-name) - (setq file-name (substring file-name 0 (match-beginning 0)))) - file-name) - -(defun mm-file-name-collapse-whitespace (file-name) - "Collapse multiple whitespace characters in FILE-NAME." - (while (string-match "\\s-\\s-+" file-name) - (setq file-name (replace-match " " t t file-name))) - file-name) - -(defun mm-file-name-replace-whitespace (file-name) - "Replace whitespace characters in FILE-NAME with underscores. -Set the option `mm-file-name-replace-whitespace' to any other -string if you do not like underscores." - (let ((s (or mm-file-name-replace-whitespace "_"))) - (while (string-match "\\s-" file-name) - (setq file-name (replace-match s t t file-name)))) - file-name) - -(defun mm-file-name-delete-control (filename) - "Delete control characters from FILENAME." - (gnus-replace-in-string filename "[\x00-\x1f\x7f]" "")) - -(defun mm-file-name-delete-gotchas (filename) - "Delete shell gotchas from FILENAME." - (setq filename (gnus-replace-in-string filename "[<>|]" "")) - (gnus-replace-in-string filename "^[.-]+" "")) - -(defun mm-save-part (handle) - "Write HANDLE to a file." - (let ((filename (or (mail-content-type-get - (mm-handle-disposition handle) 'filename) - (mail-content-type-get - (mm-handle-type handle) 'name))) - file) - (when filename - (setq filename (gnus-map-function mm-file-name-rewrite-functions - (file-name-nondirectory filename)))) - (setq file - (mm-with-multibyte - (read-file-name "Save MIME part to: " - (or mm-default-directory default-directory) - nil nil (or filename "")))) - (setq mm-default-directory (file-name-directory file)) - (and (or (not (file-exists-p file)) - (yes-or-no-p (format "File %s already exists; overwrite? " - file))) - (progn - (mm-save-part-to-file handle file) - file)))) - -(defun mm-save-part-to-file (handle file) - (mm-with-unibyte-buffer - (mm-insert-part handle) - (let ((coding-system-for-write 'binary) - (current-file-modes (default-file-modes)) - ;; Don't re-compress .gz & al. Arguably we should make - ;; `file-name-handler-alist' nil, but that would chop - ;; ange-ftp, which is reasonable to use here. - (inhibit-file-name-operation 'write-region) - (inhibit-file-name-handlers - (cons 'jka-compr-handler inhibit-file-name-handlers))) - (set-default-file-modes mm-attachment-file-modes) - (unwind-protect - (write-region (point-min) (point-max) file) - (set-default-file-modes current-file-modes))))) - -(defun mm-pipe-part (handle) - "Pipe HANDLE to a process." - (let* ((name (mail-content-type-get (mm-handle-type handle) 'name)) - (command - (read-string "Shell command on MIME part: " mm-last-shell-command))) - (mm-with-unibyte-buffer - (mm-insert-part handle) - (let ((coding-system-for-write 'binary)) - (shell-command-on-region (point-min) (point-max) command nil))))) - -(defun mm-interactively-view-part (handle) - "Display HANDLE using METHOD." - (let* ((type (mm-handle-media-type handle)) - (methods - (mapcar (lambda (i) (list (cdr (assoc 'viewer i)))) - (mailcap-mime-info type 'all))) - (method (let ((minibuffer-local-completion-map - mm-viewer-completion-map)) - (completing-read "Viewer: " methods)))) - (when (string= method "") - (error "No method given")) - (if (string-match "^[^% \t]+$" method) - (setq method (concat method " %s"))) - (mm-display-external handle method))) - -(defun mm-preferred-alternative (handles &optional preferred) - "Say which of HANDLES are preferred." - (let ((prec (if preferred (list preferred) - (mm-preferred-alternative-precedence handles))) - p h result type handle) - (while (setq p (pop prec)) - (setq h handles) - (while h - (setq handle (car h)) - (setq type (mm-handle-media-type handle)) - (when (and (equal p type) - (mm-automatic-display-p handle) - (or (stringp (car handle)) - (not (mm-handle-disposition handle)) - (equal (car (mm-handle-disposition handle)) - "inline"))) - (setq result handle - h nil - prec nil)) - (pop h))) - result)) - -(defun mm-preferred-alternative-precedence (handles) - "Return the precedence based on HANDLES and `mm-discouraged-alternatives'." - (let ((seq (nreverse (mapcar #'mm-handle-media-type - handles)))) - (dolist (disc (reverse mm-discouraged-alternatives)) - (dolist (elem (copy-sequence seq)) - (when (string-match disc elem) - (setq seq (nconc (delete elem seq) (list elem)))))) - seq)) - -(defun mm-get-content-id (id) - "Return the handle(s) referred to by ID." - (cdr (assoc id mm-content-id-alist))) - -(defconst mm-image-type-regexps - '(("/\\*.*XPM.\\*/" . xpm) - ("P[1-6]" . pbm) - ("GIF8" . gif) - ("\377\330" . jpeg) - ("\211PNG\r\n" . png) - ("#define" . xbm) - ("\\(MM\0\\*\\)\\|\\(II\\*\0\\)" . tiff) - ("%!PS" . postscript)) - "Alist of (REGEXP . IMAGE-TYPE) pairs used to auto-detect image types. -When the first bytes of an image file match REGEXP, it is assumed to -be of image type IMAGE-TYPE.") - -;; Steal from image.el. image-type-from-data suffers multi-line matching bug. -(defun mm-image-type-from-buffer () - "Determine the image type from data in the current buffer. -Value is a symbol specifying the image type or nil if type cannot -be determined." - (let ((types mm-image-type-regexps) - type) - (goto-char (point-min)) - (while (and types (null type)) - (let ((regexp (car (car types))) - (image-type (cdr (car types)))) - (when (looking-at regexp) - (setq type image-type)) - (setq types (cdr types)))) - type)) - -(defun mm-get-image (handle) - "Return an image instance based on HANDLE." - (let ((type (mm-handle-media-subtype handle)) - spec) - ;; Allow some common translations. - (setq type - (cond - ((equal type "x-pixmap") - "xpm") - ((equal type "x-xbitmap") - "xbm") - ((equal type "x-portable-bitmap") - "pbm") - (t type))) - (or (mm-handle-cache handle) - (mm-with-unibyte-buffer - (mm-insert-part handle) - (prog1 - (setq spec - (ignore-errors - ;; Avoid testing `make-glyph' since W3 may define - ;; a bogus version of it. - (if (fboundp 'create-image) - (create-image (buffer-string) - (or (mm-image-type-from-buffer) - (intern type)) - 'data-p) - (mm-create-image-xemacs type)))) - (mm-handle-set-cache handle spec)))))) - -(defun mm-create-image-xemacs (type) - (cond - ((equal type "xbm") - ;; xbm images require special handling, since - ;; the only way to create glyphs from these - ;; (without a ton of work) is to write them - ;; out to a file, and then create a file - ;; specifier. - (let ((file (mm-make-temp-file - (expand-file-name "emm" mm-tmp-directory) - nil ".xbm"))) - (unwind-protect - (progn - (write-region (point-min) (point-max) file) - (make-glyph (list (cons 'x file)))) - (ignore-errors - (delete-file file))))) - (t - (make-glyph - (vector - (or (mm-image-type-from-buffer) - (intern type)) - :data (buffer-string)))))) - -(defun mm-image-fit-p (handle) - "Say whether the image in HANDLE will fit the current window." - (let ((image (mm-get-image handle))) - (or (not image) - (if (fboundp 'glyph-width) - ;; XEmacs' glyphs can actually tell us about their width, so - ;; lets be nice and smart about them. - (or mm-inline-large-images - (and (<= (glyph-width image) (window-pixel-width)) - (<= (glyph-height image) (window-pixel-height)))) - (let* ((size (image-size image)) - (w (car size)) - (h (cdr size))) - (or mm-inline-large-images - (and (<= h (1- (window-height))) ; Don't include mode line. - (<= w (window-width))))))))) - -(defun mm-valid-image-format-p (format) - "Say whether FORMAT can be displayed natively by Emacs." - (cond - ;; Handle XEmacs - ((fboundp 'valid-image-instantiator-format-p) - (valid-image-instantiator-format-p format)) - ;; Handle Emacs 21 - ((fboundp 'image-type-available-p) - (and (display-graphic-p) - (image-type-available-p format))) - ;; Nobody else can do images yet. - (t - nil))) - -(defun mm-valid-and-fit-image-p (format handle) - "Say whether FORMAT can be displayed natively and HANDLE fits the window." - (and (mm-valid-image-format-p format) - (mm-image-fit-p handle))) - -(defun mm-find-part-by-type (handles type &optional notp recursive) - "Search in HANDLES for part with TYPE. -If NOTP, returns first non-matching part. -If RECURSIVE, search recursively." - (let (handle) - (while handles - (if (and recursive (stringp (caar handles))) - (if (setq handle (mm-find-part-by-type (cdar handles) type - notp recursive)) - (setq handles nil)) - (if (if notp - (not (equal (mm-handle-media-type (car handles)) type)) - (equal (mm-handle-media-type (car handles)) type)) - (setq handle (car handles) - handles nil))) - (setq handles (cdr handles))) - handle)) - -(defun mm-find-raw-part-by-type (ctl type &optional notp) - (goto-char (point-min)) - (let* ((boundary (concat "--" (mm-handle-multipart-ctl-parameter ctl - 'boundary))) - (close-delimiter (concat "^" (regexp-quote boundary) "--[ \t]*$")) - start - (end (save-excursion - (goto-char (point-max)) - (if (re-search-backward close-delimiter nil t) - (match-beginning 0) - (point-max)))) - result) - (setq boundary (concat "^" (regexp-quote boundary) "[ \t]*$")) - (while (and (not result) - (re-search-forward boundary end t)) - (goto-char (match-beginning 0)) - (when start - (save-excursion - (save-restriction - (narrow-to-region start (1- (point))) - (when (let* ((ct (mail-fetch-field "content-type")) - (ctl (and ct (mail-header-parse-content-type ct)))) - (if notp - (not (equal (car ctl) type)) - (equal (car ctl) type))) - (setq result (buffer-string)))))) - (forward-line 1) - (setq start (point))) - (when (and (not result) start) - (save-excursion - (save-restriction - (narrow-to-region start end) - (when (let* ((ct (mail-fetch-field "content-type")) - (ctl (and ct (mail-header-parse-content-type ct)))) - (if notp - (not (equal (car ctl) type)) - (equal (car ctl) type))) - (setq result (buffer-string)))))) - result)) - -(defvar mm-security-handle nil) - -(defsubst mm-set-handle-multipart-parameter (handle parameter value) - ;; HANDLE could be a CTL. - (when handle - (put-text-property 0 (length (car handle)) parameter value - (car handle)))) - -(defun mm-possibly-verify-or-decrypt (parts ctl) - (let ((type (car ctl)) - (subtype (cadr (split-string (car ctl) "/"))) - (mm-security-handle ctl) ;; (car CTL) is the type. - protocol func functest) - (cond - ((or (equal type "application/x-pkcs7-mime") - (equal type "application/pkcs7-mime")) - (with-temp-buffer - (when (and (cond - ((eq mm-decrypt-option 'never) nil) - ((eq mm-decrypt-option 'always) t) - ((eq mm-decrypt-option 'known) t) - (t (y-or-n-p - (format "Decrypt (S/MIME) part? ")))) - (mm-view-pkcs7 parts)) - (setq parts (mm-dissect-buffer t))))) - ((equal subtype "signed") - (unless (and (setq protocol - (mm-handle-multipart-ctl-parameter ctl 'protocol)) - (not (equal protocol "multipart/mixed"))) - ;; The message is broken or draft-ietf-openpgp-multsig-01. - (let ((protocols mm-verify-function-alist)) - (while protocols - (if (and (or (not (setq functest (nth 3 (car protocols)))) - (funcall functest parts ctl)) - (mm-find-part-by-type parts (caar protocols) nil t)) - (setq protocol (caar protocols) - protocols nil) - (setq protocols (cdr protocols)))))) - (setq func (nth 1 (assoc protocol mm-verify-function-alist))) - (when (cond - ((eq mm-verify-option 'never) nil) - ((eq mm-verify-option 'always) t) - ((eq mm-verify-option 'known) - (and func - (or (not (setq functest - (nth 3 (assoc protocol - mm-verify-function-alist)))) - (funcall functest parts ctl)))) - (t - (y-or-n-p - (format "Verify signed (%s) part? " - (or (nth 2 (assoc protocol mm-verify-function-alist)) - (format "protocol=%s" protocol)))))) - (save-excursion - (if func - (funcall func parts ctl) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details - (format "Unknown sign protocol (%s)" protocol)))))) - ((equal subtype "encrypted") - (unless (setq protocol - (mm-handle-multipart-ctl-parameter ctl 'protocol)) - ;; The message is broken. - (let ((parts parts)) - (while parts - (if (assoc (mm-handle-media-type (car parts)) - mm-decrypt-function-alist) - (setq protocol (mm-handle-media-type (car parts)) - parts nil) - (setq parts (cdr parts)))))) - (setq func (nth 1 (assoc protocol mm-decrypt-function-alist))) - (when (cond - ((eq mm-decrypt-option 'never) nil) - ((eq mm-decrypt-option 'always) t) - ((eq mm-decrypt-option 'known) - (and func - (or (not (setq functest - (nth 3 (assoc protocol - mm-decrypt-function-alist)))) - (funcall functest parts ctl)))) - (t - (y-or-n-p - (format "Decrypt (%s) part? " - (or (nth 2 (assoc protocol mm-decrypt-function-alist)) - (format "protocol=%s" protocol)))))) - (save-excursion - (if func - (setq parts (funcall func parts ctl)) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details - (format "Unknown encrypt protocol (%s)" protocol)))))) - (t nil)) - parts)) - -(defun mm-multiple-handles (handles) - (and (listp handles) - (> (length handles) 1) - (or (listp (car handles)) - (stringp (car handles))))) - -(defun mm-complicated-handles (handles) - (and (listp (car handles)) - (> (length handles) 1))) - -(defun mm-merge-handles (handles1 handles2) - (append - (if (listp (car handles1)) - handles1 - (list handles1)) - (if (listp (car handles2)) - handles2 - (list handles2)))) - -(defun mm-readable-p (handle) - "Say whether the content of HANDLE is readable." - (and (< (with-current-buffer (mm-handle-buffer handle) - (buffer-size)) 10000) - (mm-with-unibyte-buffer - (mm-insert-part handle) - (and (eq (mm-body-7-or-8) '7bit) - (not (mm-long-lines-p 76)))))) - -(provide 'mm-decode) - -;; arch-tag: 4f35d360-56b8-4030-9388-3ed82d359b9b -;;; mm-decode.el ends here diff --git a/xemacs-packages/gnus/lisp/mm-encode.el b/xemacs-packages/gnus/lisp/mm-encode.el deleted file mode 100644 index d22c59c5..00000000 --- a/xemacs-packages/gnus/lisp/mm-encode.el +++ /dev/null @@ -1,210 +0,0 @@ -;;; mm-encode.el --- Functions for encoding MIME things - -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; MORIOKA Tomohiko -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) -(require 'mail-parse) -(require 'mailcap) -(eval-and-compile - (autoload 'mm-body-7-or-8 "mm-bodies") - (autoload 'mm-long-lines-p "mm-bodies")) - -(defcustom mm-content-transfer-encoding-defaults - '(("text/x-patch" 8bit) - ("text/.*" qp-or-base64) - ("message/rfc822" 8bit) - ("application/emacs-lisp" qp-or-base64) - ("application/x-emacs-lisp" qp-or-base64) - ("application/x-patch" qp-or-base64) - (".*" base64)) - "Alist of regexps that match MIME types and their encodings. -If the encoding is `qp-or-base64', then either quoted-printable -or base64 will be used, depending on what is more efficient. - -`qp-or-base64' has another effect. It will fold long lines so that -MIME parts may not be broken by MTA. So do `quoted-printable' and -`base64'. - -Note: It affects body encoding only when a part is a raw forwarded -message (which will be made by `gnus-summary-mail-forward' with the -arg 2 for example) or is neither the text/* type nor the message/* -type. Even though in those cases, you can use the `encoding' MML tag -to specify encoding of non-ASCII MIME parts." - :type '(repeat (list (regexp :tag "MIME type") - (choice :tag "encoding" - (const 7bit) - (const 8bit) - (const qp-or-base64) - (const quoted-printable) - (const base64)))) - :group 'mime) - -(defvar mm-use-ultra-safe-encoding nil - "If non-nil, use encodings aimed at Procrustean bed survival. - -This means that textual parts are encoded as quoted-printable if they -contain lines longer than 76 characters or starting with \"From \" in -the body. Non-7bit encodings (8bit, binary) are generally disallowed. -This is to reduce the probability that a broken MTA or MDA changes the -message. - -This variable should never be set directly, but bound before a call to -`mml-generate-mime' or similar functions.") - -(defun mm-insert-rfc822-headers (charset encoding) - "Insert text/plain headers with CHARSET and ENCODING." - (insert "MIME-Version: 1.0\n") - (insert "Content-Type: text/plain; charset=" - (mail-quote-string (downcase (symbol-name charset))) "\n") - (insert "Content-Transfer-Encoding: " - (downcase (symbol-name encoding)) "\n")) - -(defun mm-insert-multipart-headers () - "Insert multipart/mixed headers." - (let ((boundary "=-=-=")) - (insert "MIME-Version: 1.0\n") - (insert "Content-Type: multipart/mixed; boundary=\"" boundary "\"\n") - boundary)) - -(defun mm-default-file-encoding (file) - "Return a default encoding for FILE." - (if (not (string-match "\\.[^.]+$" file)) - "application/octet-stream" - (mailcap-extension-to-mime (match-string 0 file)))) - -(defun mm-safer-encoding (encoding) - "Return an encoding similar to ENCODING but safer than it." - (cond - ((eq encoding '7bit) '7bit) ;; 7bit is considered safe. - ((memq encoding '(8bit quoted-printable)) 'quoted-printable) - ;; The remaining encodings are binary and base64 (and perhaps some - ;; non-standard ones), which are both turned into base64. - (t 'base64))) - -(defun mm-encode-content-transfer-encoding (encoding &optional type) - "Encode the current buffer with ENCODING for MIME type TYPE. -ENCODING can be: nil (do nothing); one of `quoted-printable', `base64'; -`7bit', `8bit' or `binary' (all do nothing); a function to do the encoding." - (cond - ((eq encoding 'quoted-printable) - ;; This used to try to make a multibyte buffer unibyte. That's - ;; completely wrong, since you'd get QP-encoded emacs-mule. If - ;; this gets run on multibyte text it's an error that needs - ;; fixing, and the encoding function will signal an error. - ;; Likewise base64 below. - (quoted-printable-encode-region (point-min) (point-max) t)) - ((eq encoding 'base64) - (when (string-match "\\`text/" type) - (goto-char (point-min)) - (while (search-forward "\n" nil t) - (replace-match "\r\n" t t))) - (base64-encode-region (point-min) (point-max))) - ((memq encoding '(7bit 8bit binary)) - ;; Do nothing. - ) - ((null encoding) - ;; Do nothing. - ) - ;; Fixme: Ignoring errors here looks bogus. - ((functionp encoding) - (ignore-errors (funcall encoding (point-min) (point-max)))) - (t - (error "Unknown encoding %s" encoding)))) - -(defun mm-encode-buffer (type) - "Encode the buffer which contains data of MIME type TYPE. -TYPE is a string or a list of the components. -The encoding used is returned." - (let* ((mime-type (if (stringp type) type (car type))) - (encoding - (or (and (listp type) - (cadr (assq 'encoding type))) - (mm-content-transfer-encoding mime-type))) - (bits (mm-body-7-or-8))) - ;; We force buffers that are 7bit to be unencoded, no matter - ;; what the preferred encoding is. - ;; Only if the buffers don't contain lone lines. - (when (and (eq bits '7bit) (not (mm-long-lines-p 76))) - (setq encoding bits)) - (mm-encode-content-transfer-encoding encoding mime-type) - encoding)) - -(defun mm-insert-headers (type encoding &optional file) - "Insert headers for TYPE." - (insert "Content-Type: " type) - (when file - (insert ";\n\tname=\"" (file-name-nondirectory file) "\"")) - (insert "\n") - (insert (format "Content-Transfer-Encoding: %s\n" encoding)) - (insert "Content-Disposition: inline") - (when file - (insert ";\n\tfilename=\"" (file-name-nondirectory file) "\"")) - (insert "\n") - (insert "\n")) - -(defun mm-content-transfer-encoding (type) - "Return a CTE suitable for TYPE to encode the current buffer." - (let ((rules mm-content-transfer-encoding-defaults)) - (catch 'found - (while rules - (when (string-match (caar rules) type) - (throw 'found - (let ((encoding - (if (eq (cadr (car rules)) 'qp-or-base64) - (mm-qp-or-base64) - (cadr (car rules))))) - (if mm-use-ultra-safe-encoding - (mm-safer-encoding encoding) - encoding)))) - (pop rules))))) - -(defun mm-qp-or-base64 () - "Return the type with which to encode the buffer. -This is either `base64' or `quoted-printable'." - (if (equal mm-use-ultra-safe-encoding '(sign . "pgp")) - ;; perhaps not always accurate? - 'quoted-printable - (save-excursion - (let ((limit (min (point-max) (+ 2000 (point-min)))) - (n8bit 0)) - (goto-char (point-min)) - (skip-chars-forward "\x20-\x7f\r\n\t" limit) - (while (< (point) limit) - (incf n8bit) - (forward-char 1) - (skip-chars-forward "\x20-\x7f\r\n\t" limit)) - (if (or (< (* 6 n8bit) (- limit (point-min))) - ;; Don't base64, say, a short line with a single - ;; non-ASCII char when splitting parts by charset. - (= n8bit 1)) - 'quoted-printable - 'base64))))) - -(provide 'mm-encode) - -;;; arch-tag: 7d01bba4-d469-4851-952b-dc863f84ed66 -;;; mm-encode.el ends here diff --git a/xemacs-packages/gnus/lisp/mm-extern.el b/xemacs-packages/gnus/lisp/mm-extern.el deleted file mode 100644 index ce9b0009..00000000 --- a/xemacs-packages/gnus/lisp/mm-extern.el +++ /dev/null @@ -1,169 +0,0 @@ -;;; mm-extern.el --- showing message/external-body - -;; Copyright (C) 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Shenghuo Zhu -;; Keywords: message external-body - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published -;; by the Free Software Foundation; either version 3, or (at your -;; option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'mm-util) -(require 'mm-decode) -(require 'mm-url) - -(defvar gnus-article-mime-handles) - -(defvar mm-extern-function-alist - '((local-file . mm-extern-local-file) - (url . mm-extern-url) - (anon-ftp . mm-extern-anon-ftp) - (ftp . mm-extern-ftp) -;;; (tftp . mm-extern-tftp) - (mail-server . mm-extern-mail-server) -;;; (afs . mm-extern-afs)) - )) - -(defvar mm-extern-anonymous "anonymous") - -(defun mm-extern-local-file (handle) - (erase-buffer) - (let ((name (cdr (assq 'name (cdr (mm-handle-type handle))))) - (coding-system-for-read mm-binary-coding-system)) - (unless name - (error "The filename is not specified")) - (mm-disable-multibyte) - (if (file-exists-p name) - (mm-insert-file-contents name nil nil nil nil t) - (error "File %s is gone" name)))) - -(defun mm-extern-url (handle) - (erase-buffer) - (let ((url (cdr (assq 'url (cdr (mm-handle-type handle))))) - (name buffer-file-name) - (coding-system-for-read mm-binary-coding-system)) - (unless url - (error "URL is not specified")) - (mm-with-unibyte-current-buffer - (mm-url-insert-file-contents url)) - (mm-disable-multibyte) - (setq buffer-file-name name))) - -(defun mm-extern-anon-ftp (handle) - (erase-buffer) - (let* ((params (cdr (mm-handle-type handle))) - (name (cdr (assq 'name params))) - (site (cdr (assq 'site params))) - (directory (cdr (assq 'directory params))) - (mode (cdr (assq 'mode params))) - (path (concat "/" (or mm-extern-anonymous - (read-string (format "ID for %s: " site))) - "@" site ":" directory "/" name)) - (coding-system-for-read mm-binary-coding-system)) - (unless name - (error "The filename is not specified")) - (mm-disable-multibyte) - (mm-insert-file-contents path nil nil nil nil t))) - -(defun mm-extern-ftp (handle) - (let (mm-extern-anonymous) - (mm-extern-anon-ftp handle))) - -(defun mm-extern-mail-server (handle) - (require 'message) - (let* ((params (cdr (mm-handle-type handle))) - (server (cdr (assq 'server params))) - (subject (or (cdr (assq 'subject params)) "none")) - (buf (current-buffer)) - info) - (if (y-or-n-p (format "Send a request message to %s? " server)) - (save-window-excursion - (message-mail server subject) - (message-goto-body) - (delete-region (point) (point-max)) - (insert-buffer-substring buf) - (message "Requesting external body...") - (message-send-and-exit) - (setq info "Request is sent.") - (message info)) - (setq info "Request is not sent.")) - (goto-char (point-min)) - (insert "[" info "]\n\n"))) - -;;;###autoload -(defun mm-extern-cache-contents (handle) - "Put the external-body part of HANDLE into its cache." - (let* ((access-type (cdr (assq 'access-type - (cdr (mm-handle-type handle))))) - (func (cdr (assq (intern - (downcase - (or access-type - (error "Couldn't find access type")))) - mm-extern-function-alist))) - buf handles) - (unless func - (error "Access type (%s) is not supported" access-type)) - (mm-with-part handle - (goto-char (point-max)) - (insert "\n\n") - ;; It should be just a single MIME handle. - (setq handles (mm-dissect-buffer t))) - (unless (bufferp (car handles)) - (mm-destroy-parts handles) - (error "Multipart external body is not supported")) - (save-excursion - (set-buffer (setq buf (mm-handle-buffer handles))) - (let (good) - (unwind-protect - (progn - (funcall func handle) - (setq good t)) - (unless good - (mm-destroy-parts handles)))) - (mm-handle-set-cache handle handles)) - (setq gnus-article-mime-handles - (mm-merge-handles gnus-article-mime-handles handles)))) - -;;;###autoload -(defun mm-inline-external-body (handle &optional no-display) - "Show the external-body part of HANDLE. -This function replaces the buffer of HANDLE with a buffer contains -the entire message. -If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing." - (unless (mm-handle-cache handle) - (mm-extern-cache-contents handle)) - (unless no-display - (save-excursion - (save-restriction - (narrow-to-region (point) (point)) - (mm-display-part (mm-handle-cache handle)))) - ;; Move undisplayer added to the cached handle to the parent. - (mm-handle-set-undisplayer - handle (mm-handle-undisplayer (mm-handle-cache handle))) - (mm-handle-set-undisplayer (mm-handle-cache handle) nil))) - -(provide 'mm-extern) - -;;; arch-tag: 9653808e-14d9-4172-86e6-adceaa05378e -;;; mm-extern.el ends here diff --git a/xemacs-packages/gnus/lisp/mm-partial.el b/xemacs-packages/gnus/lisp/mm-partial.el deleted file mode 100644 index 176c2b61..00000000 --- a/xemacs-packages/gnus/lisp/mm-partial.el +++ /dev/null @@ -1,157 +0,0 @@ -;;; mm-partial.el --- showing message/partial - -;; Copyright (C) 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Shenghuo Zhu -;; Keywords: message partial - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published -;; by the Free Software Foundation; either version 3, or (at your -;; option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus-sum) -(require 'mm-util) -(require 'mm-decode) - -(defun mm-partial-find-parts (id &optional art) - (let ((headers (save-excursion - (set-buffer gnus-summary-buffer) - gnus-newsgroup-headers)) - phandles header) - (while (setq header (pop headers)) - (unless (eq (aref header 0) art) - (mm-with-unibyte-buffer - (gnus-request-article-this-buffer (aref header 0) - gnus-newsgroup-name) - (when (search-forward id nil t) - (let ((nhandles (mm-dissect-buffer - nil gnus-article-loose-mime)) nid) - (if (consp (car nhandles)) - (mm-destroy-parts nhandles) - (setq nid (cdr (assq 'id - (cdr (mm-handle-type nhandles))))) - (if (not (equal id nid)) - (mm-destroy-parts nhandles) - (push nhandles phandles)))))))) - phandles)) - -;;;###autoload -(defun mm-inline-partial (handle &optional no-display) - "Show the partial part of HANDLE. -This function replaces the buffer of HANDLE with a buffer contains -the entire message. -If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing." - (let ((id (cdr (assq 'id (cdr (mm-handle-type handle))))) - phandles - (b (point)) (n 1) total - phandle nn ntotal - gnus-displaying-mime handles buffer) - (unless (mm-handle-cache handle) - (unless id - (error "Can not find message/partial id")) - (setq phandles - (sort (cons handle - (mm-partial-find-parts - id - (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-summary-article-number)))) - #'(lambda (a b) - (let ((anumber (string-to-number - (cdr (assq 'number - (cdr (mm-handle-type a)))))) - (bnumber (string-to-number - (cdr (assq 'number - (cdr (mm-handle-type b))))))) - (< anumber bnumber))))) - (setq gnus-article-mime-handles - (mm-merge-handles gnus-article-mime-handles phandles)) - (save-excursion - (set-buffer (generate-new-buffer " *mm*")) - (while (setq phandle (pop phandles)) - (setq nn (string-to-number - (cdr (assq 'number - (cdr (mm-handle-type phandle)))))) - (setq ntotal (string-to-number - (cdr (assq 'total - (cdr (mm-handle-type phandle)))))) - (if ntotal - (if total - (unless (eq total ntotal) - (error "The numbers of total are different")) - (setq total ntotal))) - (unless (< nn n) - (unless (eq nn n) - (error "Missing part %d" n)) - (mm-insert-part phandle) - (goto-char (point-max)) - (when (not (eq 0 (skip-chars-backward "\r\n"))) - ;; remove tail blank spaces except one - (if (looking-at "\r?\n") - (goto-char (match-end 0))) - (delete-region (point) (point-max))) - (setq n (+ n 1)))) - (unless total - (error "Don't known the total number of")) - (if (<= n total) - (error "Missing part %d" n)) - (kill-buffer (mm-handle-buffer handle)) - (goto-char (point-min)) - (let ((point (if (search-forward "\n\n" nil t) - (1- (point)) - (point-max)))) - (goto-char (point-min)) - (unless (re-search-forward "^mime-version:" point t) - (insert "MIME-Version: 1.0\n"))) - (setcar handle (current-buffer)) - (mm-handle-set-cache handle t))) - (unless no-display - (save-excursion - (save-restriction - (narrow-to-region b b) - (mm-insert-part handle) - (let (gnus-article-mime-handles) - (run-hooks 'gnus-article-decode-hook) - (gnus-article-prepare-display) - (setq handles gnus-article-mime-handles)) - (when handles - ;; It is in article buffer. - (setq gnus-article-mime-handles - (mm-merge-handles gnus-article-mime-handles handles))) - (mm-handle-set-undisplayer - handle - `(lambda () - (let (buffer-read-only) - (condition-case nil - ;; This is only valid on XEmacs. - (mapcar (lambda (prop) - (remove-specifier - (face-property 'default prop) (current-buffer))) - '(background background-pixmap foreground)) - (error nil)) - (delete-region ,(point-min-marker) ,(point-max-marker)))))))))) - -(provide 'mm-partial) - -;;; arch-tag: 460e7424-05f2-4a1d-a0f2-70ec081eff7d -;;; mm-partial.el ends here diff --git a/xemacs-packages/gnus/lisp/mm-url.el b/xemacs-packages/gnus/lisp/mm-url.el deleted file mode 100644 index 0c7845f8..00000000 --- a/xemacs-packages/gnus/lisp/mm-url.el +++ /dev/null @@ -1,469 +0,0 @@ -;;; mm-url.el --- a wrapper of url functions/commands for Gnus - -;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Shenghuo Zhu - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published -;; by the Free Software Foundation; either version 3, or (at your -;; option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; Some codes are stolen from w3 and url packages. Some are moved from -;; nnweb. - -;; TODO: Support POST, cookie. - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'mm-util) -(require 'gnus) - -(eval-and-compile - (autoload 'executable-find "executable")) - -(eval-when-compile - (if (featurep 'xemacs) - (require 'timer-funcs) - (require 'timer))) - -(defvar url-current-object) -(defvar url-package-name) -(defvar url-package-version) - -(defgroup mm-url nil - "A wrapper of url package and external url command for Gnus." - :group 'gnus) - -(defcustom mm-url-use-external (not - (condition-case nil - (require 'url) - (error nil))) - "*If non-nil, use external grab program `mm-url-program'." - :version "22.1" - :type 'boolean - :group 'mm-url) - -(defvar mm-url-predefined-programs - '((wget "wget" "--user-agent=mm-url" "-q" "-O" "-") - (w3m "w3m" "-dump_source") - (lynx "lynx" "-source") - (curl "curl" "--silent" "--user-agent" "mm-url" "--location"))) - -(defcustom mm-url-program - (cond - ((executable-find "wget") 'wget) - ((executable-find "w3m") 'w3m) - ((executable-find "lynx") 'lynx) - ((executable-find "curl") 'curl) - (t "GET")) - "The url grab program. -Likely values are `wget', `w3m', `lynx' and `curl'." - :version "22.1" - :type '(choice - (symbol :tag "wget" wget) - (symbol :tag "w3m" w3m) - (symbol :tag "lynx" lynx) - (symbol :tag "curl" curl) - (string :tag "other")) - :group 'mm-url) - -(defcustom mm-url-arguments nil - "The arguments for `mm-url-program'." - :version "22.1" - :type '(repeat string) - :group 'mm-url) - - -;;; Internal variables - -(defvar mm-url-package-name - (gnus-replace-in-string - (gnus-replace-in-string gnus-version " v.*$" "") - " " "-")) - -(defvar mm-url-package-version gnus-version-number) - -;; Stolen from w3. -(defvar mm-url-html-entities - '( - ;;(excl . 33) - (quot . 34) - ;;(num . 35) - ;;(dollar . 36) - ;;(percent . 37) - (amp . 38) - (rsquo . 39) ; should be U+8217 - ;;(apos . 39) - ;;(lpar . 40) - ;;(rpar . 41) - ;;(ast . 42) - ;;(plus . 43) - ;;(comma . 44) - ;;(period . 46) - ;;(colon . 58) - ;;(semi . 59) - (lt . 60) - ;;(equals . 61) - (gt . 62) - ;;(quest . 63) - ;;(commat . 64) - ;;(lsqb . 91) - ;;(rsqb . 93) - (uarr . 94) ; should be U+8593 - ;;(lowbar . 95) - (lsquo . 96) ; should be U+8216 - (lcub . 123) - ;;(verbar . 124) - (rcub . 125) - (tilde . 126) - (nbsp . 160) - (iexcl . 161) - (cent . 162) - (pound . 163) - (curren . 164) - (yen . 165) - (brvbar . 166) - (sect . 167) - (uml . 168) - (copy . 169) - (ordf . 170) - (laquo . 171) - (not . 172) - (shy . 173) - (reg . 174) - (macr . 175) - (deg . 176) - (plusmn . 177) - (sup2 . 178) - (sup3 . 179) - (acute . 180) - (micro . 181) - (para . 182) - (middot . 183) - (cedil . 184) - (sup1 . 185) - (ordm . 186) - (raquo . 187) - (frac14 . 188) - (frac12 . 189) - (frac34 . 190) - (iquest . 191) - (Agrave . 192) - (Aacute . 193) - (Acirc . 194) - (Atilde . 195) - (Auml . 196) - (Aring . 197) - (AElig . 198) - (Ccedil . 199) - (Egrave . 200) - (Eacute . 201) - (Ecirc . 202) - (Euml . 203) - (Igrave . 204) - (Iacute . 205) - (Icirc . 206) - (Iuml . 207) - (ETH . 208) - (Ntilde . 209) - (Ograve . 210) - (Oacute . 211) - (Ocirc . 212) - (Otilde . 213) - (Ouml . 214) - (times . 215) - (Oslash . 216) - (Ugrave . 217) - (Uacute . 218) - (Ucirc . 219) - (Uuml . 220) - (Yacute . 221) - (THORN . 222) - (szlig . 223) - (agrave . 224) - (aacute . 225) - (acirc . 226) - (atilde . 227) - (auml . 228) - (aring . 229) - (aelig . 230) - (ccedil . 231) - (egrave . 232) - (eacute . 233) - (ecirc . 234) - (euml . 235) - (igrave . 236) - (iacute . 237) - (icirc . 238) - (iuml . 239) - (eth . 240) - (ntilde . 241) - (ograve . 242) - (oacute . 243) - (ocirc . 244) - (otilde . 245) - (ouml . 246) - (divide . 247) - (oslash . 248) - (ugrave . 249) - (uacute . 250) - (ucirc . 251) - (uuml . 252) - (yacute . 253) - (thorn . 254) - (yuml . 255) - - ;; Special handling of these - (frac56 . "5/6") - (frac16 . "1/6") - (frac45 . "4/5") - (frac35 . "3/5") - (frac25 . "2/5") - (frac15 . "1/5") - (frac23 . "2/3") - (frac13 . "1/3") - (frac78 . "7/8") - (frac58 . "5/8") - (frac38 . "3/8") - (frac18 . "1/8") - - ;; The following 5 entities are not mentioned in the HTML 2.0 - ;; standard, nor in any other HTML proposed standard of which I - ;; am aware. I am not even sure they are ISO entity names. *** - ;; Hence, some arrangement should be made to give a bad HTML - ;; message when they are seen. - (ndash . 45) - (mdash . 45) - (emsp . 32) - (ensp . 32) - (sim . 126) - (le . "<=") - (agr . "alpha") - (rdquo . "''") - (ldquo . "``") - (trade . "(TM)") - ;; To be done - ;; (shy . ????) ; soft hyphen - ) - "*An assoc list of entity names and how to actually display them.") - -(defconst mm-url-unreserved-chars - '( - ?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z - ?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z - ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 - ?- ?_ ?. ?! ?~ ?* ?' ?\( ?\)) - "A list of characters that are _NOT_ reserved in the URL spec. -This is taken from RFC 2396.") - -(defun mm-url-load-url () - "Load `url-insert-file-contents'." - (unless (condition-case () - (progn - (require 'url-handlers) - (require 'url-parse) - (require 'url-vars)) - (error nil)) - ;; w3-4.0pre0.46 or earlier version. - (require 'w3-vars) - (require 'url))) - -;;;###autoload -(defun mm-url-insert-file-contents (url) - "Insert file contents of URL. -If `mm-url-use-external' is non-nil, use `mm-url-program'." - (if mm-url-use-external - (progn - (if (string-match "^file:/+" url) - (insert-file-contents (substring url (1- (match-end 0)))) - (mm-url-insert-file-contents-external url)) - (goto-char (point-min)) - (if (fboundp 'url-generic-parse-url) - (setq url-current-object - (url-generic-parse-url url))) - (list url (buffer-size))) - (mm-url-load-url) - (let ((name buffer-file-name) - (url-request-extra-headers - ;; ISTM setting a Connection header was a workaround for - ;; older versions of url included with w3, but it does more - ;; harm than good with the one shipped with Emacs. --ansel - (if (not (and (boundp 'url-version) - (equal url-version "Emacs"))) - (list (cons "Connection" "Close")))) - (url-package-name (or mm-url-package-name - url-package-name)) - (url-package-version (or mm-url-package-version - url-package-version)) - result) - (setq result (url-insert-file-contents url)) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "\r 1000\r ?" nil t) - (replace-match ""))) - (setq buffer-file-name name) - (if (and (fboundp 'url-generic-parse-url) - (listp result)) - (setq url-current-object (url-generic-parse-url - (car result)))) - result))) - -;;;###autoload -(defun mm-url-insert-file-contents-external (url) - "Insert file contents of URL using `mm-url-program'." - (let (program args) - (if (symbolp mm-url-program) - (let ((item (cdr (assq mm-url-program mm-url-predefined-programs)))) - (setq program (car item) - args (append (cdr item) (list url)))) - (setq program mm-url-program - args (append mm-url-arguments (list url)))) - (unless (eq 0 (apply 'call-process program nil t nil args)) - (error "Couldn't fetch %s" url)))) - -(defvar mm-url-timeout 30 - "The number of seconds before timing out an URL fetch.") - -(defvar mm-url-retries 10 - "The number of retries after timing out when fetching an URL.") - -(defun mm-url-insert (url &optional follow-refresh) - "Insert the contents from an URL in the current buffer. -If FOLLOW-REFRESH is non-nil, redirect refresh url in META." - (let ((times mm-url-retries) - (done nil) - (first t) - result) - (while (and (not (zerop (decf times))) - (not done)) - (with-timeout (mm-url-timeout) - (unless first - (message "Trying again (%s)..." (- mm-url-retries times))) - (setq first nil) - (if follow-refresh - (save-restriction - (narrow-to-region (point) (point)) - (mm-url-insert-file-contents url) - (goto-char (point-min)) - (when (re-search-forward - "]*URL=\\([^\"]+\\)\"" nil t) - (let ((url (match-string 1))) - (delete-region (point-min) (point-max)) - (setq result (mm-url-insert url t))))) - (setq result (mm-url-insert-file-contents url))) - (setq done t))) - result)) - -(defun mm-url-decode-entities () - "Decode all HTML entities." - (goto-char (point-min)) - (while (re-search-forward "&\\(#[0-9]+\\|[a-z]+[0-9]*\\);" nil t) - (let ((elem (if (eq (aref (match-string 1) 0) ?\#) - (let ((c - (string-to-number (substring - (match-string 1) 1)))) - (if (mm-char-or-char-int-p c) c 32)) - (or (cdr (assq (intern (match-string 1)) - mm-url-html-entities)) - ?#)))) - (unless (stringp elem) - (setq elem (char-to-string elem))) - (replace-match elem t t)))) - -(defun mm-url-decode-entities-nbsp () - "Decode all HTML entities and   to a space." - (let ((mm-url-html-entities (cons '(nbsp . 32) mm-url-html-entities))) - (mm-url-decode-entities))) - -(defun mm-url-decode-entities-string (string) - (with-temp-buffer - (insert string) - (mm-url-decode-entities) - (buffer-string))) - -(defun mm-url-form-encode-xwfu (chunk) - "Escape characters in a string for application/x-www-form-urlencoded. -Blasphemous crap because someone didn't think %20 was good enough for encoding -spaces. Die Die Die." - ;; This will get rid of the 'attributes' specified by the file type, - ;; which are useless for an application/x-www-form-urlencoded form. - (if (consp chunk) - (setq chunk (cdr chunk))) - - (mapconcat - (lambda (char) - (cond - ((= char ? ) "+") - ((memq char mm-url-unreserved-chars) (char-to-string char)) - (t (upcase (format "%%%02x" char))))) - ;; Fixme: Should this actually be accepting multibyte? Is there a - ;; better way in XEmacs? - (if (featurep 'mule) - (encode-coding-string chunk - (if (fboundp 'find-coding-systems-string) - (car (find-coding-systems-string chunk)) - buffer-file-coding-system)) - chunk) - "")) - -(defun mm-url-encode-www-form-urlencoded (pairs) - "Return PAIRS encoded for forms." - (mapconcat - (lambda (data) - (concat (mm-url-form-encode-xwfu (car data)) "=" - (mm-url-form-encode-xwfu (cdr data)))) - pairs "&")) - -(defun mm-url-fetch-form (url pairs) - "Fetch a form from URL with PAIRS as the data using the POST method." - (mm-url-load-url) - (let ((url-request-data (mm-url-encode-www-form-urlencoded pairs)) - (url-request-method "POST") - (url-request-extra-headers - '(("Content-type" . "application/x-www-form-urlencoded")))) - (url-insert-file-contents url) - (setq buffer-file-name nil)) - t) - -(defun mm-url-fetch-simple (url content) - (mm-url-load-url) - (let ((url-request-data content) - (url-request-method "POST") - (url-request-extra-headers - '(("Content-type" . "application/x-www-form-urlencoded")))) - (url-insert-file-contents url) - (setq buffer-file-name nil)) - t) - -(defun mm-url-remove-markup () - "Remove all HTML markup, leaving just plain text." - (goto-char (point-min)) - (while (search-forward "" nil t) - (point-max)))) - (goto-char (point-min)) - (while (re-search-forward "<[^>]+>" nil t) - (replace-match "" t t))) - -(provide 'mm-url) - -;;; arch-tag: 0594f9b3-417c-48b0-adc2-5082e1e7917f -;;; mm-url.el ends here diff --git a/xemacs-packages/gnus/lisp/mm-util.el b/xemacs-packages/gnus/lisp/mm-util.el deleted file mode 100644 index d7d245d6..00000000 --- a/xemacs-packages/gnus/lisp/mm-util.el +++ /dev/null @@ -1,1330 +0,0 @@ -;;; mm-util.el --- Utility functions for Mule and low level things - -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; MORIOKA Tomohiko -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) -(require 'mail-prsvr) - -(eval-and-compile - (mapcar - (lambda (elem) - (let ((nfunc (intern (format "mm-%s" (car elem))))) - (if (fboundp (car elem)) - (defalias nfunc (car elem)) - (defalias nfunc (cdr elem))))) - '((coding-system-list . ignore) - (char-int . identity) - (coding-system-equal . equal) - (annotationp . ignore) - (set-buffer-file-coding-system . ignore) - (make-char - . (lambda (charset int) - (int-to-char int))) - (read-charset - . (lambda (prompt) - "Return a charset." - (intern - (completing-read - prompt - (mapcar (lambda (e) (list (symbol-name (car e)))) - mm-mime-mule-charset-alist) - nil t)))) - (subst-char-in-string - . (lambda (from to string &optional inplace) - ;; stolen (and renamed) from nnheader.el - "Replace characters in STRING from FROM to TO. - Unless optional argument INPLACE is non-nil, return a new string." - (let ((string (if inplace string (copy-sequence string))) - (len (length string)) - (idx 0)) - ;; Replace all occurrences of FROM with TO. - (while (< idx len) - (when (= (aref string idx) from) - (aset string idx to)) - (setq idx (1+ idx))) - string))) - (string-as-unibyte . identity) - (string-make-unibyte . identity) - ;; string-as-multibyte often doesn't really do what you think it does. - ;; Example: - ;; (aref (string-as-multibyte "\201") 0) -> 129 (aka ?\201) - ;; (aref (string-as-multibyte "\300") 0) -> 192 (aka ?\300) - ;; (aref (string-as-multibyte "\300\201") 0) -> 192 (aka ?\300) - ;; (aref (string-as-multibyte "\300\201") 1) -> 129 (aka ?\201) - ;; but - ;; (aref (string-as-multibyte "\201\300") 0) -> 2240 - ;; (aref (string-as-multibyte "\201\300") 1) -> - ;; Better use string-to-multibyte or encode-coding-string. - ;; If you really need string-as-multibyte somewhere it's usually - ;; because you're using the internal emacs-mule representation (maybe - ;; because you're using string-as-unibyte somewhere), which is - ;; generally a problem in itself. - ;; Here is an approximate equivalence table to help think about it: - ;; (string-as-multibyte s) ~= (decode-coding-string s 'emacs-mule) - ;; (string-to-multibyte s) ~= (decode-coding-string s 'binary) - ;; (string-make-multibyte s) ~= (decode-coding-string s locale-coding-system) - (string-as-multibyte . identity) - (multibyte-string-p . ignore) - (insert-byte . insert-char) - (multibyte-char-to-unibyte . identity)))) - -(eval-and-compile - (if (featurep 'xemacs) - (if (featurep 'file-coding) - ;; Don't modify string if CODING-SYSTEM is nil. - (progn - (defun mm-decode-coding-string (str coding-system) - (if coding-system - (decode-coding-string str coding-system) - str)) - (defun mm-encode-coding-string (str coding-system) - (if coding-system - (encode-coding-string str coding-system) - str)) - (defun mm-decode-coding-region (start end coding-system) - (if coding-system - (decode-coding-region start end coding-system))) - (defun mm-encode-coding-region (start end coding-system) - (if coding-system - (encode-coding-region start end coding-system)))) - (defun mm-decode-coding-string (str coding-system) str) - (defun mm-encode-coding-string (str coding-system) str) - (defalias 'mm-decode-coding-region 'ignore) - (defalias 'mm-encode-coding-region 'ignore)) - (defalias 'mm-decode-coding-string 'decode-coding-string) - (defalias 'mm-encode-coding-string 'encode-coding-string) - (defalias 'mm-decode-coding-region 'decode-coding-region) - (defalias 'mm-encode-coding-region 'encode-coding-region))) - -(eval-and-compile - (cond - ((fboundp 'replace-in-string) - (defalias 'mm-replace-in-string 'replace-in-string)) - ((fboundp 'replace-regexp-in-string) - (defun mm-replace-in-string (string regexp newtext &optional literal) - "Replace all matches for REGEXP with NEWTEXT in STRING. -If LITERAL is non-nil, insert NEWTEXT literally. Return a new -string containing the replacements. - -This is a compatibility function for different Emacsen." - (replace-regexp-in-string regexp newtext string nil literal))) - (t - (defun mm-replace-in-string (string regexp newtext &optional literal) - "Replace all matches for REGEXP with NEWTEXT in STRING. -If LITERAL is non-nil, insert NEWTEXT literally. Return a new -string containing the replacements. - -This is a compatibility function for different Emacsen." - (let ((start 0) tail) - (while (string-match regexp string start) - (setq tail (- (length string) (match-end 0))) - (setq string (replace-match newtext nil literal string)) - (setq start (- (length string) tail)))) - string)))) - -(defalias 'mm-string-to-multibyte - (cond - ((featurep 'xemacs) - 'identity) - ((fboundp 'string-to-multibyte) - 'string-to-multibyte) - (t - (lambda (string) - "Return a multibyte string with the same individual chars as string." - (mapconcat - (lambda (ch) (mm-string-as-multibyte (char-to-string ch))) - string ""))))) - -(eval-and-compile - (defalias 'mm-char-or-char-int-p - (cond - ((fboundp 'char-or-char-int-p) 'char-or-char-int-p) - ((fboundp 'char-valid-p) 'char-valid-p) - (t 'identity)))) - -;; Fixme: This seems always to be used to read a MIME charset, so it -;; should be re-named and fixed (in Emacs) to offer completion only on -;; proper charset names (base coding systems which have a -;; mime-charset defined). XEmacs doesn't believe in mime-charset; -;; test with -;; `(or (coding-system-get 'iso-8859-1 'mime-charset) -;; (coding-system-get 'iso-8859-1 :mime-charset))' -;; Actually, there should be an `mm-coding-system-mime-charset'. -(eval-and-compile - (defalias 'mm-read-coding-system - (cond - ((fboundp 'read-coding-system) - (if (and (featurep 'xemacs) - (<= (string-to-number emacs-version) 21.1)) - (lambda (prompt &optional default-coding-system) - (read-coding-system prompt)) - 'read-coding-system)) - (t (lambda (prompt &optional default-coding-system) - "Prompt the user for a coding system." - (completing-read - prompt (mapcar (lambda (s) (list (symbol-name (car s)))) - mm-mime-mule-charset-alist))))))) - -(defvar mm-coding-system-list nil) -(defun mm-get-coding-system-list () - "Get the coding system list." - (or mm-coding-system-list - (setq mm-coding-system-list (mm-coding-system-list)))) - -(defun mm-coding-system-p (cs) - "Return non-nil if CS is a symbol naming a coding system. -In XEmacs, also return non-nil if CS is a coding system object. -If CS is available, return CS itself in Emacs, and return a coding -system object in XEmacs." - (if (fboundp 'find-coding-system) - (and cs (find-coding-system cs)) - (if (fboundp 'coding-system-p) - (when (coding-system-p cs) - cs) - ;; no-MULE XEmacs: - (car (memq cs (mm-get-coding-system-list)))))) - -(defun mm-codepage-setup (number &optional alias) - "Create a coding system cpNUMBER. -The coding system is created using `codepage-setup'. If ALIAS is -non-nil, an alias is created and added to -`mm-charset-synonym-alist'. If ALIAS is a string, it's used as -the alias. Else windows-NUMBER is used." - (interactive - (let ((completion-ignore-case t) - (candidates (cp-supported-codepages))) - (list (completing-read "Setup DOS Codepage: (default 437) " candidates - nil t nil nil "437")))) - (when alias - (setq alias (if (stringp alias) - (intern alias) - (intern (format "windows-%s" number))))) - (let* ((cp (intern (format "cp%s" number)))) - (unless (mm-coding-system-p cp) - (codepage-setup number)) - (when (and alias - ;; Don't add alias if setup of cp failed. - (mm-coding-system-p cp)) - (add-to-list 'mm-charset-synonym-alist (cons alias cp))))) - -(defvar mm-charset-synonym-alist - `( - ;; Not in XEmacs, but it's not a proper MIME charset anyhow. - ,@(unless (mm-coding-system-p 'x-ctext) - '((x-ctext . ctext))) - ;; ISO-8859-15 is very similar to ISO-8859-1. But it's _different_ in 8 - ;; positions! - ,@(unless (mm-coding-system-p 'iso-8859-15) - '((iso-8859-15 . iso-8859-1))) - ;; BIG-5HKSCS is similar to, but different than, BIG-5. - ,@(unless (mm-coding-system-p 'big5-hkscs) - '((big5-hkscs . big5))) - ;; A Microsoft misunderstanding. - ,@(when (and (not (mm-coding-system-p 'unicode)) - (mm-coding-system-p 'utf-16-le)) - '((unicode . utf-16-le))) - ;; A Microsoft misunderstanding. - ,@(unless (mm-coding-system-p 'ks_c_5601-1987) - (if (mm-coding-system-p 'cp949) - '((ks_c_5601-1987 . cp949)) - '((ks_c_5601-1987 . euc-kr)))) - ;; Windows-31J is Windows Codepage 932. - ,@(when (and (not (mm-coding-system-p 'windows-31j)) - (mm-coding-system-p 'cp932)) - '((windows-31j . cp932))) - ;; Charset name: GBK, Charset aliases: CP936, MS936, windows-936 - ;; http://www.iana.org/assignments/charset-reg/GBK - ;; Emacs 22.1 has cp936, but not gbk, so we alias it: - ,@(when (and (not (mm-coding-system-p 'gbk)) - (mm-coding-system-p 'cp936)) - '((gbk . cp936))) - ) - "A mapping from unknown or invalid charset names to the real charset names. - -See `mm-codepage-iso-8859-list' and `mm-codepage-ibm-list'.") - -(defcustom mm-codepage-iso-8859-list - (list 1250 ;; Windows-1250 is a variant of Latin-2 heavily used by Microsoft - ;; Outlook users in Czech republic. Use this to allow reading of - ;; their e-mails. cp1250 should be defined by M-x codepage-setup - ;; (Emacs 21). - '(1252 . 1) ;; Windows-1252 is a superset of iso-8859-1 (West - ;; Europe). See also `gnus-article-dumbquotes-map'. - '(1254 . 9) ;; Windows-1254 is a superset of iso-8859-9 (Turkish). - '(1255 . 8));; Windows-1255 is a superset of iso-8859-8 (Hebrew). - "A list of Windows codepage numbers and iso-8859 charset numbers. - -If an element is a number corresponding to a supported windows -codepage, appropriate entries to `mm-charset-synonym-alist' are -added by `mm-setup-codepage-iso-8859'. An element may also be a -cons cell where the car is a codepage number and the cdr is the -corresponding number of an iso-8859 charset." - :type '(list (set :inline t - (const 1250 :tag "Central and East European") - (const (1252 . 1) :tag "West European") - (const (1254 . 9) :tag "Turkish") - (const (1255 . 8) :tag "Hebrew")) - (repeat :inline t - :tag "Other options" - (choice - (integer :tag "Windows codepage number") - (cons (integer :tag "Windows codepage number") - (integer :tag "iso-8859 charset number"))))) - :version "22.1" ;; Gnus 5.10.9 - :group 'mime) - -(defcustom mm-codepage-ibm-list - (list 437 ;; (US etc.) - 860 ;; (Portugal) - 861 ;; (Iceland) - 862 ;; (Israel) - 863 ;; (Canadian French) - 865 ;; (Nordic) - 852 ;; - 850 ;; (Latin 1) - 855 ;; (Cyrillic) - 866 ;; (Cyrillic - Russian) - 857 ;; (Turkish) - 864 ;; (Arabic) - 869 ;; (Greek) - 874);; (Thai) - ;; In Emacs 23 (unicode), cp... and ibm... are aliases. - ;; Cf. http://thread.gmane.org/v9lkng5nwy.fsf@marauder.physik.uni-ulm.de - "List of IBM codepage numbers. - -The codepage mappings slighly differ between IBM and other vendors. -See \"ftp://ftp.unicode.org/Public/MAPPINGS/VENDORS/IBM/README.TXT\". - -If an element is a number corresponding to a supported windows -codepage, appropriate entries to `mm-charset-synonym-alist' are -added by `mm-setup-codepage-ibm'." - :type '(list (set :inline t - (const 437 :tag "US etc.") - (const 860 :tag "Portugal") - (const 861 :tag "Iceland") - (const 862 :tag "Israel") - (const 863 :tag "Canadian French") - (const 865 :tag "Nordic") - (const 852) - (const 850 :tag "Latin 1") - (const 855 :tag "Cyrillic") - (const 866 :tag "Cyrillic - Russian") - (const 857 :tag "Turkish") - (const 864 :tag "Arabic") - (const 869 :tag "Greek") - (const 874 :tag "Thai")) - (repeat :inline t - :tag "Other options" - (integer :tag "Codepage number"))) - :version "22.1" ;; Gnus 5.10.9 - :group 'mime) - -(defun mm-setup-codepage-iso-8859 (&optional list) - "Add appropriate entries to `mm-charset-synonym-alist'. -Unless LIST is given, `mm-codepage-iso-8859-list' is used." - (unless list - (setq list mm-codepage-iso-8859-list)) - (dolist (i list) - (let (cp windows iso) - (if (consp i) - (setq cp (intern (format "cp%d" (car i))) - windows (intern (format "windows-%d" (car i))) - iso (intern (format "iso-8859-%d" (cdr i)))) - (setq cp (intern (format "cp%d" i)) - windows (intern (format "windows-%d" i)))) - (unless (mm-coding-system-p windows) - (if (mm-coding-system-p cp) - (add-to-list 'mm-charset-synonym-alist (cons windows cp)) - (add-to-list 'mm-charset-synonym-alist (cons windows iso))))))) - -(defun mm-setup-codepage-ibm (&optional list) - "Add appropriate entries to `mm-charset-synonym-alist'. -Unless LIST is given, `mm-codepage-ibm-list' is used." - (unless list - (setq list mm-codepage-ibm-list)) - (dolist (number list) - (let ((ibm (intern (format "ibm%d" number))) - (cp (intern (format "cp%d" number)))) - (when (and (not (mm-coding-system-p ibm)) - (mm-coding-system-p cp)) - (add-to-list 'mm-charset-synonym-alist (cons ibm cp)))))) - -;; Initialize: -(mm-setup-codepage-iso-8859) -(mm-setup-codepage-ibm) - -(defcustom mm-charset-override-alist - `((iso-8859-1 . windows-1252)) - "A mapping from undesired charset names to their replacement. - -You may add pairs like (iso-8859-1 . windows-1252) here, -i.e. treat iso-8859-1 as windows-1252. windows-1252 is a -superset of iso-8859-1." - :type '(list (set :inline t - (const (iso-8859-1 . windows-1252)) - (const (undecided . windows-1252))) - (repeat :inline t - :tag "Other options" - (cons (symbol :tag "From charset") - (symbol :tag "To charset")))) - :version "22.1" ;; Gnus 5.10.9 - :group 'mime) - -(defcustom mm-charset-eval-alist - (if (featurep 'xemacs) - nil ;; I don't know what would be useful for XEmacs. - '(;; Emacs 21 offers 1250 1251 1253 1257. Emacs 22 provides autoloads for - ;; 1250-1258 (i.e. `mm-codepage-setup' does nothing). - (windows-1250 . (mm-codepage-setup 1250 t)) - (windows-1251 . (mm-codepage-setup 1251 t)) - (windows-1253 . (mm-codepage-setup 1253 t)) - (windows-1257 . (mm-codepage-setup 1257 t)))) - "An alist of (CHARSET . FORM) pairs. -If an article is encoded in an unknown CHARSET, FORM is -evaluated. This allows to load additional libraries providing -charsets on demand. If supported by your Emacs version, you -could use `autoload-coding-system' here." - :version "22.1" ;; Gnus 5.10.9 - :type '(list (set :inline t - (const (windows-1250 . (mm-codepage-setup 1250 t))) - (const (windows-1251 . (mm-codepage-setup 1251 t))) - (const (windows-1253 . (mm-codepage-setup 1253 t))) - (const (windows-1257 . (mm-codepage-setup 1257 t))) - (const (cp850 . (mm-codepage-setup 850 nil)))) - (repeat :inline t - :tag "Other options" - (cons (symbol :tag "charset") - (symbol :tag "form")))) - :group 'mime) -(put 'mm-charset-eval-alist 'risky-local-variable t) - -(defvar mm-binary-coding-system - (cond - ((mm-coding-system-p 'binary) 'binary) - ((mm-coding-system-p 'no-conversion) 'no-conversion) - (t nil)) - "100% binary coding system.") - -(defvar mm-text-coding-system - (or (if (memq system-type '(windows-nt ms-dos ms-windows)) - (and (mm-coding-system-p 'raw-text-dos) 'raw-text-dos) - (and (mm-coding-system-p 'raw-text) 'raw-text)) - mm-binary-coding-system) - "Text-safe coding system (For removing ^M).") - -(defvar mm-text-coding-system-for-write nil - "Text coding system for write.") - -(defvar mm-auto-save-coding-system - (cond - ((mm-coding-system-p 'utf-8-emacs) ; Mule 7 - (if (memq system-type '(windows-nt ms-dos ms-windows)) - (if (mm-coding-system-p 'utf-8-emacs-dos) - 'utf-8-emacs-dos mm-binary-coding-system) - 'utf-8-emacs)) - ((mm-coding-system-p 'emacs-mule) - (if (memq system-type '(windows-nt ms-dos ms-windows)) - (if (mm-coding-system-p 'emacs-mule-dos) - 'emacs-mule-dos mm-binary-coding-system) - 'emacs-mule)) - ((mm-coding-system-p 'escape-quoted) 'escape-quoted) - (t mm-binary-coding-system)) - "Coding system of auto save file.") - -(defvar mm-universal-coding-system mm-auto-save-coding-system - "The universal coding system.") - -;; Fixme: some of the cars here aren't valid MIME charsets. That -;; should only matter with XEmacs, though. -(defvar mm-mime-mule-charset-alist - `((us-ascii ascii) - (iso-8859-1 latin-iso8859-1) - (iso-8859-2 latin-iso8859-2) - (iso-8859-3 latin-iso8859-3) - (iso-8859-4 latin-iso8859-4) - (iso-8859-5 cyrillic-iso8859-5) - ;; Non-mule (X)Emacs uses the last mule-charset for 8bit characters. - ;; The fake mule-charset, gnus-koi8-r, tells Gnus that the default - ;; charset is koi8-r, not iso-8859-5. - (koi8-r cyrillic-iso8859-5 gnus-koi8-r) - (iso-8859-6 arabic-iso8859-6) - (iso-8859-7 greek-iso8859-7) - (iso-8859-8 hebrew-iso8859-8) - (iso-8859-9 latin-iso8859-9) - (iso-8859-14 latin-iso8859-14) - (iso-8859-15 latin-iso8859-15) - (viscii vietnamese-viscii-lower) - (iso-2022-jp latin-jisx0201 japanese-jisx0208 japanese-jisx0208-1978) - (euc-kr korean-ksc5601) - (gb2312 chinese-gb2312) - (big5 chinese-big5-1 chinese-big5-2) - (tibetan tibetan) - (thai-tis620 thai-tis620) - (windows-1251 cyrillic-iso8859-5) - (iso-2022-7bit ethiopic arabic-1-column arabic-2-column) - (iso-2022-jp-2 latin-iso8859-1 greek-iso8859-7 - latin-jisx0201 japanese-jisx0208-1978 - chinese-gb2312 japanese-jisx0208 - korean-ksc5601 japanese-jisx0212) - (iso-2022-int-1 latin-iso8859-1 greek-iso8859-7 - latin-jisx0201 japanese-jisx0208-1978 - chinese-gb2312 japanese-jisx0208 - korean-ksc5601 japanese-jisx0212 - chinese-cns11643-1 chinese-cns11643-2) - (iso-2022-int-1 latin-iso8859-1 latin-iso8859-2 - cyrillic-iso8859-5 greek-iso8859-7 - latin-jisx0201 japanese-jisx0208-1978 - chinese-gb2312 japanese-jisx0208 - korean-ksc5601 japanese-jisx0212 - chinese-cns11643-1 chinese-cns11643-2 - chinese-cns11643-3 chinese-cns11643-4 - chinese-cns11643-5 chinese-cns11643-6 - chinese-cns11643-7) - (iso-2022-jp-3 latin-jisx0201 japanese-jisx0208-1978 japanese-jisx0208 - japanese-jisx0213-1 japanese-jisx0213-2) - (shift_jis latin-jisx0201 katakana-jisx0201 japanese-jisx0208) - ,(cond ((fboundp 'unicode-precedence-list) - (cons 'utf-8 (delq 'ascii (mapcar 'charset-name - (unicode-precedence-list))))) - ((or (not (fboundp 'charsetp)) ;; non-Mule case - (charsetp 'unicode-a) - (not (mm-coding-system-p 'mule-utf-8))) - '(utf-8 unicode-a unicode-b unicode-c unicode-d unicode-e)) - (t ;; If we have utf-8 we're in Mule 5+. - (append '(utf-8) - (delete 'ascii - (coding-system-get 'mule-utf-8 'safe-charsets)))))) - "Alist of MIME-charset/MULE-charsets.") - -(defun mm-enrich-utf-8-by-mule-ucs () - "Make the `utf-8' MIME charset usable by the Mule-UCS package. -This function will run when the `un-define' module is loaded under -XEmacs, and fill the `utf-8' entry in `mm-mime-mule-charset-alist' -with Mule charsets. It is completely useless for Emacs." - (when (boundp 'unicode-basic-translation-charset-order-list) - (condition-case nil - (let ((val (delq - 'ascii - (copy-sequence - (symbol-value - 'unicode-basic-translation-charset-order-list)))) - (elem (assq 'utf-8 mm-mime-mule-charset-alist))) - (if elem - (setcdr elem val) - (setq mm-mime-mule-charset-alist - (nconc mm-mime-mule-charset-alist - (list (cons 'utf-8 val)))))) - (error)))) - -;; Correct by construction, but should be unnecessary for Emacs: -(if (featurep 'xemacs) - (eval-after-load "un-define" '(mm-enrich-utf-8-by-mule-ucs)) - (when (and (fboundp 'coding-system-list) - (fboundp 'sort-coding-systems)) - (let ((css (sort-coding-systems (coding-system-list 'base-only))) - cs mime mule alist) - (while css - (setq cs (pop css) - mime (or (coding-system-get cs :mime-charset) ; Emacs 23 (unicode) - (coding-system-get cs 'mime-charset))) - (when (and mime - (not (eq t (setq mule - (coding-system-get cs 'safe-charsets)))) - (not (assq mime alist))) - (push (cons mime (delq 'ascii mule)) alist))) - (setq mm-mime-mule-charset-alist (nreverse alist))))) - -(defvar mm-hack-charsets '(iso-8859-15 iso-2022-jp-2) - "A list of special charsets. -Valid elements include: -`iso-8859-15' convert ISO-8859-1, -9 to ISO-8859-15 if ISO-8859-15 exists. -`iso-2022-jp-2' convert ISO-2022-jp to ISO-2022-jp-2 if ISO-2022-jp-2 exists." -) - -(defvar mm-iso-8859-15-compatible - '((iso-8859-1 "\xA4\xA6\xA8\xB4\xB8\xBC\xBD\xBE") - (iso-8859-9 "\xA4\xA6\xA8\xB4\xB8\xBC\xBD\xBE\xD0\xDD\xDE\xF0\xFD\xFE")) - "ISO-8859-15 exchangeable coding systems and inconvertible characters.") - -(defvar mm-iso-8859-x-to-15-table - (and (fboundp 'coding-system-p) - (mm-coding-system-p 'iso-8859-15) - (mapcar - (lambda (cs) - (if (mm-coding-system-p (car cs)) - (let ((c (string-to-char - (decode-coding-string "\341" (car cs))))) - (cons (char-charset c) - (cons - (- (string-to-char - (decode-coding-string "\341" 'iso-8859-15)) c) - (string-to-list (decode-coding-string (car (cdr cs)) - (car cs)))))) - '(gnus-charset 0))) - mm-iso-8859-15-compatible)) - "A table of the difference character between ISO-8859-X and ISO-8859-15.") - -(defcustom mm-coding-system-priorities - (if (boundp 'current-language-environment) - (let ((lang (symbol-value 'current-language-environment))) - (cond ((string= lang "Japanese") - ;; Japanese users prefer iso-2022-jp to euc-japan or - ;; shift_jis, however iso-8859-1 should be used when - ;; there are only ASCII text and Latin-1 characters. - '(iso-8859-1 iso-2022-jp iso-2022-jp-2 shift_jis utf-8))))) - "Preferred coding systems for encoding outgoing messages. - -More than one suitable coding system may be found for some text. -By default, the coding system with the highest priority is used -to encode outgoing messages (see `sort-coding-systems'). If this -variable is set, it overrides the default priority." - :version "21.2" - :type '(repeat (symbol :tag "Coding system")) - :group 'mime) - -;; ?? -(defvar mm-use-find-coding-systems-region - (fboundp 'find-coding-systems-region) - "Use `find-coding-systems-region' to find proper coding systems. - -Setting it to nil is useful on Emacsen supporting Unicode if sending -mail with multiple parts is preferred to sending a Unicode one.") - -;;; Internal variables: - -;;; Functions: - -(defun mm-mule-charset-to-mime-charset (charset) - "Return the MIME charset corresponding to the given Mule CHARSET." - (if (and (fboundp 'find-coding-systems-for-charsets) - (fboundp 'sort-coding-systems)) - (let ((css (sort (sort-coding-systems - (find-coding-systems-for-charsets (list charset))) - 'mm-sort-coding-systems-predicate)) - cs mime) - (while (and (not mime) - css) - (when (setq cs (pop css)) - (setq mime (or (coding-system-get cs :mime-charset) - (coding-system-get cs 'mime-charset))))) - mime) - (let ((alist (mapcar (lambda (cs) - (assq cs mm-mime-mule-charset-alist)) - (sort (mapcar 'car mm-mime-mule-charset-alist) - 'mm-sort-coding-systems-predicate))) - out) - (while alist - (when (memq charset (cdar alist)) - (setq out (caar alist) - alist nil)) - (pop alist)) - out))) - -(defun mm-charset-to-coding-system (charset &optional lbt - allow-override) - "Return coding-system corresponding to CHARSET. -CHARSET is a symbol naming a MIME charset. -If optional argument LBT (`unix', `dos' or `mac') is specified, it is -used as the line break code type of the coding system. - -If ALLOW-OVERRIDE is given, use `mm-charset-override-alist' to -map undesired charset names to their replacement. This should -only be used for decoding, not for encoding." - ;; OVERRIDE is used (only) in `mm-decode-body' and `mm-decode-string'. - (when (stringp charset) - (setq charset (intern (downcase charset)))) - (when lbt - (setq charset (intern (format "%s-%s" charset lbt)))) - (cond - ((null charset) - charset) - ;; Running in a non-MULE environment. - ((or (null (mm-get-coding-system-list)) - (not (fboundp 'coding-system-get))) - charset) - ;; Check override list quite early. Should only used for decoding, not for - ;; encoding! - ((and allow-override - (let ((cs (cdr (assq charset mm-charset-override-alist)))) - (and cs (mm-coding-system-p cs) cs)))) - ;; ascii - ((eq charset 'us-ascii) - 'ascii) - ;; Check to see whether we can handle this charset. (This depends - ;; on there being some coding system matching each `mime-charset' - ;; property defined, as there should be.) - ((and (mm-coding-system-p charset) -;;; Doing this would potentially weed out incorrect charsets. -;;; charset -;;; (eq charset (coding-system-get charset 'mime-charset)) - ) - charset) - ;; Eval expressions from `mm-charset-eval-alist' - ((let* ((el (assq charset mm-charset-eval-alist)) - (cs (car el)) - (form (cdr el))) - (and cs - form - (prog2 - ;; Avoid errors... - (condition-case nil (eval form) (error nil)) - ;; (message "Failed to eval `%s'" form)) - (mm-coding-system-p cs) - (message "Added charset `%s' via `mm-charset-eval-alist'" cs)) - cs))) - ;; Translate invalid charsets. - ((let ((cs (cdr (assq charset mm-charset-synonym-alist)))) - (and cs - (mm-coding-system-p cs) - ;; (message - ;; "Using synonym `%s' from `mm-charset-synonym-alist' for `%s'" - ;; cs charset) - cs))) - ;; Last resort: search the coding system list for entries which - ;; have the right mime-charset in case the canonical name isn't - ;; defined (though it should be). - ((let (cs) - ;; mm-get-coding-system-list returns a list of cs without lbt. - ;; Do we need -lbt? - (dolist (c (mm-get-coding-system-list)) - (if (and (null cs) - (eq charset (or (coding-system-get c :mime-charset) - (coding-system-get c 'mime-charset)))) - (setq cs c))) - (unless cs - ;; Warn the user about unknown charset: - (if (fboundp 'gnus-message) - (gnus-message 7 "Unknown charset: %s" charset) - (message "Unknown charset: %s" charset))) - cs)))) - -(defsubst mm-replace-chars-in-string (string from to) - (mm-subst-char-in-string from to string)) - -(eval-and-compile - (defvar mm-emacs-mule (and (not (featurep 'xemacs)) - (boundp 'default-enable-multibyte-characters) - default-enable-multibyte-characters - (fboundp 'set-buffer-multibyte)) - "True in Emacs with Mule.") - - (if mm-emacs-mule - (defun mm-enable-multibyte () - "Set the multibyte flag of the current buffer. -Only do this if the default value of `enable-multibyte-characters' is -non-nil. This is a no-op in XEmacs." - (set-buffer-multibyte 'to)) - (defalias 'mm-enable-multibyte 'ignore)) - - (if mm-emacs-mule - (defun mm-disable-multibyte () - "Unset the multibyte flag of in the current buffer. -This is a no-op in XEmacs." - (set-buffer-multibyte nil)) - (defalias 'mm-disable-multibyte 'ignore))) - -(defun mm-preferred-coding-system (charset) - ;; A typo in some Emacs versions. - (or (get-charset-property charset 'preferred-coding-system) - (get-charset-property charset 'prefered-coding-system))) - -;; Mule charsets shouldn't be used. -(defsubst mm-guess-charset () - "Guess Mule charset from the language environment." - (or - mail-parse-mule-charset ;; cached mule-charset - (progn - (setq mail-parse-mule-charset - (and (boundp 'current-language-environment) - (car (last - (assq 'charset - (assoc current-language-environment - language-info-alist)))))) - (if (or (not mail-parse-mule-charset) - (eq mail-parse-mule-charset 'ascii)) - (setq mail-parse-mule-charset - (or (car (last (assq mail-parse-charset - mm-mime-mule-charset-alist))) - ;; default - 'latin-iso8859-1))) - mail-parse-mule-charset))) - -(defun mm-charset-after (&optional pos) - "Return charset of a character in current buffer at position POS. -If POS is nil, it defauls to the current point. -If POS is out of range, the value is nil. -If the charset is `composition', return the actual one." - (let ((char (char-after pos)) charset) - (if (< (mm-char-int char) 128) - (setq charset 'ascii) - ;; charset-after is fake in some Emacsen. - (setq charset (and (fboundp 'char-charset) (char-charset char))) - (if (eq charset 'composition) ; Mule 4 - (let ((p (or pos (point)))) - (cadr (find-charset-region p (1+ p)))) - (if (and charset (not (memq charset '(ascii eight-bit-control - eight-bit-graphic)))) - charset - (mm-guess-charset)))))) - -(defun mm-mime-charset (charset) - "Return the MIME charset corresponding to the given Mule CHARSET." - (if (eq charset 'unknown) - (error "The message contains non-printable characters, please use attachment")) - (if (and (fboundp 'coding-system-get) (fboundp 'get-charset-property)) - ;; This exists in Emacs 20. - (or - (and (mm-preferred-coding-system charset) - (or (coding-system-get - (mm-preferred-coding-system charset) :mime-charset) - (coding-system-get - (mm-preferred-coding-system charset) 'mime-charset))) - (and (eq charset 'ascii) - 'us-ascii) - (mm-preferred-coding-system charset) - (mm-mule-charset-to-mime-charset charset)) - ;; This is for XEmacs. - (mm-mule-charset-to-mime-charset charset))) - -(if (fboundp 'delete-dups) - (defalias 'mm-delete-duplicates 'delete-dups) - (defun mm-delete-duplicates (list) - "Destructively remove `equal' duplicates from LIST. -Store the result in LIST and return it. LIST must be a proper list. -Of several `equal' occurrences of an element in LIST, the first -one is kept. - -This is a compatibility function for Emacsen without `delete-dups'." - ;; Code from `subr.el' in Emacs 22: - (let ((tail list)) - (while tail - (setcdr tail (delete (car tail) (cdr tail))) - (setq tail (cdr tail)))) - list)) - -;; Fixme: This is used in places when it should be testing the -;; default multibyteness. See mm-default-multibyte-p. -(eval-and-compile - (if (and (not (featurep 'xemacs)) - (boundp 'enable-multibyte-characters)) - (defun mm-multibyte-p () - "Non-nil if multibyte is enabled in the current buffer." - enable-multibyte-characters) - (defun mm-multibyte-p () (featurep 'mule)))) - -(defun mm-default-multibyte-p () - "Return non-nil if the session is multibyte. -This affects whether coding conversion should be attempted generally." - (if (featurep 'mule) - (if (boundp 'default-enable-multibyte-characters) - default-enable-multibyte-characters - t))) - -(defun mm-iso-8859-x-to-15-region (&optional b e) - (if (fboundp 'char-charset) - (let (charset item c inconvertible) - (save-restriction - (if e (narrow-to-region b e)) - (goto-char (point-min)) - (skip-chars-forward "\0-\177") - (while (not (eobp)) - (cond - ((not (setq item (assq (char-charset (setq c (char-after))) - mm-iso-8859-x-to-15-table))) - (forward-char)) - ((memq c (cdr (cdr item))) - (setq inconvertible t) - (forward-char)) - (t - (insert-before-markers (prog1 (+ c (car (cdr item))) - (delete-char 1))))) - (skip-chars-forward "\0-\177"))) - (not inconvertible)))) - -(defun mm-sort-coding-systems-predicate (a b) - (let ((priorities - (mapcar (lambda (cs) - ;; Note: invalid entries are dropped silently - (and (setq cs (mm-coding-system-p cs)) - (coding-system-base cs))) - mm-coding-system-priorities))) - (and (setq a (mm-coding-system-p a)) - (if (setq b (mm-coding-system-p b)) - (> (length (memq (coding-system-base a) priorities)) - (length (memq (coding-system-base b) priorities))) - t)))) - -(eval-when-compile - (autoload 'latin-unity-massage-name "latin-unity") - (autoload 'latin-unity-maybe-remap "latin-unity") - (autoload 'latin-unity-representations-feasible-region "latin-unity") - (autoload 'latin-unity-representations-present-region "latin-unity") - (defvar latin-unity-coding-systems) - (defvar latin-unity-ucs-list)) - -(defun mm-xemacs-find-mime-charset-1 (begin end) - "Determine which MIME charset to use to send region as message. -This uses the XEmacs-specific latin-unity package to better handle the -case where identical characters from diverse ISO-8859-? character sets -can be encoded using a single one of the corresponding coding systems. - -It treats `mm-coding-system-priorities' as the list of preferred -coding systems; a useful example setting for this list in Western -Europe would be '(iso-8859-1 iso-8859-15 utf-8), which would default -to the very standard Latin 1 coding system, and only move to coding -systems that are less supported as is necessary to encode the -characters that exist in the buffer. - -Latin Unity doesn't know about those non-ASCII Roman characters that -are available in various East Asian character sets. As such, its -behavior if you have a JIS 0212 LATIN SMALL LETTER A WITH ACUTE in a -buffer and it can otherwise be encoded as Latin 1, won't be ideal. -But this is very much a corner case, so don't worry about it." - (let ((systems mm-coding-system-priorities) csets psets curset) - - ;; Load the Latin Unity library, if available. - (when (and (not (featurep 'latin-unity)) (locate-library "latin-unity")) - (ignore-errors (require 'latin-unity))) - - ;; Now, can we use it? - (if (featurep 'latin-unity) - (progn - (setq csets (latin-unity-representations-feasible-region begin end) - psets (latin-unity-representations-present-region begin end)) - - (catch 'done - - ;; Pass back the first coding system in the preferred list - ;; that can encode the whole region. - (dolist (curset systems) - (setq curset (latin-unity-massage-name 'buffer-default curset)) - - ;; If the coding system is a universal coding system, then - ;; it can certainly encode all the characters in the region. - (if (memq curset latin-unity-ucs-list) - (throw 'done (list curset))) - - ;; If a coding system isn't universal, and isn't in - ;; the list that latin unity knows about, we can't - ;; decide whether to use it here. Leave that until later - ;; in `mm-find-mime-charset-region' function, whence we - ;; have been called. - (unless (memq curset latin-unity-coding-systems) - (throw 'done nil)) - - ;; Right, we know about this coding system, and it may - ;; conceivably be able to encode all the characters in - ;; the region. - (if (latin-unity-maybe-remap begin end curset csets psets t) - (throw 'done (list curset)))) - - ;; Can't encode using anything from the - ;; `mm-coding-system-priorities' list. - ;; Leave `mm-find-mime-charset' to do most of the work. - nil)) - - ;; Right, latin unity isn't available; let `mm-find-charset-region' - ;; take its default action, which equally applies to GNU Emacs. - nil))) - -(defmacro mm-xemacs-find-mime-charset (begin end) - (when (featurep 'xemacs) - `(and (featurep 'mule) (mm-xemacs-find-mime-charset-1 ,begin ,end)))) - -(defun mm-find-mime-charset-region (b e &optional hack-charsets) - "Return the MIME charsets needed to encode the region between B and E. -nil means ASCII, a single-element list represents an appropriate MIME -charset, and a longer list means no appropriate charset." - (let (charsets) - ;; The return possibilities of this function are a mess... - (or (and (mm-multibyte-p) - mm-use-find-coding-systems-region - ;; Find the mime-charset of the most preferred coding - ;; system that has one. - (let ((systems (find-coding-systems-region b e))) - (when mm-coding-system-priorities - (setq systems - (sort systems 'mm-sort-coding-systems-predicate))) - (setq systems (delq 'compound-text systems)) - (unless (equal systems '(undecided)) - (while systems - (let* ((head (pop systems)) - (cs (or (coding-system-get head :mime-charset) - (coding-system-get head 'mime-charset)))) - ;; The mime-charset (`x-ctext') of - ;; `compound-text' is not in the IANA list. We - ;; shouldn't normally use anything here with a - ;; mime-charset having an `x-' prefix. - ;; Fixme: Allow this to be overridden, since - ;; there is existing use of x-ctext. - ;; Also people apparently need the coding system - ;; `iso-2022-jp-3' (which Mule-UCS defines with - ;; mime-charset, though it's not valid). - (if (and cs - (not (string-match "^[Xx]-" (symbol-name cs))) - ;; UTF-16 of any variety is invalid for - ;; text parts and, unfortunately, has - ;; mime-charset defined both in Mule-UCS - ;; and versions of Emacs. (The name - ;; might be `mule-utf-16...' or - ;; `utf-16...'.) - (not (string-match "utf-16" (symbol-name cs)))) - (setq systems nil - charsets (list cs)))))) - charsets)) - ;; If we're XEmacs, and some coding system is appropriate, - ;; mm-xemacs-find-mime-charset will return an appropriate list. - ;; Otherwise, we'll get nil, and the next setq will get invoked. - (setq charsets (mm-xemacs-find-mime-charset b e)) - - ;; We're not multibyte, or a single coding system won't cover it. - (setq charsets - (mm-delete-duplicates - (mapcar 'mm-mime-charset - (delq 'ascii - (mm-find-charset-region b e)))))) - (if (and (> (length charsets) 1) - (memq 'iso-8859-15 charsets) - (memq 'iso-8859-15 hack-charsets) - (save-excursion (mm-iso-8859-x-to-15-region b e))) - (mapcar (lambda (x) (setq charsets (delq (car x) charsets))) - mm-iso-8859-15-compatible)) - (if (and (memq 'iso-2022-jp-2 charsets) - (memq 'iso-2022-jp-2 hack-charsets)) - (setq charsets (delq 'iso-2022-jp charsets))) - ;; Attempt to reduce the number of charsets if utf-8 is available. - (if (and (featurep 'xemacs) - (> (length charsets) 1) - (mm-coding-system-p 'utf-8)) - (let ((mm-coding-system-priorities - (cons 'utf-8 mm-coding-system-priorities))) - (setq charsets - (mm-delete-duplicates - (mapcar 'mm-mime-charset - (delq 'ascii - (mm-find-charset-region b e))))))) - charsets)) - -(defmacro mm-with-unibyte-buffer (&rest forms) - "Create a temporary buffer, and evaluate FORMS there like `progn'. -Use unibyte mode for this." - `(let (default-enable-multibyte-characters) - (with-temp-buffer ,@forms))) -(put 'mm-with-unibyte-buffer 'lisp-indent-function 0) -(put 'mm-with-unibyte-buffer 'edebug-form-spec '(body)) - -(defmacro mm-with-multibyte-buffer (&rest forms) - "Create a temporary buffer, and evaluate FORMS there like `progn'. -Use multibyte mode for this." - `(let ((default-enable-multibyte-characters t)) - (with-temp-buffer ,@forms))) -(put 'mm-with-multibyte-buffer 'lisp-indent-function 0) -(put 'mm-with-multibyte-buffer 'edebug-form-spec '(body)) - -(defmacro mm-with-unibyte-current-buffer (&rest forms) - "Evaluate FORMS with current buffer temporarily made unibyte. -Also bind `default-enable-multibyte-characters' to nil. -Equivalent to `progn' in XEmacs - -NOTE: Use this macro with caution in multibyte buffers (it is not -worth using this macro in unibyte buffers of course). Use of -`(set-buffer-multibyte t)', which is run finally, is generally -harmful since it is likely to modify existing data in the buffer. -For instance, it converts \"\\300\\255\" into \"\\255\" in -Emacs 23 (unicode)." - (let ((multibyte (make-symbol "multibyte")) - (buffer (make-symbol "buffer"))) - `(if mm-emacs-mule - (let ((,multibyte enable-multibyte-characters) - (,buffer (current-buffer))) - (unwind-protect - (let (default-enable-multibyte-characters) - (set-buffer-multibyte nil) - ,@forms) - (set-buffer ,buffer) - (set-buffer-multibyte ,multibyte))) - (let (default-enable-multibyte-characters) - ,@forms)))) -(put 'mm-with-unibyte-current-buffer 'lisp-indent-function 0) -(put 'mm-with-unibyte-current-buffer 'edebug-form-spec '(body)) - -(defmacro mm-with-unibyte (&rest forms) - "Eval the FORMS with the default value of `enable-multibyte-characters' nil." - `(let (default-enable-multibyte-characters) - ,@forms)) -(put 'mm-with-unibyte 'lisp-indent-function 0) -(put 'mm-with-unibyte 'edebug-form-spec '(body)) - -(defmacro mm-with-multibyte (&rest forms) - "Eval the FORMS with the default value of `enable-multibyte-characters' t." - `(let ((default-enable-multibyte-characters t)) - ,@forms)) -(put 'mm-with-multibyte 'lisp-indent-function 0) -(put 'mm-with-multibyte 'edebug-form-spec '(body)) - -(defun mm-find-charset-region (b e) - "Return a list of Emacs charsets in the region B to E." - (cond - ((and (mm-multibyte-p) - (fboundp 'find-charset-region)) - ;; Remove composition since the base charsets have been included. - ;; Remove eight-bit-*, treat them as ascii. - (let ((css (find-charset-region b e))) - (mapcar (lambda (cs) (setq css (delq cs css))) - '(composition eight-bit-control eight-bit-graphic - control-1)) - css)) - (t - ;; We are in a unibyte buffer or XEmacs non-mule, so we futz around a bit. - (save-excursion - (save-restriction - (narrow-to-region b e) - (goto-char (point-min)) - (skip-chars-forward "\0-\177") - (if (eobp) - '(ascii) - (let (charset) - (setq charset - (and (boundp 'current-language-environment) - (car (last (assq 'charset - (assoc current-language-environment - language-info-alist)))))) - (if (eq charset 'ascii) (setq charset nil)) - (or charset - (setq charset - (car (last (assq mail-parse-charset - mm-mime-mule-charset-alist))))) - (list 'ascii (or charset 'latin-iso8859-1))))))))) - -(if (fboundp 'shell-quote-argument) - (defalias 'mm-quote-arg 'shell-quote-argument) - (defun mm-quote-arg (arg) - "Return a version of ARG that is safe to evaluate in a shell." - (let ((pos 0) new-pos accum) - ;; *** bug: we don't handle newline characters properly - (while (setq new-pos (string-match "[]*[;!'`\"$\\& \t{} |()<>]" arg pos)) - (push (substring arg pos new-pos) accum) - (push "\\" accum) - (push (list (aref arg new-pos)) accum) - (setq pos (1+ new-pos))) - (if (= pos 0) - arg - (apply 'concat (nconc (nreverse accum) (list (substring arg pos)))))))) - -(defun mm-auto-mode-alist () - "Return an `auto-mode-alist' with only the .gz (etc) thingies." - (let ((alist auto-mode-alist) - out) - (while alist - (when (listp (cdar alist)) - (push (car alist) out)) - (pop alist)) - (nreverse out))) - -(defvar mm-inhibit-file-name-handlers - '(jka-compr-handler image-file-handler) - "A list of handlers doing (un)compression (etc) thingies.") - -(defun mm-insert-file-contents (filename &optional visit beg end replace - inhibit) - "Like `insert-file-contents', but only reads in the file. -A buffer may be modified in several ways after reading into the buffer due -to advanced Emacs features, such as file-name-handlers, format decoding, -`find-file-hooks', etc. -If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'. - This function ensures that none of these modifications will take place." - (let* ((format-alist nil) - (auto-mode-alist (if inhibit nil (mm-auto-mode-alist))) - (default-major-mode 'fundamental-mode) - (enable-local-variables nil) - (after-insert-file-functions nil) - (enable-local-eval nil) - (inhibit-file-name-operation (if inhibit - 'insert-file-contents - inhibit-file-name-operation)) - (inhibit-file-name-handlers - (if inhibit - (append mm-inhibit-file-name-handlers - inhibit-file-name-handlers) - inhibit-file-name-handlers)) - (ffh (if (boundp 'find-file-hook) - 'find-file-hook - 'find-file-hooks)) - (val (symbol-value ffh))) - (set ffh nil) - (unwind-protect - (insert-file-contents filename visit beg end replace) - (set ffh val)))) - -(defun mm-append-to-file (start end filename &optional codesys inhibit) - "Append the contents of the region to the end of file FILENAME. -When called from a function, expects three arguments, -START, END and FILENAME. START and END are buffer positions -saying what text to write. -Optional fourth argument specifies the coding system to use when -encoding the file. -If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'." - (let ((coding-system-for-write - (or codesys mm-text-coding-system-for-write - mm-text-coding-system)) - (inhibit-file-name-operation (if inhibit - 'append-to-file - inhibit-file-name-operation)) - (inhibit-file-name-handlers - (if inhibit - (append mm-inhibit-file-name-handlers - inhibit-file-name-handlers) - inhibit-file-name-handlers))) - (write-region start end filename t 'no-message) - (message "Appended to %s" filename))) - -(defun mm-write-region (start end filename &optional append visit lockname - coding-system inhibit) - - "Like `write-region'. -If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'." - (let ((coding-system-for-write - (or coding-system mm-text-coding-system-for-write - mm-text-coding-system)) - (inhibit-file-name-operation (if inhibit - 'write-region - inhibit-file-name-operation)) - (inhibit-file-name-handlers - (if inhibit - (append mm-inhibit-file-name-handlers - inhibit-file-name-handlers) - inhibit-file-name-handlers))) - (write-region start end filename append visit lockname))) - -;; It is not a MIME function, but some MIME functions use it. -(if (and (fboundp 'make-temp-file) - (ignore-errors - (let ((def (symbol-function 'make-temp-file))) - (and (byte-code-function-p def) - (setq def (if (fboundp 'compiled-function-arglist) - ;; XEmacs - (eval (list 'compiled-function-arglist def)) - (aref def 0))) - (>= (length def) 4) - (eq (nth 3 def) 'suffix))))) - (defalias 'mm-make-temp-file 'make-temp-file) - ;; Stolen (and modified for Emacs 20 and XEmacs) from Emacs 22. - (defun mm-make-temp-file (prefix &optional dir-flag suffix) - "Create a temporary file. -The returned file name (created by appending some random characters at the end -of PREFIX, and expanding against `temporary-file-directory' if necessary), -is guaranteed to point to a newly created empty file. -You can then use `write-region' to write new data into the file. - -If DIR-FLAG is non-nil, create a new empty directory instead of a file. - -If SUFFIX is non-nil, add that at the end of the file name." - (let ((umask (default-file-modes)) - file) - (unwind-protect - (progn - ;; Create temp files with strict access rights. It's easy to - ;; loosen them later, whereas it's impossible to close the - ;; time-window of loose permissions otherwise. - (set-default-file-modes 448) - (while (condition-case err - (progn - (setq file - (make-temp-name - (expand-file-name - prefix - (if (fboundp 'temp-directory) - ;; XEmacs - (temp-directory) - temporary-file-directory)))) - (if suffix - (setq file (concat file suffix))) - (if dir-flag - (make-directory file) - ;; NOTE: This is unsafe if Emacs 20 - ;; users and XEmacs users don't use - ;; a secure temp directory. - (gmm-write-region "" nil file nil 'silent - nil 'excl)) - nil) - (file-already-exists t) - ;; The Emacs 20 and XEmacs versions of - ;; `make-directory' issue `file-error'. - (file-error (or (and (or (featurep 'xemacs) - (= emacs-major-version 20)) - (file-exists-p file)) - (signal (car err) (cdr err))))) - ;; the file was somehow created by someone else between - ;; `make-temp-name' and `write-region', let's try again. - nil) - file) - ;; Reset the umask. - (set-default-file-modes umask))))) - -(defun mm-image-load-path (&optional package) - (let (dir result) - (dolist (path load-path (nreverse result)) - (when (and path - (file-directory-p - (setq dir (concat (file-name-directory - (directory-file-name path)) - "etc/images/" (or package "gnus/"))))) - (push dir result)) - (push path result)))) - -;; Fixme: This doesn't look useful where it's used. -(if (fboundp 'detect-coding-region) - (defun mm-detect-coding-region (start end) - "Like `detect-coding-region' except returning the best one." - (let ((coding-systems - (detect-coding-region start end))) - (or (car-safe coding-systems) - coding-systems))) - (defun mm-detect-coding-region (start end) - (let ((point (point))) - (goto-char start) - (skip-chars-forward "\0-\177" end) - (prog1 - (if (eq (point) end) 'ascii (mm-guess-charset)) - (goto-char point))))) - -(if (fboundp 'coding-system-get) - (defun mm-detect-mime-charset-region (start end) - "Detect MIME charset of the text in the region between START and END." - (let ((cs (mm-detect-coding-region start end))) - (or (coding-system-get cs :mime-charset) - (coding-system-get cs 'mime-charset)))) - (defun mm-detect-mime-charset-region (start end) - "Detect MIME charset of the text in the region between START and END." - (let ((cs (mm-detect-coding-region start end))) - cs))) - - -(provide 'mm-util) - -;; arch-tag: 94dc5388-825d-4fd1-bfa5-2100aa351238 -;;; mm-util.el ends here diff --git a/xemacs-packages/gnus/lisp/mm-uu.el b/xemacs-packages/gnus/lisp/mm-uu.el deleted file mode 100644 index 52685c23..00000000 --- a/xemacs-packages/gnus/lisp/mm-uu.el +++ /dev/null @@ -1,627 +0,0 @@ -;;; mm-uu.el --- Return uu stuff as mm handles - -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Shenghuo Zhu -;; Keywords: postscript uudecode binhex shar forward gnatsweb pgp - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. -;; -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) -(require 'mail-parse) -(require 'nnheader) -(require 'mm-decode) -(require 'mailcap) -(require 'mml2015) - -(autoload 'uudecode-decode-region "uudecode") -(autoload 'uudecode-decode-region-external "uudecode") -(autoload 'uudecode-decode-region-internal "uudecode") - -(autoload 'binhex-decode-region "binhex") -(autoload 'binhex-decode-region-external "binhex") -(autoload 'binhex-decode-region-internal "binhex") - -(autoload 'yenc-decode-region "yenc") -(autoload 'yenc-extract-filename "yenc") - -(defcustom mm-uu-decode-function 'uudecode-decode-region - "*Function to uudecode. -Internal function is done in Lisp by default, therefore decoding may -appear to be horribly slow. You can make Gnus use an external -decoder, such as uudecode." - :type '(choice - (function-item :tag "Auto detect" uudecode-decode-region) - (function-item :tag "Internal" uudecode-decode-region-internal) - (function-item :tag "External" uudecode-decode-region-external)) - :group 'gnus-article-mime) - -(defcustom mm-uu-binhex-decode-function 'binhex-decode-region - "*Function to binhex decode. -Internal function is done in elisp by default, therefore decoding may -appear to be horribly slow . You can make Gnus use the external Unix -decoder, such as hexbin." - :type '(choice (function-item :tag "Auto detect" binhex-decode-region) - (function-item :tag "Internal" binhex-decode-region-internal) - (function-item :tag "External" binhex-decode-region-external)) - :group 'gnus-article-mime) - -(defvar mm-uu-yenc-decode-function 'yenc-decode-region) - -(defvar mm-uu-pgp-beginning-signature - "^-----BEGIN PGP SIGNATURE-----") - -(defvar mm-uu-beginning-regexp nil) - -(defvar mm-dissect-disposition "inline" - "The default disposition of uu parts. -This can be either \"inline\" or \"attachment\".") - -(defcustom mm-uu-emacs-sources-regexp "\\.emacs\\.sources" - "The regexp of Emacs sources groups." - :version "22.1" - :type 'regexp - :group 'gnus-article-mime) - -(defcustom mm-uu-diff-groups-regexp - "\\(gmane\\|gnu\\)\\..*\\(diff\\|commit\\|cvs\\|bug\\|devel\\)" - "Regexp matching diff groups." - :version "22.1" - :type 'regexp - :group 'gnus-article-mime) - -(defvar mm-uu-type-alist - '((postscript - "^%!PS-" - "^%%EOF$" - mm-uu-postscript-extract - nil) - (uu - "^begin[ \t]+0?[0-7][0-7][0-7][ \t]+" - "^end[ \t]*$" - mm-uu-uu-extract - mm-uu-uu-filename) - (binhex - "^:...............................................................$" - ":$" - mm-uu-binhex-extract - nil - mm-uu-binhex-filename) - (yenc - "^=ybegin.*size=[0-9]+.*name=.*$" - "^=yend.*size=[0-9]+" - mm-uu-yenc-extract - mm-uu-yenc-filename) - (shar - "^#! */bin/sh" - "^exit 0$" - mm-uu-shar-extract) - (forward - ;; Thanks to Edward J. Sabol and - ;; Peter von der Ah\'e - "^-+ \\(Start of \\)?Forwarded message" - "^-+ End \\(of \\)?forwarded message" - mm-uu-forward-extract - nil - mm-uu-forward-test) - (gnatsweb - "^----gnatsweb-attachment----" - nil - mm-uu-gnatsweb-extract) - (pgp-signed - "^-----BEGIN PGP SIGNED MESSAGE-----" - "^-----END PGP SIGNATURE-----" - mm-uu-pgp-signed-extract - nil - nil) - (pgp-encrypted - "^-----BEGIN PGP MESSAGE-----" - "^-----END PGP MESSAGE-----" - mm-uu-pgp-encrypted-extract - nil - nil) - (pgp-key - "^-----BEGIN PGP PUBLIC KEY BLOCK-----" - "^-----END PGP PUBLIC KEY BLOCK-----" - mm-uu-pgp-key-extract - mm-uu-gpg-key-skip-to-last - nil) - (emacs-sources - "^;;;?[ \t]*[^ \t]+\\.el[ \t]*--" - "^;;;?[ \t]*\\([^ \t]+\\.el\\)[ \t]+ends here" - mm-uu-emacs-sources-extract - nil - mm-uu-emacs-sources-test) - (diff - "^Index: " - nil - mm-uu-diff-extract - nil - mm-uu-diff-test)) - "A list of specifications for non-MIME attachments. -Each element consist of the following entries: label, -start-regexp, end-regexp, extract-function, test-function. - -After modifying this list you must run \\[mm-uu-configure]. - -You can disable elements from this list by customizing -`mm-uu-configure-list'.") - -(defcustom mm-uu-configure-list '((shar . disabled)) - "A list of mm-uu configuration. -To disable dissecting shar codes, for instance, add -`(shar . disabled)' to this list." - :type 'alist - :options (mapcar (lambda (entry) - (list (car entry) '(const disabled))) - mm-uu-type-alist) - :group 'gnus-article-mime) - -(defvar mm-uu-text-plain-type '("text/plain" (charset . gnus-decoded)) - "MIME type and parameters for text/plain parts. -`gnus-decoded' is a fake charset, which means no further decoding.") - -;; functions - -(defsubst mm-uu-type (entry) - (car entry)) - -(defsubst mm-uu-beginning-regexp (entry) - (nth 1 entry)) - -(defsubst mm-uu-end-regexp (entry) - (nth 2 entry)) - -(defsubst mm-uu-function-extract (entry) - (nth 3 entry)) - -(defsubst mm-uu-function-1 (entry) - (nth 4 entry)) - -(defsubst mm-uu-function-2 (entry) - (nth 5 entry)) - -(defun mm-uu-copy-to-buffer (&optional from to) - "Copy the contents of the current buffer to a fresh buffer. -Return that buffer." - (let ((obuf (current-buffer)) - (coding-system - ;; Might not exist in non-MULE XEmacs - (when (boundp 'buffer-file-coding-system) - buffer-file-coding-system))) - (with-current-buffer (generate-new-buffer " *mm-uu*") - (setq buffer-file-coding-system coding-system) - (insert-buffer-substring obuf from to) - (current-buffer)))) - -(defun mm-uu-configure-p (key val) - (member (cons key val) mm-uu-configure-list)) - -(defun mm-uu-configure (&optional symbol value) - "Configure detection of non-MIME attachments." - (interactive) - (if symbol (set-default symbol value)) - (setq mm-uu-beginning-regexp nil) - (mapcar (lambda (entry) - (if (mm-uu-configure-p (mm-uu-type entry) 'disabled) - nil - (setq mm-uu-beginning-regexp - (concat mm-uu-beginning-regexp - (if mm-uu-beginning-regexp "\\|") - (mm-uu-beginning-regexp entry))))) - mm-uu-type-alist)) - -(mm-uu-configure) - -(eval-when-compile - (defvar file-name) - (defvar start-point) - (defvar end-point) - (defvar entry)) - -(defun mm-uu-uu-filename () - (if (looking-at ".+") - (setq file-name - (let ((nnheader-file-name-translation-alist - '((?/ . ?,) (?\ . ?_) (?* . ?_) (?$ . ?_)))) - (nnheader-translate-file-chars (match-string 0)))))) - -(defun mm-uu-binhex-filename () - (setq file-name - (ignore-errors - (binhex-decode-region start-point end-point t)))) - -(defun mm-uu-yenc-filename () - (goto-char start-point) - (setq file-name - (ignore-errors - (yenc-extract-filename)))) - -(defun mm-uu-forward-test () - (save-excursion - (goto-char start-point) - (forward-line) - (looking-at "[\r\n]*[a-zA-Z][a-zA-Z0-9-]*:"))) - -(defun mm-uu-postscript-extract () - (mm-make-handle (mm-uu-copy-to-buffer start-point end-point) - '("application/postscript"))) - -(defun mm-uu-emacs-sources-extract () - (mm-make-handle (mm-uu-copy-to-buffer start-point end-point) - '("application/emacs-lisp" (charset . gnus-decoded)) - nil nil - (list mm-dissect-disposition - (cons 'filename file-name)))) - -(eval-when-compile - (defvar gnus-newsgroup-name)) - -(defun mm-uu-emacs-sources-test () - (setq file-name (match-string 1)) - (and gnus-newsgroup-name - mm-uu-emacs-sources-regexp - (string-match mm-uu-emacs-sources-regexp gnus-newsgroup-name))) - -(defun mm-uu-diff-extract () - (mm-make-handle (mm-uu-copy-to-buffer start-point end-point) - '("text/x-patch" (charset . gnus-decoded)))) - -(defun mm-uu-diff-test () - (and gnus-newsgroup-name - mm-uu-diff-groups-regexp - (string-match mm-uu-diff-groups-regexp gnus-newsgroup-name))) - -(defun mm-uu-forward-extract () - (mm-make-handle (mm-uu-copy-to-buffer - (progn (goto-char start-point) (forward-line) (point)) - (progn (goto-char end-point) (forward-line -1) (point))) - '("message/rfc822" (charset . gnus-decoded)))) - -(defun mm-uu-uu-extract () - (mm-make-handle (mm-uu-copy-to-buffer start-point end-point) - (list (or (and file-name - (string-match "\\.[^\\.]+$" - file-name) - (mailcap-extension-to-mime - (match-string 0 file-name))) - "application/octet-stream")) - 'x-uuencode nil - (if (and file-name (not (equal file-name ""))) - (list mm-dissect-disposition - (cons 'filename file-name))))) - -(defun mm-uu-binhex-extract () - (mm-make-handle (mm-uu-copy-to-buffer start-point end-point) - (list (or (and file-name - (string-match "\\.[^\\.]+$" file-name) - (mailcap-extension-to-mime - (match-string 0 file-name))) - "application/octet-stream")) - 'x-binhex nil - (if (and file-name (not (equal file-name ""))) - (list mm-dissect-disposition - (cons 'filename file-name))))) - -(defun mm-uu-yenc-extract () - (mm-make-handle (mm-uu-copy-to-buffer start-point end-point) - (list (or (and file-name - (string-match "\\.[^\\.]+$" file-name) - (mailcap-extension-to-mime - (match-string 0 file-name))) - "application/octet-stream")) - 'x-yenc nil - (if (and file-name (not (equal file-name ""))) - (list mm-dissect-disposition - (cons 'filename file-name))))) - - -(defun mm-uu-shar-extract () - (mm-make-handle (mm-uu-copy-to-buffer start-point end-point) - '("application/x-shar"))) - -(defun mm-uu-gnatsweb-extract () - (save-restriction - (goto-char start-point) - (forward-line) - (narrow-to-region (point) end-point) - (mm-dissect-buffer t))) - -(defun mm-uu-pgp-signed-test (&rest rest) - (and - mml2015-use - (mml2015-clear-verify-function) - (cond - ((eq mm-verify-option 'never) nil) - ((eq mm-verify-option 'always) t) - ((eq mm-verify-option 'known) t) - (t (prog1 - (y-or-n-p "Verify pgp signed part? ") - (message "")))))) - -(eval-when-compile - (defvar gnus-newsgroup-charset)) - -(defun mm-uu-pgp-signed-extract-1 (handles ctl) - (let ((buf (mm-uu-copy-to-buffer (point-min) (point-max)))) - (with-current-buffer buf - (if (mm-uu-pgp-signed-test) - (progn - (mml2015-clean-buffer) - (let ((coding-system-for-write (or gnus-newsgroup-charset - 'iso-8859-1))) - (funcall (mml2015-clear-verify-function)))) - (when (and mml2015-use (null (mml2015-clear-verify-function))) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details - (format "Clear verification not supported by `%s'.\n" mml2015-use)))) - (goto-char (point-min)) - (forward-line) - ;; We need to be careful not to strip beyond the armor headers. - ;; Previously, an attacker could replace the text inside our - ;; markup with trailing garbage by injecting whitespace into the - ;; message. - (while (looking-at "Hash:") ; The only header allowed in cleartext - (forward-line)) ; signatures according to RFC2440. - (when (looking-at "[\t ]*$") - (forward-line)) - (delete-region (point-min) (point)) - (if (re-search-forward mm-uu-pgp-beginning-signature nil t) - (delete-region (match-beginning 0) (point-max))) - (goto-char (point-min)) - (while (re-search-forward "^- " nil t) - (replace-match "" t t) - (forward-line 1))) - (list (mm-make-handle buf mm-uu-text-plain-type)))) - -(defun mm-uu-pgp-signed-extract () - (let ((mm-security-handle (list (format "multipart/signed")))) - (mm-set-handle-multipart-parameter - mm-security-handle 'protocol "application/x-gnus-pgp-signature") - (save-restriction - (narrow-to-region start-point end-point) - (add-text-properties 0 (length (car mm-security-handle)) - (list 'buffer (mm-uu-copy-to-buffer)) - (car mm-security-handle)) - (setcdr mm-security-handle - (mm-uu-pgp-signed-extract-1 nil - mm-security-handle))) - mm-security-handle)) - -(defun mm-uu-pgp-encrypted-test (&rest rest) - (and - mml2015-use - (mml2015-clear-decrypt-function) - (cond - ((eq mm-decrypt-option 'never) nil) - ((eq mm-decrypt-option 'always) t) - ((eq mm-decrypt-option 'known) t) - (t (prog1 - (y-or-n-p "Decrypt pgp encrypted part? ") - (message "")))))) - -(defun mm-uu-pgp-encrypted-extract-1 (handles ctl) - (let ((buf (mm-uu-copy-to-buffer (point-min) (point-max))) - (first t) - charset) - ;; Make sure there's a blank line between header and body. - (with-current-buffer buf - (goto-char (point-min)) - (while (prog2 - (forward-line 1) - (if first - (looking-at "[^\t\n ]+:") - (looking-at "[^\t\n ]+:\\|[\t ]")) - (setq first nil))) - (unless (memq (char-after) '(?\n nil)) - (insert "\n")) - (save-restriction - (narrow-to-region (point-min) (point)) - (setq charset (mail-fetch-field "charset"))) - (if (and (mm-uu-pgp-encrypted-test) - (progn - (mml2015-clean-buffer) - (funcall (mml2015-clear-decrypt-function)) - (equal (mm-handle-multipart-ctl-parameter mm-security-handle - 'gnus-info) - "OK"))) - (progn - ;; Decode charset. - (if (and (or charset - (setq charset gnus-newsgroup-charset)) - (setq charset (mm-charset-to-coding-system charset)) - (not (eq charset 'ascii))) - ;; Assume that buffer's multibyteness is turned off. - ;; See `mml2015-pgg-clear-decrypt'. - (insert (mm-decode-coding-string (prog1 - (buffer-string) - (erase-buffer) - (mm-enable-multibyte)) - charset)) - (mm-enable-multibyte)) - (list (mm-make-handle buf mm-uu-text-plain-type))) - (list (mm-make-handle buf '("application/pgp-encrypted"))))))) - -(defun mm-uu-pgp-encrypted-extract () - (let ((mm-security-handle (list (format "multipart/encrypted")))) - (mm-set-handle-multipart-parameter - mm-security-handle 'protocol "application/x-gnus-pgp-encrypted") - (save-restriction - (narrow-to-region start-point end-point) - (add-text-properties 0 (length (car mm-security-handle)) - (list 'buffer (mm-uu-copy-to-buffer)) - (car mm-security-handle)) - (setcdr mm-security-handle - (mm-uu-pgp-encrypted-extract-1 nil - mm-security-handle))) - mm-security-handle)) - -(defun mm-uu-gpg-key-skip-to-last () - (let ((point (point)) - (end-regexp (mm-uu-end-regexp entry)) - (beginning-regexp (mm-uu-beginning-regexp entry))) - (when (and end-regexp - (not (mm-uu-configure-p (mm-uu-type entry) 'disabled))) - (while (re-search-forward end-regexp nil t) - (skip-chars-forward " \t\n\r") - (if (looking-at beginning-regexp) - (setq point (match-end 0))))) - (goto-char point))) - -(defun mm-uu-pgp-key-extract () - (let ((buf (mm-uu-copy-to-buffer start-point end-point))) - (mm-make-handle buf - '("application/pgp-keys")))) - -;;;###autoload -(defun mm-uu-dissect (&optional noheader mime-type) - "Dissect the current buffer and return a list of uu handles. -The optional NOHEADER means there's no header in the buffer. -MIME-TYPE specifies a MIME type and parameters, which defaults to the -value of `mm-uu-text-plain-type'." - (let ((case-fold-search t) - (mm-uu-text-plain-type (or mime-type mm-uu-text-plain-type)) - text-start start-point end-point file-name result entry func) - (save-excursion - (goto-char (point-min)) - (cond - (noheader) - ((looking-at "\n") - (forward-line)) - ((search-forward "\n\n" nil t) - t) - (t (goto-char (point-max)))) - (setq text-start (point)) - (while (re-search-forward mm-uu-beginning-regexp nil t) - (setq start-point (match-beginning 0) - entry nil) - (let ((alist mm-uu-type-alist) - (beginning-regexp (match-string 0))) - (while (not entry) - (if (string-match (mm-uu-beginning-regexp (car alist)) - beginning-regexp) - (setq entry (car alist)) - (pop alist)))) - (if (setq func (mm-uu-function-1 entry)) - (funcall func)) - (forward-line);; in case of failure - (when (and (not (mm-uu-configure-p (mm-uu-type entry) 'disabled)) - (let ((end-regexp (mm-uu-end-regexp entry))) - (if (not end-regexp) - (or (setq end-point (point-max)) t) - (prog1 - (re-search-forward end-regexp nil t) - (forward-line) - (setq end-point (point))))) - (or (not (setq func (mm-uu-function-2 entry))) - (funcall func))) - (if (and (> start-point text-start) - (progn - (goto-char text-start) - (re-search-forward "." start-point t))) - (push - (mm-make-handle (mm-uu-copy-to-buffer text-start start-point) - mm-uu-text-plain-type) - result)) - (push - (funcall (mm-uu-function-extract entry)) - result) - (goto-char (setq text-start end-point)))) - (when result - (if (and (> (point-max) (1+ text-start)) - (save-excursion - (goto-char text-start) - (re-search-forward "." nil t))) - (push - (mm-make-handle (mm-uu-copy-to-buffer text-start (point-max)) - mm-uu-text-plain-type) - result)) - (setq result (cons "multipart/mixed" (nreverse result)))) - result))) - -;;;###autoload -(defun mm-uu-dissect-text-parts (handle &optional decoded) - "Dissect text parts and put uu handles into HANDLE. -Assume text has been decoded if DECODED is non-nil." - (let ((buffer (mm-handle-buffer handle))) - (cond ((stringp buffer) - (dolist (elem (cdr handle)) - (mm-uu-dissect-text-parts elem decoded))) - ((bufferp buffer) - (let ((type (mm-handle-media-type handle)) - (case-fold-search t) ;; string-match - children charset encoding) - (when (and - (stringp type) - ;; Mutt still uses application/pgp even though - ;; it has already been withdrawn. - (string-match "\\`text/\\|\\`application/pgp\\'" type) - (setq - children - (with-current-buffer buffer - (cond - ((or decoded - (eq (setq charset (mail-content-type-get - (mm-handle-type handle) - 'charset)) - 'gnus-decoded)) - (setq decoded t) - (mm-uu-dissect - t (cons type '((charset . gnus-decoded))))) - (charset - (setq decoded t) - (mm-with-multibyte-buffer - (insert (mm-decode-string (mm-get-part handle) - charset)) - (mm-uu-dissect - t (cons type '((charset . gnus-decoded)))))) - ((setq encoding (mm-handle-encoding handle)) - (setq decoded nil) - ;; Inherit the multibyteness of the `buffer'. - (with-temp-buffer - (insert-buffer-substring buffer) - (mm-decode-content-transfer-encoding - encoding type) - (mm-uu-dissect t (list type)))) - (t - (setq decoded nil) - (mm-uu-dissect t (list type))))))) - ;; Ignore it if a given part is dissected into a single - ;; part of which the type is the same as the given one. - (if (and (<= (length children) 2) - (string-equal (mm-handle-media-type (cadr children)) - type)) - (kill-buffer (mm-handle-buffer (cadr children))) - (kill-buffer buffer) - (setcdr handle (cdr children)) - (setcar handle (car children)) ;; "multipart/mixed" - (dolist (elem (cdr children)) - (mm-uu-dissect-text-parts elem decoded)))))) - (t - (dolist (elem handle) - (mm-uu-dissect-text-parts elem decoded)))))) - -(provide 'mm-uu) - -;; arch-tag: 7db076bf-53db-4320-aa19-ca76a1d2ab2c -;;; mm-uu.el ends here diff --git a/xemacs-packages/gnus/lisp/mm-view.el b/xemacs-packages/gnus/lisp/mm-view.el deleted file mode 100644 index df4ffb84..00000000 --- a/xemacs-packages/gnus/lisp/mm-view.el +++ /dev/null @@ -1,658 +0,0 @@ -;;; mm-view.el --- functions for viewing MIME objects - -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) -(require 'mail-parse) -(require 'mailcap) -(require 'mm-bodies) -(require 'mm-decode) - -(eval-and-compile - (autoload 'gnus-article-prepare-display "gnus-art") - (autoload 'vcard-parse-string "vcard") - (autoload 'vcard-format-string "vcard") - (autoload 'fill-flowed "flow-fill") - (autoload 'html2text "html2text" nil t) - (unless (fboundp 'diff-mode) - (autoload 'diff-mode "diff-mode" "" t nil))) - -(defvar gnus-article-mime-handles) -(defvar gnus-newsgroup-charset) -(defvar smime-keys) -(defvar w3m-cid-retrieve-function-alist) -(defvar w3m-current-buffer) -(defvar w3m-display-inline-images) -(defvar w3m-minor-mode-map) - -(defvar mm-text-html-renderer-alist - '((w3 . mm-inline-text-html-render-with-w3) - (w3m . mm-inline-text-html-render-with-w3m) - (w3m-standalone . mm-inline-text-html-render-with-w3m-standalone) - (links mm-inline-render-with-file - mm-links-remove-leading-blank - "links" "-dump" file) - (lynx mm-inline-render-with-stdin nil - "lynx" "-dump" "-force_html" "-stdin" "-nolist") - (html2text mm-inline-render-with-function html2text)) - "The attributes of renderer types for text/html.") - -(defvar mm-text-html-washer-alist - '((w3 . gnus-article-wash-html-with-w3) - (w3m . gnus-article-wash-html-with-w3m) - (w3m-standalone . gnus-article-wash-html-with-w3m-standalone) - (links mm-inline-wash-with-file - mm-links-remove-leading-blank - "links" "-dump" file) - (lynx mm-inline-wash-with-stdin nil - "lynx" "-dump" "-force_html" "-stdin" "-nolist") - (html2text html2text)) - "The attributes of washer types for text/html.") - -(defcustom mm-fill-flowed t - "If non-nil an format=flowed article will be displayed flowed." - :type 'boolean - :version "22.1" - :group 'mime-display) - -;;; Internal variables. - -;;; -;;; Functions for displaying various formats inline -;;; - -(defun mm-inline-image-emacs (handle) - (let ((b (point-marker)) - buffer-read-only) - (put-image (mm-get-image handle) b) - (insert "\n\n") - (mm-handle-set-undisplayer - handle - `(lambda () - (let ((b ,b) - buffer-read-only) - (remove-images b b) - (delete-region b (+ b 2))))))) - -(defun mm-inline-image-xemacs (handle) - (insert "\n\n") - (forward-char -2) - (let ((annot (make-annotation (mm-get-image handle) nil 'text)) - buffer-read-only) - (mm-handle-set-undisplayer - handle - `(lambda () - (let ((b ,(point-marker)) - buffer-read-only) - (delete-annotation ,annot) - (delete-region (- b 2) b)))) - (set-extent-property annot 'mm t) - (set-extent-property annot 'duplicable t))) - -(eval-and-compile - (if (featurep 'xemacs) - (defalias 'mm-inline-image 'mm-inline-image-xemacs) - (defalias 'mm-inline-image 'mm-inline-image-emacs))) - -(defvar mm-w3-setup nil) -(defun mm-setup-w3 () - (unless mm-w3-setup - (require 'w3) - (w3-do-setup) - (require 'url) - (require 'w3-vars) - (require 'url-vars) - (setq mm-w3-setup t))) - -(defun mm-inline-text-html-render-with-w3 (handle) - (mm-setup-w3) - (let ((text (mm-get-part handle)) - (b (point)) - (url-standalone-mode t) - (url-gateway-unplugged t) - (w3-honor-stylesheets nil) - (url-current-object - (url-generic-parse-url (format "cid:%s" (mm-handle-id handle)))) - (width (window-width)) - (charset (mail-content-type-get - (mm-handle-type handle) 'charset))) - (save-excursion - (insert text) - (save-restriction - (narrow-to-region b (point)) - (goto-char (point-min)) - (if (or (and (boundp 'w3-meta-content-type-charset-regexp) - (re-search-forward - w3-meta-content-type-charset-regexp nil t)) - (and (boundp 'w3-meta-charset-content-type-regexp) - (re-search-forward - w3-meta-charset-content-type-regexp nil t))) - (setq charset - (or (let ((bsubstr (buffer-substring-no-properties - (match-beginning 2) - (match-end 2)))) - (if (fboundp 'w3-coding-system-for-mime-charset) - (w3-coding-system-for-mime-charset bsubstr) - (mm-charset-to-coding-system bsubstr))) - charset))) - (delete-region (point-min) (point-max)) - (insert (mm-decode-string text charset)) - (save-window-excursion - (save-restriction - (let ((w3-strict-width width) - ;; Don't let w3 set the global version of - ;; this variable. - (fill-column fill-column)) - (if (or debug-on-error debug-on-quit) - (w3-region (point-min) (point-max)) - (condition-case () - (w3-region (point-min) (point-max)) - (error - (delete-region (point-min) (point-max)) - (let ((b (point)) - (charset (mail-content-type-get - (mm-handle-type handle) 'charset))) - (if (or (eq charset 'gnus-decoded) - (eq mail-parse-charset 'gnus-decoded)) - (save-restriction - (narrow-to-region (point) (point)) - (mm-insert-part handle) - (goto-char (point-max))) - (insert (mm-decode-string (mm-get-part handle) - charset)))) - (message - "Error while rendering html; showing as text/plain"))))))) - (mm-handle-set-undisplayer - handle - `(lambda () - (let (buffer-read-only) - (if (functionp 'remove-specifier) - (mapcar (lambda (prop) - (remove-specifier - (face-property 'default prop) - (current-buffer))) - '(background background-pixmap foreground))) - (delete-region ,(point-min-marker) - ,(point-max-marker))))))))) - -(defvar mm-w3m-setup nil - "Whether gnus-article-mode has been setup to use emacs-w3m.") - -(defun mm-setup-w3m () - "Setup gnus-article-mode to use emacs-w3m." - (unless mm-w3m-setup - (require 'w3m) - (unless (assq 'gnus-article-mode w3m-cid-retrieve-function-alist) - (push (cons 'gnus-article-mode 'mm-w3m-cid-retrieve) - w3m-cid-retrieve-function-alist)) - (setq mm-w3m-setup t)) - (setq w3m-display-inline-images mm-inline-text-html-with-images)) - -(defun mm-w3m-cid-retrieve-1 (url handle) - (dolist (elem handle) - (when (consp elem) - (when (equal url (mm-handle-id elem)) - (mm-insert-part elem) - (throw 'found-handle (mm-handle-media-type elem))) - (when (and (stringp (car elem)) - (equal "multipart" (mm-handle-media-supertype elem))) - (mm-w3m-cid-retrieve-1 url elem))))) - -(defun mm-w3m-cid-retrieve (url &rest args) - "Insert a content pointed by URL if it has the cid: scheme." - (when (string-match "\\`cid:" url) - (or (catch 'found-handle - (mm-w3m-cid-retrieve-1 - (setq url (concat "<" (substring url (match-end 0)) ">")) - (with-current-buffer w3m-current-buffer - gnus-article-mime-handles))) - (prog1 - nil - (message "Failed to find \"Content-ID: %s\"" url))))) - -(defun mm-inline-text-html-render-with-w3m (handle) - "Render a text/html part using emacs-w3m." - (mm-setup-w3m) - (let ((text (mm-get-part handle)) - (b (point)) - (charset (or (mail-content-type-get (mm-handle-type handle) 'charset) - mail-parse-charset))) - (save-excursion - (insert (if charset (mm-decode-string text charset) text)) - (save-restriction - (narrow-to-region b (point)) - (unless charset - (goto-char (point-min)) - (when (setq charset (w3m-detect-meta-charset)) - (delete-region (point-min) (point-max)) - (insert (mm-decode-string text charset)))) - (let ((w3m-safe-url-regexp mm-w3m-safe-url-regexp) - w3m-force-redisplay) - (w3m-region (point-min) (point-max) nil charset)) - (when (and mm-inline-text-html-with-w3m-keymap - (boundp 'w3m-minor-mode-map) - w3m-minor-mode-map) - (add-text-properties - (point-min) (point-max) - (list 'keymap w3m-minor-mode-map - ;; Put the mark meaning this part was rendered by emacs-w3m. - 'mm-inline-text-html-with-w3m t))) - (mm-handle-set-undisplayer - handle - `(lambda () - (let (buffer-read-only) - (if (functionp 'remove-specifier) - (mapcar (lambda (prop) - (remove-specifier - (face-property 'default prop) - (current-buffer))) - '(background background-pixmap foreground))) - (delete-region ,(point-min-marker) - ,(point-max-marker))))))))) - -(defvar mm-w3m-standalone-supports-m17n-p (if (featurep 'mule) 'undecided) - "*T means the w3m command supports the m17n feature.") - -(defun mm-w3m-standalone-supports-m17n-p () - "Say whether the w3m command supports the m17n feature." - (cond ((eq mm-w3m-standalone-supports-m17n-p t) t) - ((eq mm-w3m-standalone-supports-m17n-p nil) nil) - ((not (featurep 'mule)) (setq mm-w3m-standalone-supports-m17n-p nil)) - ((condition-case nil - (let ((coding-system-for-write 'iso-2022-jp) - (coding-system-for-read 'iso-2022-jp) - (str (mm-decode-coding-string "\ -\e$B#D#o#e#s!!#w#3#m!!#s#u#p#p#o#r#t!!#m#1#7#n!)\e(B" 'iso-2022-jp))) - (mm-with-multibyte-buffer - (insert str) - (call-process-region - (point-min) (point-max) "w3m" t t nil "-dump" - "-T" "text/html" "-I" "iso-2022-jp" "-O" "iso-2022-jp") - (goto-char (point-min)) - (search-forward str nil t))) - (error nil)) - (setq mm-w3m-standalone-supports-m17n-p t)) - (t - ;;(message "You had better upgrade your w3m command") - (setq mm-w3m-standalone-supports-m17n-p nil)))) - -(defun mm-inline-text-html-render-with-w3m-standalone (handle) - "Render a text/html part using w3m." - (if (mm-w3m-standalone-supports-m17n-p) - (let ((source (mm-get-part handle)) - (charset (or (mail-content-type-get (mm-handle-type handle) - 'charset) - (symbol-name mail-parse-charset))) - cs) - (unless (and charset - (setq cs (mm-charset-to-coding-system charset)) - (not (eq cs 'ascii))) - ;; The default. - (setq charset "iso-8859-1" - cs 'iso-8859-1)) - (mm-insert-inline - handle - (mm-with-unibyte-buffer - (insert source) - (mm-enable-multibyte) - (let ((coding-system-for-write 'binary) - (coding-system-for-read cs)) - (call-process-region - (point-min) (point-max) - "w3m" t t nil "-dump" "-T" "text/html" - "-I" charset "-O" charset)) - (buffer-string)))) - (mm-inline-render-with-stdin handle nil "w3m" "-dump" "-T" "text/html"))) - -(defun mm-links-remove-leading-blank () - ;; Delete the annoying three spaces preceding each line of links - ;; output. - (goto-char (point-min)) - (while (re-search-forward "^ " nil t) - (delete-region (match-beginning 0) (match-end 0)))) - -(defun mm-inline-wash-with-file (post-func cmd &rest args) - (let ((file (mm-make-temp-file - (expand-file-name "mm" mm-tmp-directory)))) - (let ((coding-system-for-write 'binary)) - (write-region (point-min) (point-max) file nil 'silent)) - (delete-region (point-min) (point-max)) - (unwind-protect - (apply 'call-process cmd nil t nil (mapcar 'eval args)) - (delete-file file)) - (and post-func (funcall post-func)))) - -(defun mm-inline-wash-with-stdin (post-func cmd &rest args) - (let ((coding-system-for-write 'binary)) - (apply 'call-process-region (point-min) (point-max) - cmd t t nil args)) - (and post-func (funcall post-func))) - -(defun mm-inline-render-with-file (handle post-func cmd &rest args) - (let ((source (mm-get-part handle))) - (mm-insert-inline - handle - (mm-with-unibyte-buffer - (insert source) - (apply 'mm-inline-wash-with-file post-func cmd args) - (buffer-string))))) - -(defun mm-inline-render-with-stdin (handle post-func cmd &rest args) - (let ((source (mm-get-part handle))) - (mm-insert-inline - handle - (mm-with-unibyte-buffer - (insert source) - (apply 'mm-inline-wash-with-stdin post-func cmd args) - (buffer-string))))) - -(defun mm-inline-render-with-function (handle func &rest args) - (let ((source (mm-get-part handle)) - (charset (or (mail-content-type-get (mm-handle-type handle) 'charset) - mail-parse-charset))) - (mm-insert-inline - handle - (mm-with-multibyte-buffer - (insert (if charset - (mm-decode-string source charset) - source)) - (apply func args) - (buffer-string))))) - -(defun mm-inline-text-html (handle) - (let* ((func (or mm-inline-text-html-renderer mm-text-html-renderer)) - (entry (assq func mm-text-html-renderer-alist)) - buffer-read-only) - (if entry - (setq func (cdr entry))) - (cond - ((functionp func) - (funcall func handle)) - (t - (apply (car func) handle (cdr func)))))) - -(defun mm-inline-text-vcard (handle) - (let (buffer-read-only) - (mm-insert-inline - handle - (concat "\n-- \n" - (ignore-errors - (if (fboundp 'vcard-pretty-print) - (vcard-pretty-print (mm-get-part handle)) - (vcard-format-string - (vcard-parse-string (mm-get-part handle) - 'vcard-standard-filter)))))))) - -(defun mm-inline-text (handle) - (let ((b (point)) - (type (mm-handle-media-subtype handle)) - (charset (mail-content-type-get - (mm-handle-type handle) 'charset)) - buffer-read-only) - (if (or (eq charset 'gnus-decoded) - ;; This is probably not entirely correct, but - ;; makes rfc822 parts with embedded multiparts work. - (eq mail-parse-charset 'gnus-decoded)) - (save-restriction - (narrow-to-region (point) (point)) - (mm-insert-part handle) - (goto-char (point-max))) - (insert (mm-decode-string (mm-get-part handle) charset))) - (when (and mm-fill-flowed - (equal type "plain") - (equal (cdr (assoc 'format (mm-handle-type handle))) - "flowed")) - (save-restriction - (narrow-to-region b (point)) - (goto-char b) - (fill-flowed) - (goto-char (point-max)))) - (save-restriction - (narrow-to-region b (point)) - (when (or (equal type "enriched") - (equal type "richtext")) - (set-text-properties (point-min) (point-max) nil) - (ignore-errors - (enriched-decode (point-min) (point-max)))) - (mm-handle-set-undisplayer - handle - `(lambda () - (let (buffer-read-only) - (delete-region ,(point-min-marker) - ,(point-max-marker)))))))) - -(defun mm-insert-inline (handle text) - "Insert TEXT inline from HANDLE." - (let ((b (point))) - (insert text) - (mm-handle-set-undisplayer - handle - `(lambda () - (let (buffer-read-only) - (delete-region ,(set-marker (make-marker) b) - ,(set-marker (make-marker) (point)))))))) - -(defun mm-inline-audio (handle) - (message "Not implemented")) - -(defun mm-view-sound-file () - (message "Not implemented")) - -(defun mm-w3-prepare-buffer () - (require 'w3) - (let ((url-standalone-mode t) - (url-gateway-unplugged t) - (w3-honor-stylesheets nil)) - (w3-prepare-buffer))) - -(defun mm-view-message () - (mm-enable-multibyte) - (let (handles) - (let (gnus-article-mime-handles) - ;; Double decode problem may happen. See mm-inline-message. - (run-hooks 'gnus-article-decode-hook) - (gnus-article-prepare-display) - (setq handles gnus-article-mime-handles)) - (when handles - (setq gnus-article-mime-handles - (mm-merge-handles gnus-article-mime-handles handles)))) - (fundamental-mode) - (goto-char (point-min))) - -(defun mm-inline-message (handle) - (let ((b (point)) - (bolp (bolp)) - (charset (mail-content-type-get - (mm-handle-type handle) 'charset)) - gnus-displaying-mime handles) - (when (and charset - (stringp charset)) - (setq charset (intern (downcase charset))) - (when (eq charset 'us-ascii) - (setq charset nil))) - (save-excursion - (save-restriction - (narrow-to-region b b) - (mm-insert-part handle) - (let (gnus-article-mime-handles - ;; disable prepare hook - gnus-article-prepare-hook - (gnus-newsgroup-charset - (unless (eq charset 'gnus-decoded) ;; mm-uu might set it. - (or charset gnus-newsgroup-charset)))) - (let ((gnus-original-article-buffer (mm-handle-buffer handle))) - (run-hooks 'gnus-article-decode-hook)) - (gnus-article-prepare-display) - (setq handles gnus-article-mime-handles)) - (goto-char (point-min)) - (unless bolp - (insert "\n")) - (goto-char (point-max)) - (unless (bolp) - (insert "\n")) - (insert "----------\n\n") - (when handles - (setq gnus-article-mime-handles - (mm-merge-handles gnus-article-mime-handles handles))) - (mm-handle-set-undisplayer - handle - `(lambda () - (let (buffer-read-only) - (if (fboundp 'remove-specifier) - ;; This is only valid on XEmacs. - (mapcar (lambda (prop) - (remove-specifier - (face-property 'default prop) (current-buffer))) - '(background background-pixmap foreground))) - (delete-region ,(point-min-marker) ,(point-max-marker))))))))) - -(defun mm-display-inline-fontify (handle mode) - (let (text) - ;; XEmacs @#$@ version of font-lock refuses to fully turn itself - ;; on for buffers whose name begins with " ". That's why we use - ;; save-current-buffer/get-buffer-create rather than - ;; with-temp-buffer. - (save-current-buffer - (set-buffer (generate-new-buffer "*fontification*")) - (unwind-protect - (progn - (buffer-disable-undo) - (mm-insert-part handle) - (require 'font-lock) - (let ((font-lock-maximum-size nil) - ;; Disable support modes, e.g., jit-lock, lazy-lock, etc. - (font-lock-mode-hook nil) - (font-lock-support-mode nil) - ;; I find font-lock a bit too verbose. - (font-lock-verbose nil)) - (funcall mode) - ;; The mode function might have already turned on font-lock. - (unless (symbol-value 'font-lock-mode) - (font-lock-fontify-buffer))) - ;; By default, XEmacs font-lock uses non-duplicable text - ;; properties. This code forces all the text properties - ;; to be copied along with the text. - (when (fboundp 'extent-list) - (map-extents (lambda (ext ignored) - (set-extent-property ext 'duplicable t) - nil) - nil nil nil nil nil 'text-prop)) - (setq text (buffer-string))) - (kill-buffer (current-buffer)))) - (mm-insert-inline handle text))) - -;; Shouldn't these functions check whether the user even wants to use -;; font-lock? At least under XEmacs, this fontification is pretty -;; much unconditional. Also, it would be nice to change for the size -;; of the fontified region. - -(defun mm-display-patch-inline (handle) - (mm-display-inline-fontify handle 'diff-mode)) - -(defun mm-display-elisp-inline (handle) - (mm-display-inline-fontify handle 'emacs-lisp-mode)) - -;; id-signedData OBJECT IDENTIFIER ::= { iso(1) member-body(2) -;; us(840) rsadsi(113549) pkcs(1) pkcs7(7) 2 } -(defvar mm-pkcs7-signed-magic - (mm-string-as-unibyte - (apply 'concat - (mapcar 'char-to-string - (list ?\x30 ?\x5c ?\x28 ?\x80 ?\x5c ?\x7c ?\x81 ?\x2e ?\x5c - ?\x7c ?\x82 ?\x2e ?\x2e ?\x5c ?\x7c ?\x83 ?\x2e ?\x2e - ?\x2e ?\x5c ?\x29 ?\x06 ?\x09 ?\x5c ?\x2a ?\x86 ?\x48 - ?\x86 ?\xf7 ?\x0d ?\x01 ?\x07 ?\x02))))) - -;; id-envelopedData OBJECT IDENTIFIER ::= { iso(1) member-body(2) -;; us(840) rsadsi(113549) pkcs(1) pkcs7(7) 3 } -(defvar mm-pkcs7-enveloped-magic - (mm-string-as-unibyte - (apply 'concat - (mapcar 'char-to-string - (list ?\x30 ?\x5c ?\x28 ?\x80 ?\x5c ?\x7c ?\x81 ?\x2e ?\x5c - ?\x7c ?\x82 ?\x2e ?\x2e ?\x5c ?\x7c ?\x83 ?\x2e ?\x2e - ?\x2e ?\x5c ?\x29 ?\x06 ?\x09 ?\x5c ?\x2a ?\x86 ?\x48 - ?\x86 ?\xf7 ?\x0d ?\x01 ?\x07 ?\x03))))) - -(defun mm-view-pkcs7-get-type (handle) - (mm-with-unibyte-buffer - (mm-insert-part handle) - (cond ((looking-at mm-pkcs7-enveloped-magic) - 'enveloped) - ((looking-at mm-pkcs7-signed-magic) - 'signed) - (t - (error "Could not identify PKCS#7 type"))))) - -(defun mm-view-pkcs7 (handle) - (case (mm-view-pkcs7-get-type handle) - (enveloped (mm-view-pkcs7-decrypt handle)) - (signed (mm-view-pkcs7-verify handle)) - (otherwise (error "Unknown or unimplemented PKCS#7 type")))) - -(defun mm-view-pkcs7-verify (handle) - ;; A bogus implementation of PKCS#7. FIXME:: - (mm-insert-part handle) - (goto-char (point-min)) - (if (search-forward "Content-Type: " nil t) - (delete-region (point-min) (match-beginning 0))) - (goto-char (point-max)) - (if (re-search-backward "--\r?\n?" nil t) - (delete-region (match-end 0) (point-max))) - (goto-char (point-min)) - (while (search-forward "\r\n" nil t) - (replace-match "\n")) - (message "Verify signed PKCS#7 message is unimplemented.") - (sit-for 1) - t) - -(autoload 'gnus-completing-read-maybe-default "gnus-util" nil nil 'macro) - -(defun mm-view-pkcs7-decrypt (handle) - (insert-buffer-substring (mm-handle-buffer handle)) - (goto-char (point-min)) - (insert "MIME-Version: 1.0\n") - (mm-insert-headers "application/pkcs7-mime" "base64" "smime.p7m") - (smime-decrypt-region - (point-min) (point-max) - (if (= (length smime-keys) 1) - (cadar smime-keys) - (smime-get-key-by-email - (gnus-completing-read-maybe-default - (concat "Decipher using key" - (if smime-keys - (concat " (default " (caar smime-keys) "): ") - ": ")) - smime-keys nil nil nil nil (car-safe (car-safe smime-keys)))))) - (goto-char (point-min)) - (while (search-forward "\r\n" nil t) - (replace-match "\n")) - (goto-char (point-min))) - -(provide 'mm-view) - -;;; arch-tag: b60e749a-d05c-47f2-bccd-bdaa59327cb2 -;;; mm-view.el ends here diff --git a/xemacs-packages/gnus/lisp/mml-sec.el b/xemacs-packages/gnus/lisp/mml-sec.el deleted file mode 100644 index 7845cfda..00000000 --- a/xemacs-packages/gnus/lisp/mml-sec.el +++ /dev/null @@ -1,350 +0,0 @@ -;;; mml-sec.el --- A package with security functions for MML documents - -;; Copyright (C) 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Simon Josefsson - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(require 'mml-smime) -(eval-when-compile (require 'cl)) -(autoload 'mml2015-sign "mml2015") -(autoload 'mml2015-encrypt "mml2015") -(autoload 'mml1991-sign "mml1991") -(autoload 'mml1991-encrypt "mml1991") -(autoload 'message-goto-body "message") -(autoload 'mml-insert-tag "mml") - -(defvar mml-sign-alist - '(("smime" mml-smime-sign-buffer mml-smime-sign-query) - ("pgp" mml-pgp-sign-buffer list) - ("pgpauto" mml-pgpauto-sign-buffer list) - ("pgpmime" mml-pgpmime-sign-buffer list)) - "Alist of MIME signer functions.") - -(defcustom mml-default-sign-method "pgpmime" - "Default sign method. -The string must have an entry in `mml-sign-alist'." - :version "22.1" - :type '(choice (const "smime") - (const "pgp") - (const "pgpauto") - (const "pgpmime") - string) - :group 'message) - -(defvar mml-encrypt-alist - '(("smime" mml-smime-encrypt-buffer mml-smime-encrypt-query) - ("pgp" mml-pgp-encrypt-buffer list) - ("pgpauto" mml-pgpauto-sign-buffer list) - ("pgpmime" mml-pgpmime-encrypt-buffer list)) - "Alist of MIME encryption functions.") - -(defcustom mml-default-encrypt-method "pgpmime" - "Default encryption method. -The string must have an entry in `mml-encrypt-alist'." - :version "22.1" - :type '(choice (const "smime") - (const "pgp") - (const "pgpauto") - (const "pgpmime") - string) - :group 'message) - -(defcustom mml-signencrypt-style-alist - '(("smime" separate) - ("pgp" combined) - ("pgpauto" combined) - ("pgpmime" combined)) - "Alist specifying if `signencrypt' results in two separate operations or not. -The first entry indicates the MML security type, valid entries include -the strings \"smime\", \"pgp\", and \"pgpmime\". The second entry is -a symbol `separate' or `combined' where `separate' means that MML signs -and encrypt messages in a two step process, and `combined' means that MML -signs and encrypt the message in one step. - -Note that the output generated by using a `combined' mode is NOT -understood by all PGP implementations, in particular PGP version -2 does not support it! See Info node `(message)Security' for -details." - :version "22.1" - :group 'message - :type '(repeat (list (choice (const :tag "S/MIME" "smime") - (const :tag "PGP" "pgp") - (const :tag "PGP/MIME" "pgpmime") - (string :tag "User defined")) - (choice (const :tag "Separate" separate) - (const :tag "Combined" combined))))) - -;;; Configuration/helper functions - -(defun mml-signencrypt-style (method &optional style) - "Function for setting/getting the signencrypt-style used. Takes two -arguments, the method (e.g. \"pgp\") and optionally the mode -\(e.g. combined). If the mode is omitted, the current value is returned. - -For example, if you prefer to use combined sign & encrypt with -smime, putting the following in your Gnus startup file will -enable that behavior: - -\(mml-set-signencrypt-style \"smime\" combined) - -You can also customize or set `mml-signencrypt-style-alist' instead." - (let ((style-item (assoc method mml-signencrypt-style-alist))) - (if style-item - (if (or (eq style 'separate) - (eq style 'combined)) - ;; valid style setting? - (setf (second style-item) style) - ;; otherwise, just return the current value - (second style-item)) - (message "Warning, attempt to set invalid signencrypt style")))) - -;;; Security functions - -(defun mml-smime-sign-buffer (cont) - (or (mml-smime-sign cont) - (error "Signing failed... inspect message logs for errors"))) - -(defun mml-smime-encrypt-buffer (cont &optional sign) - (when sign - (message "Combined sign and encrypt S/MIME not support yet") - (sit-for 1)) - (or (mml-smime-encrypt cont) - (error "Encryption failed... inspect message logs for errors"))) - -(defun mml-pgp-sign-buffer (cont) - (or (mml1991-sign cont) - (error "Signing failed... inspect message logs for errors"))) - -(defun mml-pgp-encrypt-buffer (cont &optional sign) - (or (mml1991-encrypt cont sign) - (error "Encryption failed... inspect message logs for errors"))) - -(defun mml-pgpmime-sign-buffer (cont) - (or (mml2015-sign cont) - (error "Signing failed... inspect message logs for errors"))) - -(defun mml-pgpmime-encrypt-buffer (cont &optional sign) - (or (mml2015-encrypt cont sign) - (error "Encryption failed... inspect message logs for errors"))) - -(defun mml-pgpauto-sign-buffer (cont) - (message-goto-body) - (or (if (re-search-backward "Content-Type: *multipart/.*" nil t) ; there must be a better way... - (mml2015-sign cont) - (mml1991-sign cont)) - (error "Encryption failed... inspect message logs for errors"))) - -(defun mml-pgpauto-encrypt-buffer (cont &optional sign) - (message-goto-body) - (or (if (re-search-backward "Content-Type: *multipart/.*" nil t) ; there must be a better way... - (mml2015-encrypt cont sign) - (mml1991-encrypt cont sign)) - (error "Encryption failed... inspect message logs for errors"))) - -(defun mml-secure-part (method &optional sign) - (save-excursion - (let ((tags (funcall (nth 2 (assoc method (if sign mml-sign-alist - mml-encrypt-alist)))))) - (cond ((re-search-backward - "<#\\(multipart\\|part\\|external\\|mml\\)" nil t) - (goto-char (match-end 0)) - (insert (if sign " sign=" " encrypt=") method) - (while tags - (let ((key (pop tags)) - (value (pop tags))) - (when value - ;; Quote VALUE if it contains suspicious characters. - (when (string-match "[\"'\\~/*;() \t\n]" value) - (setq value (prin1-to-string value))) - (insert (format " %s=%s" key value)))))) - ((or (re-search-backward - (concat "^" (regexp-quote mail-header-separator) "\n") nil t) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "\n") nil t)) - (goto-char (match-end 0)) - (apply 'mml-insert-tag 'part (cons (if sign 'sign 'encrypt) - (cons method tags)))) - (t (error "The message is corrupted. No mail header separator")))))) - -(defvar mml-secure-method - (if (equal mml-default-encrypt-method mml-default-sign-method) - mml-default-sign-method - "pgpmime") - "Current security method. Internal variable.") - -(defun mml-secure-sign (&optional method) - "Add MML tags to sign this MML part. -Use METHOD if given. Else use `mml-secure-method' or -`mml-default-sign-method'." - (interactive) - (mml-secure-part - (or method mml-secure-method mml-default-sign-method) - 'sign)) - -(defun mml-secure-encrypt (&optional method) - "Add MML tags to encrypt this MML part. -Use METHOD if given. Else use `mml-secure-method' or -`mml-default-sign-method'." - (interactive) - (mml-secure-part - (or method mml-secure-method mml-default-sign-method))) - -(defun mml-secure-sign-pgp () - "Add MML tags to PGP sign this MML part." - (interactive) - (mml-secure-part "pgp" 'sign)) - -(defun mml-secure-sign-pgpauto () - "Add MML tags to PGP-auto sign this MML part." - (interactive) - (mml-secure-part "pgpauto" 'sign)) - -(defun mml-secure-sign-pgpmime () - "Add MML tags to PGP/MIME sign this MML part." - (interactive) - (mml-secure-part "pgpmime" 'sign)) - -(defun mml-secure-sign-smime () - "Add MML tags to S/MIME sign this MML part." - (interactive) - (mml-secure-part "smime" 'sign)) - -(defun mml-secure-encrypt-pgp () - "Add MML tags to PGP encrypt this MML part." - (interactive) - (mml-secure-part "pgp")) - -(defun mml-secure-encrypt-pgpmime () - "Add MML tags to PGP/MIME encrypt this MML part." - (interactive) - (mml-secure-part "pgpmime")) - -(defun mml-secure-encrypt-smime () - "Add MML tags to S/MIME encrypt this MML part." - (interactive) - (mml-secure-part "smime")) - -;; defuns that add the proper <#secure ...> tag to the top of the message body -(defun mml-secure-message (method &optional modesym) - (let ((mode (prin1-to-string modesym)) - insert-loc) - (mml-unsecure-message) - (save-excursion - (goto-char (point-min)) - (cond ((re-search-forward - (concat "^" (regexp-quote mail-header-separator) "\n") nil t) - (goto-char (setq insert-loc (match-end 0))) - (unless (looking-at "<#secure") - (mml-insert-tag - 'secure 'method method 'mode mode))) - (t (error - "The message is corrupted. No mail header separator")))) - (when (eql insert-loc (point)) - (forward-line 1)))) - -(defun mml-unsecure-message () - "Remove security related MML tags from message." - (interactive) - (save-excursion - (goto-char (point-max)) - (when (re-search-backward "^<#secure.*>\n" nil t) - (delete-region (match-beginning 0) (match-end 0))))) - - -(defun mml-secure-message-sign (&optional method) - "Add MML tags to sign this MML part. -Use METHOD if given. Else use `mml-secure-method' or -`mml-default-sign-method'." - (interactive) - (mml-secure-part - (or method mml-secure-method mml-default-sign-method) - 'sign)) - -(defun mml-secure-message-sign-encrypt (&optional method) - "Add MML tag to sign and encrypt the entire message. -Use METHOD if given. Else use `mml-secure-method' or -`mml-default-sign-method'." - (interactive) - (mml-secure-message - (or method mml-secure-method mml-default-sign-method) - 'signencrypt)) - -(defun mml-secure-message-encrypt (&optional method) - "Add MML tag to encrypt the entire message. -Use METHOD if given. Else use `mml-secure-method' or -`mml-default-sign-method'." - (interactive) - (mml-secure-message - (or method mml-secure-method mml-default-sign-method) - 'encrypt)) - -(defun mml-secure-message-sign-smime () - "Add MML tag to encrypt/sign the entire message." - (interactive) - (mml-secure-message "smime" 'sign)) - -(defun mml-secure-message-sign-pgp () - "Add MML tag to encrypt/sign the entire message." - (interactive) - (mml-secure-message "pgp" 'sign)) - -(defun mml-secure-message-sign-pgpmime () - "Add MML tag to encrypt/sign the entire message." - (interactive) - (mml-secure-message "pgpmime" 'sign)) - -(defun mml-secure-message-sign-pgpauto () - "Add MML tag to encrypt/sign the entire message." - (interactive) - (mml-secure-message "pgpauto" 'sign)) - -(defun mml-secure-message-encrypt-smime (&optional dontsign) - "Add MML tag to encrypt and sign the entire message. -If called with a prefix argument, only encrypt (do NOT sign)." - (interactive "P") - (mml-secure-message "smime" (if dontsign 'encrypt 'signencrypt))) - -(defun mml-secure-message-encrypt-pgp (&optional dontsign) - "Add MML tag to encrypt and sign the entire message. -If called with a prefix argument, only encrypt (do NOT sign)." - (interactive "P") - (mml-secure-message "pgp" (if dontsign 'encrypt 'signencrypt))) - -(defun mml-secure-message-encrypt-pgpmime (&optional dontsign) - "Add MML tag to encrypt and sign the entire message. -If called with a prefix argument, only encrypt (do NOT sign)." - (interactive "P") - (mml-secure-message "pgpmime" (if dontsign 'encrypt 'signencrypt))) - -(defun mml-secure-message-encrypt-pgpauto (&optional dontsign) - "Add MML tag to encrypt and sign the entire message. -If called with a prefix argument, only encrypt (do NOT sign)." - (interactive "P") - (mml-secure-message "pgpauto" (if dontsign 'encrypt 'signencrypt))) - -(provide 'mml-sec) - -;;; arch-tag: 111c56e7-df5e-4287-87d7-93ed2911ec6c -;;; mml-sec.el ends here diff --git a/xemacs-packages/gnus/lisp/mml-smime.el b/xemacs-packages/gnus/lisp/mml-smime.el deleted file mode 100644 index 05cdb1e4..00000000 --- a/xemacs-packages/gnus/lisp/mml-smime.el +++ /dev/null @@ -1,212 +0,0 @@ -;;; mml-smime.el --- S/MIME support for MML - -;; Copyright (C) 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Simon Josefsson -;; Keywords: Gnus, MIME, S/MIME, MML - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published -;; by the Free Software Foundation; either version 3, or (at your -;; option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'smime) -(require 'mm-decode) -(autoload 'message-narrow-to-headers "message") -(autoload 'message-fetch-field "message") - -(defun mml-smime-sign (cont) - (when (null smime-keys) - (customize-variable 'smime-keys) - (error "No S/MIME keys configured, use customize to add your key")) - (smime-sign-buffer (cdr (assq 'keyfile cont))) - (goto-char (point-min)) - (while (search-forward "\r\n" nil t) - (replace-match "\n" t t)) - (goto-char (point-max))) - -(defun mml-smime-encrypt (cont) - (let (certnames certfiles tmp file tmpfiles) - ;; xxx tmp files are always an security issue - (while (setq tmp (pop cont)) - (if (and (consp tmp) (eq (car tmp) 'certfile)) - (push (cdr tmp) certnames))) - (while (setq tmp (pop certnames)) - (if (not (and (not (file-exists-p tmp)) - (get-buffer tmp))) - (push tmp certfiles) - (setq file (mm-make-temp-file (expand-file-name "mml." - mm-tmp-directory))) - (with-current-buffer tmp - (write-region (point-min) (point-max) file)) - (push file certfiles) - (push file tmpfiles))) - (if (smime-encrypt-buffer certfiles) - (progn - (while (setq tmp (pop tmpfiles)) - (delete-file tmp)) - t) - (while (setq tmp (pop tmpfiles)) - (delete-file tmp)) - nil)) - (goto-char (point-max))) - -(defun mml-smime-sign-query () - ;; query information (what certificate) from user when MML tag is - ;; added, for use later by the signing process - (when (null smime-keys) - (customize-variable 'smime-keys) - (error "No S/MIME keys configured, use customize to add your key")) - (list 'keyfile - (if (= (length smime-keys) 1) - (cadar smime-keys) - (or (let ((from (cadr (funcall (if (boundp - 'gnus-extract-address-components) - gnus-extract-address-components - 'mail-extract-address-components) - (or (save-excursion - (save-restriction - (message-narrow-to-headers) - (message-fetch-field "from"))) - ""))))) - (and from (smime-get-key-by-email from))) - (smime-get-key-by-email - (completing-read "Sign this part with what signature? " - smime-keys nil nil - (and (listp (car-safe smime-keys)) - (caar smime-keys)))))))) - -(defun mml-smime-get-file-cert () - (ignore-errors - (list 'certfile (read-file-name - "File with recipient's S/MIME certificate: " - smime-certificate-directory nil t "")))) - -(defun mml-smime-get-dns-cert () - ;; todo: deal with comma separated multiple recipients - (let (result who bad cert) - (condition-case () - (while (not result) - (setq who (read-from-minibuffer - (format "%sLookup certificate for: " (or bad "")) - (cadr (funcall (if (boundp - 'gnus-extract-address-components) - gnus-extract-address-components - 'mail-extract-address-components) - (or (save-excursion - (save-restriction - (message-narrow-to-headers) - (message-fetch-field "to"))) - ""))))) - (if (setq cert (smime-cert-by-dns who)) - (setq result (list 'certfile (buffer-name cert))) - (setq bad (format "`%s' not found. " who)))) - (quit)) - result)) - -(defun mml-smime-encrypt-query () - ;; todo: add ldap support (xemacs ldap api?) - ;; todo: try dns/ldap automatically first, before prompting user - (let (certs done) - (while (not done) - (ecase (read (gnus-completing-read-with-default - "dns" "Fetch certificate from" - '(("dns") ("file")) nil t)) - (dns (setq certs (append certs - (mml-smime-get-dns-cert)))) - (file (setq certs (append certs - (mml-smime-get-file-cert))))) - (setq done (not (y-or-n-p "Add more recipients? ")))) - certs)) - -(defun mml-smime-verify (handle ctl) - (with-temp-buffer - (insert-buffer-substring (mm-handle-multipart-original-buffer ctl)) - (goto-char (point-min)) - (insert (format "Content-Type: %s; " (mm-handle-media-type ctl))) - (insert (format "protocol=\"%s\"; " - (mm-handle-multipart-ctl-parameter ctl 'protocol))) - (insert (format "micalg=\"%s\"; " - (mm-handle-multipart-ctl-parameter ctl 'micalg))) - (insert (format "boundary=\"%s\"\n\n" - (mm-handle-multipart-ctl-parameter ctl 'boundary))) - (when (get-buffer smime-details-buffer) - (kill-buffer smime-details-buffer)) - (let ((buf (current-buffer)) - (good-signature (smime-noverify-buffer)) - (good-certificate (and (or smime-CA-file smime-CA-directory) - (smime-verify-buffer))) - addresses openssl-output) - (setq openssl-output (with-current-buffer smime-details-buffer - (buffer-string))) - (if (not good-signature) - (progn - ;; we couldn't verify message, fail with openssl output as message - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Failed") - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details - (concat "OpenSSL failed to verify message integrity:\n" - "-------------------------------------------\n" - openssl-output))) - ;; verify mail addresses in mail against those in certificate - (when (and (smime-pkcs7-region (point-min) (point-max)) - (smime-pkcs7-certificates-region (point-min) (point-max))) - (with-temp-buffer - (insert-buffer-substring buf) - (goto-char (point-min)) - (while (re-search-forward "-----END CERTIFICATE-----" nil t) - (when (smime-pkcs7-email-region (point-min) (point)) - (setq addresses (append (smime-buffer-as-string-region - (point-min) (point)) addresses))) - (delete-region (point-min) (point))) - (setq addresses (mapcar 'downcase addresses)))) - (if (not (member (downcase (or (mm-handle-multipart-from ctl) "")) addresses)) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Sender address forged") - (if good-certificate - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Ok (sender authenticated)") - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Ok (sender not trusted)"))) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details - (concat "Sender claimed to be: " (mm-handle-multipart-from ctl) "\n" - (if addresses - (concat "Addresses in certificate: " - (mapconcat 'identity addresses ", ")) - "No addresses found in certificate. (Requires OpenSSL 0.9.6 or later.)") - "\n" "\n" - "OpenSSL output:\n" - "---------------\n" openssl-output "\n" - "Certificate(s) inside S/MIME signature:\n" - "---------------------------------------\n" - (buffer-string) "\n"))))) - handle) - -(defun mml-smime-verify-test (handle ctl) - smime-openssl-program) - -(provide 'mml-smime) - -;;; arch-tag: f1bf94d4-f2cd-4c6f-b059-ad69492817e2 -;;; mml-smime.el ends here diff --git a/xemacs-packages/gnus/lisp/mml.el b/xemacs-packages/gnus/lisp/mml.el deleted file mode 100644 index d490a3e6..00000000 --- a/xemacs-packages/gnus/lisp/mml.el +++ /dev/null @@ -1,1343 +0,0 @@ -;;; mml.el --- A package for parsing and validating MML documents - -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(require 'mm-util) -(require 'mm-bodies) -(require 'mm-encode) -(require 'mm-decode) -(require 'mml-sec) -(eval-when-compile (require 'cl)) - -(eval-and-compile - (autoload 'message-make-message-id "message") - (autoload 'gnus-setup-posting-charset "gnus-msg") - (autoload 'gnus-add-minor-mode "gnus-ems") - (autoload 'gnus-make-local-hook "gnus-util") - (autoload 'message-fetch-field "message") - (autoload 'message-info "message") - (autoload 'fill-flowed-encode "flow-fill") - (autoload 'message-posting-charset "message") - (autoload 'dnd-get-local-file-name "dnd")) - -(defvar gnus-article-mime-handles) -(defvar gnus-mouse-2) -(defvar gnus-newsrc-hashtb) -(defvar message-default-charset) -(defvar message-deletable-headers) -(defvar message-options) -(defvar message-posting-charset) -(defvar message-required-mail-headers) -(defvar message-required-news-headers) -(defvar dnd-protocol-alist) - -(defcustom mml-content-type-parameters - '(name access-type expiration size permission format) - "*A list of acceptable parameters in MML tag. -These parameters are generated in Content-Type header if exists." - :version "22.1" - :type '(repeat (symbol :tag "Parameter")) - :group 'message) - -(defcustom mml-content-disposition-parameters - '(filename creation-date modification-date read-date) - "*A list of acceptable parameters in MML tag. -These parameters are generated in Content-Disposition header if exists." - :version "22.1" - :type '(repeat (symbol :tag "Parameter")) - :group 'message) - -(defcustom mml-insert-mime-headers-always nil - "If non-nil, always put Content-Type: text/plain at top of empty parts. -It is necessary to work against a bug in certain clients." - :version "22.1" - :type 'boolean - :group 'message) - -(defvar mml-tweak-type-alist nil - "A list of (TYPE . FUNCTION) for tweaking MML parts. -TYPE is a string containing a regexp to match the MIME type. FUNCTION -is a Lisp function which is called with the MML handle to tweak the -part. This variable is used only when no TWEAK parameter exists in -the MML handle.") - -(defvar mml-tweak-function-alist nil - "A list of (NAME . FUNCTION) for tweaking MML parts. -NAME is a string containing the name of the TWEAK parameter in the MML -handle. FUNCTION is a Lisp function which is called with the MML -handle to tweak the part.") - -(defvar mml-tweak-sexp-alist - '((mml-externalize-attachments . mml-tweak-externalize-attachments)) - "A list of (SEXP . FUNCTION) for tweaking MML parts. -SEXP is an s-expression. If the evaluation of SEXP is non-nil, FUNCTION -is called. FUNCTION is a Lisp function which is called with the MML -handle to tweak the part.") - -(defvar mml-externalize-attachments nil - "*If non-nil, local-file attachments are generated as external parts.") - -(defvar mml-generate-multipart-alist nil - "*Alist of multipart generation functions. -Each entry has the form (NAME . FUNCTION), where -NAME is a string containing the name of the part (without the -leading \"/multipart/\"), -FUNCTION is a Lisp function which is called to generate the part. - -The Lisp function has to supply the appropriate MIME headers and the -contents of this part.") - -(defvar mml-syntax-table - (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table))) - (modify-syntax-entry ?\\ "/" table) - (modify-syntax-entry ?< "(" table) - (modify-syntax-entry ?> ")" table) - (modify-syntax-entry ?@ "w" table) - (modify-syntax-entry ?/ "w" table) - (modify-syntax-entry ?= " " table) - (modify-syntax-entry ?* " " table) - (modify-syntax-entry ?\; " " table) - (modify-syntax-entry ?\' " " table) - table)) - -(defvar mml-boundary-function 'mml-make-boundary - "A function called to suggest a boundary. -The function may be called several times, and should try to make a new -suggestion each time. The function is called with one parameter, -which is a number that says how many times the function has been -called for this message.") - -(defvar mml-confirmation-set nil - "A list of symbols, each of which disables some warning. -`unknown-encoding': always send messages contain characters with -unknown encoding; `use-ascii': always use ASCII for those characters -with unknown encoding; `multipart': always send messages with more than -one charsets.") - -(defvar mml-generate-default-type "text/plain" - "Content type by which the Content-Type header can be omitted. -The Content-Type header will not be put in the MIME part if the type -equals the value and there's no parameter (e.g. charset, format, etc.) -and `mml-insert-mime-headers-always' is nil. The value will be bound -to \"message/rfc822\" when encoding an article to be forwarded as a MIME -part. This is for the internal use, you should never modify the value.") - -(defvar mml-buffer-list nil) - -(defun mml-generate-new-buffer (name) - (let ((buf (generate-new-buffer name))) - (push buf mml-buffer-list) - buf)) - -(defun mml-destroy-buffers () - (let (kill-buffer-hook) - (mapcar 'kill-buffer mml-buffer-list) - (setq mml-buffer-list nil))) - -(defun mml-parse () - "Parse the current buffer as an MML document." - (save-excursion - (goto-char (point-min)) - (let ((table (syntax-table))) - (unwind-protect - (progn - (set-syntax-table mml-syntax-table) - (mml-parse-1)) - (set-syntax-table table))))) - -(defun mml-parse-1 () - "Parse the current buffer as an MML document." - (let (struct tag point contents charsets warn use-ascii no-markup-p raw) - (while (and (not (eobp)) - (not (looking-at "<#/multipart"))) - (cond - ((looking-at "<#secure") - ;; The secure part is essentially a meta-meta tag, which - ;; expands to either a part tag if there are no other parts in - ;; the document or a multipart tag if there are other parts - ;; included in the message - (let* (secure-mode - (taginfo (mml-read-tag)) - (recipients (cdr (assq 'recipients taginfo))) - (sender (cdr (assq 'sender taginfo))) - (location (cdr (assq 'tag-location taginfo))) - (mode (cdr (assq 'mode taginfo))) - (method (cdr (assq 'method taginfo))) - tags) - (save-excursion - (if - (re-search-forward - "<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t) - (setq secure-mode "multipart") - (setq secure-mode "part"))) - (save-excursion - (goto-char location) - (re-search-forward "<#secure[^\n]*>\n")) - (delete-region (match-beginning 0) (match-end 0)) - (cond ((string= mode "sign") - (setq tags (list "sign" method))) - ((string= mode "encrypt") - (setq tags (list "encrypt" method))) - ((string= mode "signencrypt") - (setq tags (list "sign" method "encrypt" method)))) - (eval `(mml-insert-tag ,secure-mode - ,@tags - ,(if recipients "recipients") - ,recipients - ,(if sender "sender") - ,sender)) - ;; restart the parse - (goto-char location))) - ((looking-at "<#multipart") - (push (nconc (mml-read-tag) (mml-parse-1)) struct)) - ((looking-at "<#external") - (push (nconc (mml-read-tag) (list (cons 'contents (mml-read-part)))) - struct)) - (t - (if (or (looking-at "<#part") (looking-at "<#mml")) - (setq tag (mml-read-tag) - no-markup-p nil - warn nil) - (setq tag (list 'part '(type . "text/plain")) - no-markup-p t - warn t)) - (setq raw (cdr (assq 'raw tag)) - point (point) - contents (mml-read-part (eq 'mml (car tag))) - charsets (cond - (raw nil) - ((assq 'charset tag) - (list - (intern (downcase (cdr (assq 'charset tag)))))) - (t - (mm-find-mime-charset-region point (point) - mm-hack-charsets)))) - (when (and (not raw) (memq nil charsets)) - (if (or (memq 'unknown-encoding mml-confirmation-set) - (message-options-get 'unknown-encoding) - (and (y-or-n-p "\ -Message contains characters with unknown encoding. Really send? ") - (message-options-set 'unknown-encoding t))) - (if (setq use-ascii - (or (memq 'use-ascii mml-confirmation-set) - (message-options-get 'use-ascii) - (and (y-or-n-p "Use ASCII as charset? ") - (message-options-set 'use-ascii t)))) - (setq charsets (delq nil charsets)) - (setq warn nil)) - (error "Edit your message to remove those characters"))) - (if (or raw - (eq 'mml (car tag)) - (< (length charsets) 2)) - (if (or (not no-markup-p) - (string-match "[^ \t\r\n]" contents)) - ;; Don't create blank parts. - (push (nconc tag (list (cons 'contents contents))) - struct)) - (let ((nstruct (mml-parse-singlepart-with-multiple-charsets - tag point (point) use-ascii))) - (when (and warn - (not (memq 'multipart mml-confirmation-set)) - (not (message-options-get 'multipart)) - (not (and (y-or-n-p (format "\ -A message part needs to be split into %d charset parts. Really send? " - (length nstruct))) - (message-options-set 'multipart t)))) - (error "Edit your message to use only one charset")) - (setq struct (nconc nstruct struct))))))) - (unless (eobp) - (forward-line 1)) - (nreverse struct))) - -(defun mml-parse-singlepart-with-multiple-charsets - (orig-tag beg end &optional use-ascii) - (save-excursion - (save-restriction - (narrow-to-region beg end) - (goto-char (point-min)) - (let ((current (or (mm-mime-charset (mm-charset-after)) - (and use-ascii 'us-ascii))) - charset struct space newline paragraph) - (while (not (eobp)) - (setq charset (mm-mime-charset (mm-charset-after))) - (cond - ;; The charset remains the same. - ((eq charset 'us-ascii)) - ((or (and use-ascii (not charset)) - (eq charset current)) - (setq space nil - newline nil - paragraph nil)) - ;; The initial charset was ascii. - ((eq current 'us-ascii) - (setq current charset - space nil - newline nil - paragraph nil)) - ;; We have a change in charsets. - (t - (push (append - orig-tag - (list (cons 'contents - (buffer-substring-no-properties - beg (or paragraph newline space (point)))))) - struct) - (setq beg (or paragraph newline space (point)) - current charset - space nil - newline nil - paragraph nil))) - ;; Compute places where it might be nice to break the part. - (cond - ((memq (following-char) '(? ?\t)) - (setq space (1+ (point)))) - ((and (eq (following-char) ?\n) - (not (bobp)) - (eq (char-after (1- (point))) ?\n)) - (setq paragraph (point))) - ((eq (following-char) ?\n) - (setq newline (1+ (point))))) - (forward-char 1)) - ;; Do the final part. - (unless (= beg (point)) - (push (append orig-tag - (list (cons 'contents - (buffer-substring-no-properties - beg (point))))) - struct)) - struct)))) - -(defun mml-read-tag () - "Read a tag and return the contents." - (let ((orig-point (point)) - contents name elem val) - (forward-char 2) - (setq name (buffer-substring-no-properties - (point) (progn (forward-sexp 1) (point)))) - (skip-chars-forward " \t\n") - (while (not (looking-at ">[ \t]*\n?")) - (setq elem (buffer-substring-no-properties - (point) (progn (forward-sexp 1) (point)))) - (skip-chars-forward "= \t\n") - (setq val (buffer-substring-no-properties - (point) (progn (forward-sexp 1) (point)))) - (when (string-match "^\"\\(.*\\)\"$" val) - (setq val (match-string 1 val))) - (push (cons (intern elem) val) contents) - (skip-chars-forward " \t\n")) - (goto-char (match-end 0)) - ;; Don't skip the leading space. - ;;(skip-chars-forward " \t\n") - ;; Put the tag location into the returned contents - (setq contents (append (list (cons 'tag-location orig-point)) contents)) - (cons (intern name) (nreverse contents)))) - -(defun mml-buffer-substring-no-properties-except-hard-newlines (start end) - (let ((str (buffer-substring-no-properties start end)) - (bufstart start) tmp) - (while (setq tmp (text-property-any start end 'hard 't)) - (set-text-properties (- tmp bufstart) (- tmp bufstart -1) - '(hard t) str) - (setq start (1+ tmp))) - str)) - -(defun mml-read-part (&optional mml) - "Return the buffer up till the next part, multipart or closing part or multipart. -If MML is non-nil, return the buffer up till the correspondent mml tag." - (let ((beg (point)) (count 1)) - ;; If the tag ended at the end of the line, we go to the next line. - (when (looking-at "[ \t]*\n") - (forward-line 1)) - (if mml - (progn - (while (and (> count 0) (not (eobp))) - (if (re-search-forward "<#\\(/\\)?mml." nil t) - (setq count (+ count (if (match-beginning 1) -1 1))) - (goto-char (point-max)))) - (mml-buffer-substring-no-properties-except-hard-newlines - beg (if (> count 0) - (point) - (match-beginning 0)))) - (if (re-search-forward - "<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t) - (prog1 - (mml-buffer-substring-no-properties-except-hard-newlines - beg (match-beginning 0)) - (if (or (not (match-beginning 1)) - (equal (match-string 2) "multipart")) - (goto-char (match-beginning 0)) - (when (looking-at "[ \t]*\n") - (forward-line 1)))) - (mml-buffer-substring-no-properties-except-hard-newlines - beg (goto-char (point-max))))))) - -(defvar mml-boundary nil) -(defvar mml-base-boundary "-=-=") -(defvar mml-multipart-number 0) - -(defun mml-generate-mime () - "Generate a MIME message based on the current MML document." - (let ((cont (mml-parse)) - (mml-multipart-number mml-multipart-number)) - (if (not cont) - nil - (mm-with-multibyte-buffer - (if (and (consp (car cont)) - (= (length cont) 1)) - (mml-generate-mime-1 (car cont)) - (mml-generate-mime-1 (nconc (list 'multipart '(type . "mixed")) - cont))) - (buffer-string))))) - -(defun mml-generate-mime-1 (cont) - (let ((mm-use-ultra-safe-encoding - (or mm-use-ultra-safe-encoding (assq 'sign cont)))) - (save-restriction - (narrow-to-region (point) (point)) - (mml-tweak-part cont) - (cond - ((or (eq (car cont) 'part) (eq (car cont) 'mml)) - (let* ((raw (cdr (assq 'raw cont))) - (filename (cdr (assq 'filename cont))) - (type (or (cdr (assq 'type cont)) - (if filename - (or (mm-default-file-encoding filename) - "application/octet-stream") - "text/plain"))) - coded encoding charset flowed) - (if (and (not raw) - (member (car (split-string type "/")) '("text" "message"))) - (progn - (with-temp-buffer - (setq charset (mm-charset-to-coding-system - (cdr (assq 'charset cont)))) - (when (eq charset 'ascii) - (setq charset nil)) - (cond - ((cdr (assq 'buffer cont)) - (insert-buffer-substring (cdr (assq 'buffer cont)))) - ((and filename - (not (equal (cdr (assq 'nofile cont)) "yes"))) - (let ((coding-system-for-read charset)) - (mm-insert-file-contents filename))) - ((eq 'mml (car cont)) - (insert (cdr (assq 'contents cont)))) - (t - (save-restriction - (narrow-to-region (point) (point)) - (insert (cdr (assq 'contents cont))) - ;; Remove quotes from quoted tags. - (goto-char (point-min)) - (while (re-search-forward - "<#!+/?\\(part\\|multipart\\|external\\|mml\\)" - nil t) - (delete-region (+ (match-beginning 0) 2) - (+ (match-beginning 0) 3)))))) - (cond - ((eq (car cont) 'mml) - (let ((mml-boundary (mml-compute-boundary cont)) - ;; It is necessary for the case where this - ;; function is called recursively since - ;; `m-g-d-t' will be bound to "message/rfc822" - ;; when encoding an article to be forwarded. - (mml-generate-default-type "text/plain")) - (mml-to-mime)) - (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b"))) - ;; ignore 0x1b, it is part of iso-2022-jp - (setq encoding (mm-body-7-or-8)))) - ((string= (car (split-string type "/")) "message") - (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b"))) - ;; ignore 0x1b, it is part of iso-2022-jp - (setq encoding (mm-body-7-or-8)))) - (t - ;; Only perform format=flowed filling on text/plain - ;; parts where there either isn't a format parameter - ;; in the mml tag or it says "flowed" and there - ;; actually are hard newlines in the text. - (let (use-hard-newlines) - (when (and (string= type "text/plain") - (not (string= (cdr (assq 'sign cont)) "pgp")) - (or (null (assq 'format cont)) - (string= (cdr (assq 'format cont)) - "flowed")) - (setq use-hard-newlines - (text-property-any - (point-min) (point-max) 'hard 't))) - (fill-flowed-encode) - ;; Indicate that `mml-insert-mime-headers' should - ;; insert a "; format=flowed" string unless the - ;; user has already specified it. - (setq flowed (null (assq 'format cont))))) - (setq charset (mm-encode-body charset)) - (setq encoding (mm-body-encoding - charset (cdr (assq 'encoding cont)))))) - (setq coded (buffer-string))) - (mml-insert-mime-headers cont type charset encoding flowed) - (insert "\n") - (insert coded)) - (mm-with-unibyte-buffer - (cond - ((cdr (assq 'buffer cont)) - (insert (mm-string-as-unibyte - (with-current-buffer (cdr (assq 'buffer cont)) - (buffer-string))))) - ((and filename - (not (equal (cdr (assq 'nofile cont)) "yes"))) - (let ((coding-system-for-read mm-binary-coding-system)) - (mm-insert-file-contents filename nil nil nil nil t))) - (t - (let ((contents (cdr (assq 'contents cont)))) - (if (if (featurep 'xemacs) - (string-match "[^\000-\377]" contents) - (mm-multibyte-string-p contents)) - (progn - (mm-enable-multibyte) - (insert contents) - (unless raw - (setq charset (mm-encode-body)))) - (insert contents))))) - (setq encoding (mm-encode-buffer type) - coded (mm-string-as-multibyte (buffer-string)))) - (mml-insert-mime-headers cont type charset encoding nil) - (insert "\n" coded)))) - ((eq (car cont) 'external) - (insert "Content-Type: message/external-body") - (let ((parameters (mml-parameter-string - cont '(expiration size permission))) - (name (cdr (assq 'name cont))) - (url (cdr (assq 'url cont)))) - (when name - (setq name (mml-parse-file-name name)) - (if (stringp name) - (mml-insert-parameter - (mail-header-encode-parameter "name" name) - "access-type=local-file") - (mml-insert-parameter - (mail-header-encode-parameter - "name" (file-name-nondirectory (nth 2 name))) - (mail-header-encode-parameter "site" (nth 1 name)) - (mail-header-encode-parameter - "directory" (file-name-directory (nth 2 name)))) - (mml-insert-parameter - (concat "access-type=" - (if (member (nth 0 name) '("ftp@" "anonymous@")) - "anon-ftp" - "ftp"))))) - (when url - (mml-insert-parameter - (mail-header-encode-parameter "url" url) - "access-type=url")) - (when parameters - (mml-insert-parameter-string - cont '(expiration size permission))) - (insert "\n\n") - (insert "Content-Type: " - (or (cdr (assq 'type cont)) - (if name - (or (mm-default-file-encoding name) - "application/octet-stream") - "text/plain")) - "\n") - (insert "Content-ID: " (message-make-message-id) "\n") - (insert "Content-Transfer-Encoding: " - (or (cdr (assq 'encoding cont)) "binary")) - (insert "\n\n") - (insert (or (cdr (assq 'contents cont)))) - (insert "\n"))) - ((eq (car cont) 'multipart) - (let* ((type (or (cdr (assq 'type cont)) "mixed")) - (mml-generate-default-type (if (equal type "digest") - "message/rfc822" - "text/plain")) - (handler (assoc type mml-generate-multipart-alist))) - (if handler - (funcall (cdr handler) cont) - ;; No specific handler. Use default one. - (let ((mml-boundary (mml-compute-boundary cont))) - (insert (format "Content-Type: multipart/%s; boundary=\"%s\"" - type mml-boundary) - (if (cdr (assq 'start cont)) - (format "; start=\"%s\"\n" (cdr (assq 'start cont))) - "\n")) - (let ((cont cont) part) - (while (setq part (pop cont)) - ;; Skip `multipart' and attributes. - (when (and (consp part) (consp (cdr part))) - (insert "\n--" mml-boundary "\n") - (mml-generate-mime-1 part) - (goto-char (point-max))))) - (insert "\n--" mml-boundary "--\n"))))) - (t - (error "Invalid element: %S" cont))) - ;; handle sign & encrypt tags in a semi-smart way. - (let ((sign-item (assoc (cdr (assq 'sign cont)) mml-sign-alist)) - (encrypt-item (assoc (cdr (assq 'encrypt cont)) - mml-encrypt-alist)) - sender recipients) - (when (or sign-item encrypt-item) - (when (setq sender (cdr (assq 'sender cont))) - (message-options-set 'mml-sender sender) - (message-options-set 'message-sender sender)) - (if (setq recipients (cdr (assq 'recipients cont))) - (message-options-set 'message-recipients recipients)) - (let ((style (mml-signencrypt-style - (first (or sign-item encrypt-item))))) - ;; check if: we're both signing & encrypting, both methods - ;; are the same (why would they be different?!), and that - ;; the signencrypt style allows for combined operation. - (if (and sign-item encrypt-item (equal (first sign-item) - (first encrypt-item)) - (equal style 'combined)) - (funcall (nth 1 encrypt-item) cont t) - ;; otherwise, revert to the old behavior. - (when sign-item - (funcall (nth 1 sign-item) cont)) - (when encrypt-item - (funcall (nth 1 encrypt-item) cont))))))))) - -(defun mml-compute-boundary (cont) - "Return a unique boundary that does not exist in CONT." - (let ((mml-boundary (funcall mml-boundary-function - (incf mml-multipart-number)))) - ;; This function tries again and again until it has found - ;; a unique boundary. - (while (not (catch 'not-unique - (mml-compute-boundary-1 cont)))) - mml-boundary)) - -(defun mml-compute-boundary-1 (cont) - (let (filename) - (cond - ((eq (car cont) 'part) - (with-temp-buffer - (cond - ((cdr (assq 'buffer cont)) - (insert-buffer-substring (cdr (assq 'buffer cont)))) - ((and (setq filename (cdr (assq 'filename cont))) - (not (equal (cdr (assq 'nofile cont)) "yes"))) - (mm-insert-file-contents filename nil nil nil nil t)) - (t - (insert (cdr (assq 'contents cont))))) - (goto-char (point-min)) - (when (re-search-forward (concat "^--" (regexp-quote mml-boundary)) - nil t) - (setq mml-boundary (funcall mml-boundary-function - (incf mml-multipart-number))) - (throw 'not-unique nil)))) - ((eq (car cont) 'multipart) - (mapcar 'mml-compute-boundary-1 (cddr cont)))) - t)) - -(defun mml-make-boundary (number) - (concat (make-string (% number 60) ?=) - (if (> number 17) - (format "%x" number) - "") - mml-base-boundary)) - -(defun mml-insert-mime-headers (cont type charset encoding flowed) - (let (parameters id disposition description) - (setq parameters - (mml-parameter-string - cont mml-content-type-parameters)) - (when (or charset - parameters - flowed - (not (equal type mml-generate-default-type)) - mml-insert-mime-headers-always) - (when (consp charset) - (error - "Can't encode a part with several charsets")) - (insert "Content-Type: " type) - (when charset - (mml-insert-parameter - (mail-header-encode-parameter "charset" (symbol-name charset)))) - (when flowed - (mml-insert-parameter "format=flowed")) - (when parameters - (mml-insert-parameter-string - cont mml-content-type-parameters)) - (insert "\n")) - (when (setq id (cdr (assq 'id cont))) - (insert "Content-ID: " id "\n")) - (setq parameters - (mml-parameter-string - cont mml-content-disposition-parameters)) - (when (or (setq disposition (cdr (assq 'disposition cont))) - parameters) - (insert "Content-Disposition: " (or disposition "inline")) - (when parameters - (mml-insert-parameter-string - cont mml-content-disposition-parameters)) - (insert "\n")) - (unless (eq encoding '7bit) - (insert (format "Content-Transfer-Encoding: %s\n" encoding))) - (when (setq description (cdr (assq 'description cont))) - (insert "Content-Description: ") - (setq description (prog1 - (point) - (insert description "\n"))) - (mail-encode-encoded-word-region description (point))))) - -(defun mml-parameter-string (cont types) - (let ((string "") - value type) - (while (setq type (pop types)) - (when (setq value (cdr (assq type cont))) - ;; Strip directory component from the filename parameter. - (when (eq type 'filename) - (setq value (file-name-nondirectory value))) - (setq string (concat string "; " - (mail-header-encode-parameter - (symbol-name type) value))))) - (when (not (zerop (length string))) - string))) - -(defun mml-insert-parameter-string (cont types) - (let (value type) - (while (setq type (pop types)) - (when (setq value (cdr (assq type cont))) - ;; Strip directory component from the filename parameter. - (when (eq type 'filename) - (setq value (file-name-nondirectory value))) - (mml-insert-parameter - (mail-header-encode-parameter - (symbol-name type) value)))))) - -(eval-when-compile - (defvar ange-ftp-name-format) - (defvar efs-path-regexp)) -(defun mml-parse-file-name (path) - (if (if (boundp 'efs-path-regexp) - (string-match efs-path-regexp path) - (if (boundp 'ange-ftp-name-format) - (string-match (car ange-ftp-name-format) path))) - (list (match-string 1 path) (match-string 2 path) - (substring path (1+ (match-end 2)))) - path)) - -(defun mml-insert-buffer (buffer) - "Insert BUFFER at point and quote any MML markup." - (save-restriction - (narrow-to-region (point) (point)) - (insert-buffer-substring buffer) - (mml-quote-region (point-min) (point-max)) - (goto-char (point-max)))) - -;;; -;;; Transforming MIME to MML -;;; - -(defun mime-to-mml (&optional handles) - "Translate the current buffer (which should be a message) into MML. -If HANDLES is non-nil, use it instead reparsing the buffer." - ;; First decode the head. - (save-restriction - (message-narrow-to-head) - (let ((rfc2047-quote-decoded-words-containing-tspecials t)) - (mail-decode-encoded-word-region (point-min) (point-max)))) - (unless handles - (setq handles (mm-dissect-buffer t))) - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (delete-region (point) (point-max)) - (if (stringp (car handles)) - (mml-insert-mime handles) - (mml-insert-mime handles t)) - (mm-destroy-parts handles) - (save-restriction - (message-narrow-to-head) - ;; Remove them, they are confusing. - (message-remove-header "Content-Type") - (message-remove-header "MIME-Version") - (message-remove-header "Content-Disposition") - (message-remove-header "Content-Transfer-Encoding"))) - -(defun mml-to-mime () - "Translate the current buffer from MML to MIME." - (message-encode-message-body) - (save-restriction - (message-narrow-to-headers-or-head) - ;; Skip past any From_ headers. - (while (looking-at "From ") - (forward-line 1)) - (let ((mail-parse-charset message-default-charset)) - (mail-encode-encoded-word-buffer)))) - -(defun mml-insert-mime (handle &optional no-markup) - (let (textp buffer mmlp) - ;; Determine type and stuff. - (unless (stringp (car handle)) - (unless (setq textp (equal (mm-handle-media-supertype handle) "text")) - (save-excursion - (set-buffer (setq buffer (mml-generate-new-buffer " *mml*"))) - (mm-insert-part handle 'no-cache) - (if (setq mmlp (equal (mm-handle-media-type handle) - "message/rfc822")) - (mime-to-mml))))) - (if mmlp - (mml-insert-mml-markup handle nil t t) - (unless (and no-markup - (equal (mm-handle-media-type handle) "text/plain")) - (mml-insert-mml-markup handle buffer textp))) - (cond - (mmlp - (insert-buffer-substring buffer) - (goto-char (point-max)) - (insert "<#/mml>\n")) - ((stringp (car handle)) - (mapcar 'mml-insert-mime (cdr handle)) - (insert "<#/multipart>\n")) - (textp - (let ((charset (mail-content-type-get - (mm-handle-type handle) 'charset)) - (start (point))) - (if (eq charset 'gnus-decoded) - (mm-insert-part handle) - (insert (mm-decode-string (mm-get-part handle) charset))) - (mml-quote-region start (point))) - (goto-char (point-max))) - (t - (insert "<#/part>\n"))))) - -(defun mml-insert-mml-markup (handle &optional buffer nofile mmlp) - "Take a MIME handle and insert an MML tag." - (if (stringp (car handle)) - (progn - (insert "<#multipart type=" (mm-handle-media-subtype handle)) - (let ((start (mm-handle-multipart-ctl-parameter handle 'start))) - (when start - (insert " start=\"" start "\""))) - (insert ">\n")) - (if mmlp - (insert "<#mml type=" (mm-handle-media-type handle)) - (insert "<#part type=" (mm-handle-media-type handle))) - (dolist (elem (append (cdr (mm-handle-type handle)) - (cdr (mm-handle-disposition handle)))) - (unless (symbolp (cdr elem)) - (insert " " (symbol-name (car elem)) "=\"" (cdr elem) "\""))) - (when (mm-handle-id handle) - (insert " id=\"" (mm-handle-id handle) "\"")) - (when (mm-handle-disposition handle) - (insert " disposition=" (car (mm-handle-disposition handle)))) - (when buffer - (insert " buffer=\"" (buffer-name buffer) "\"")) - (when nofile - (insert " nofile=yes")) - (when (mm-handle-description handle) - (insert " description=\"" (mm-handle-description handle) "\"")) - (insert ">\n"))) - -(defun mml-insert-parameter (&rest parameters) - "Insert PARAMETERS in a nice way." - (let (start end) - (dolist (param parameters) - (insert ";") - (setq start (point)) - (insert " " param) - (setq end (point)) - (goto-char start) - (end-of-line) - (if (> (current-column) 76) - (progn - (goto-char start) - (insert "\n") - (goto-char (1+ end))) - (goto-char end))))) - -;;; -;;; Mode for inserting and editing MML forms -;;; - -(defvar mml-mode-map - (let ((sign (make-sparse-keymap)) - (encrypt (make-sparse-keymap)) - (signpart (make-sparse-keymap)) - (encryptpart (make-sparse-keymap)) - (map (make-sparse-keymap)) - (main (make-sparse-keymap))) - (define-key map "\C-s" 'mml-secure-message-sign) - (define-key map "\C-c" 'mml-secure-message-encrypt) - (define-key map "\C-e" 'mml-secure-message-sign-encrypt) - (define-key map "\C-p\C-s" 'mml-secure-sign) - (define-key map "\C-p\C-c" 'mml-secure-encrypt) - (define-key sign "p" 'mml-secure-message-sign-pgpmime) - (define-key sign "o" 'mml-secure-message-sign-pgp) - (define-key sign "s" 'mml-secure-message-sign-smime) - (define-key signpart "p" 'mml-secure-sign-pgpmime) - (define-key signpart "o" 'mml-secure-sign-pgp) - (define-key signpart "s" 'mml-secure-sign-smime) - (define-key encrypt "p" 'mml-secure-message-encrypt-pgpmime) - (define-key encrypt "o" 'mml-secure-message-encrypt-pgp) - (define-key encrypt "s" 'mml-secure-message-encrypt-smime) - (define-key encryptpart "p" 'mml-secure-encrypt-pgpmime) - (define-key encryptpart "o" 'mml-secure-encrypt-pgp) - (define-key encryptpart "s" 'mml-secure-encrypt-smime) - (define-key map "\C-n" 'mml-unsecure-message) - (define-key map "f" 'mml-attach-file) - (define-key map "b" 'mml-attach-buffer) - (define-key map "e" 'mml-attach-external) - (define-key map "q" 'mml-quote-region) - (define-key map "m" 'mml-insert-multipart) - (define-key map "p" 'mml-insert-part) - (define-key map "v" 'mml-validate) - (define-key map "P" 'mml-preview) - (define-key map "s" sign) - (define-key map "S" signpart) - (define-key map "c" encrypt) - (define-key map "C" encryptpart) - ;;(define-key map "n" 'mml-narrow-to-part) - ;; `M-m' conflicts with `back-to-indentation'. - ;; (define-key main "\M-m" map) - (define-key main "\C-c\C-m" map) - main)) - -(easy-menu-define - mml-menu mml-mode-map "" - `("Attachments" - ["Attach File..." mml-attach-file - ,@(if (featurep 'xemacs) '(t) - '(:help "Attach a file at point"))] - ["Attach Buffer..." mml-attach-buffer - ,@(if (featurep 'xemacs) '(t) - '(:help "Attach a buffer to the outgoing MIME message"))] - ["Attach External..." mml-attach-external - ,@(if (featurep 'xemacs) '(t) - '(:help "Attach reference to file"))] - ;; - ("Change Security Method" - ["PGP/MIME" - (lambda () (interactive) (setq mml-secure-method "pgpmime")) - ,@(if (featurep 'xemacs) nil - '(:help "Set Security Method to PGP/MIME")) - :style radio - :selected (equal mml-secure-method "pgpmime") ] - ["S/MIME" - (lambda () (interactive) (setq mml-secure-method "smime")) - ,@(if (featurep 'xemacs) nil - '(:help "Set Security Method to S/MIME")) - :style radio - :selected (equal mml-secure-method "smime") ] - ["Inline PGP" - (lambda () (interactive) (setq mml-secure-method "pgp")) - ,@(if (featurep 'xemacs) nil - '(:help "Set Security Method to inline PGP")) - :style radio - :selected (equal mml-secure-method "pgp") ] ) - ;; - ["Sign Message" mml-secure-message-sign t] - ["Encrypt Message" mml-secure-message-encrypt t] - ["Sign and Encrypt Message" mml-secure-message-sign-encrypt t] - ["Encrypt/Sign off" mml-unsecure-message - ,@(if (featurep 'xemacs) '(t) - '(:help "Don't Encrypt/Sign Message"))] - ;; Maybe we could remove these, because people who write MML most probably - ;; don't use the menu: - ["Insert Part..." mml-insert-part - :active (message-in-body-p)] - ["Insert Multipart..." mml-insert-multipart - :active (message-in-body-p)] - ;; - ;; Do we have separate encrypt and encrypt/sign commands for parts? - ["Sign Part" mml-secure-sign t] - ["Encrypt Part" mml-secure-encrypt t] - ;;["Narrow" mml-narrow-to-part t] - ["Quote MML in region" mml-quote-region - :active (message-mark-active-p) - ,@(if (featurep 'xemacs) nil - '(:help "Quote MML tags in region"))] - ["Validate MML" mml-validate t] - ["Preview" mml-preview t] - "----" - ["Emacs MIME manual" (lambda () (interactive) (message-info 4)) - ,@(if (featurep 'xemacs) '(t) - '(:help "Display the Emacs MIME manual"))] - ["PGG manual" (lambda () (interactive) (message-info 16)) - ,@(if (featurep 'xemacs) '(t) - '(:help "Display the PGG manual"))])) - -(defvar mml-mode nil - "Minor mode for editing MML.") - -(defun mml-mode (&optional arg) - "Minor mode for editing MML. -MML is the MIME Meta Language, a minor mode for composing MIME articles. -See Info node `(emacs-mime)Composing'. - -\\{mml-mode-map}" - (interactive "P") - (when (set (make-local-variable 'mml-mode) - (if (null arg) (not mml-mode) - (> (prefix-numeric-value arg) 0))) - (add-minor-mode 'mml-mode " MML" mml-mode-map) - (easy-menu-add mml-menu mml-mode-map) - (when (boundp 'dnd-protocol-alist) - (set (make-local-variable 'dnd-protocol-alist) - (append mml-dnd-protocol-alist dnd-protocol-alist))) - (run-hooks 'mml-mode-hook))) - -;;; -;;; Helper functions for reading MIME stuff from the minibuffer and -;;; inserting stuff to the buffer. -;;; - -(defun mml-minibuffer-read-file (prompt) - (let* ((completion-ignored-extensions nil) - (file (read-file-name prompt nil nil t))) - ;; Prevent some common errors. This is inspired by similar code in - ;; VM. - (when (file-directory-p file) - (error "%s is a directory, cannot attach" file)) - (unless (file-exists-p file) - (error "No such file: %s" file)) - (unless (file-readable-p file) - (error "Permission denied: %s" file)) - file)) - -(defun mml-minibuffer-read-type (name &optional default) - (mailcap-parse-mimetypes) - (let* ((default (or default - (mm-default-file-encoding name) - ;; Perhaps here we should check what the file - ;; looks like, and offer text/plain if it looks - ;; like text/plain. - "application/octet-stream")) - (string (completing-read - (format "Content type (default %s): " default) - (mapcar 'list (mailcap-mime-types))))) - (if (not (equal string "")) - string - default))) - -(defun mml-minibuffer-read-description () - (let ((description (read-string "One line description: "))) - (when (string-match "\\`[ \t]*\\'" description) - (setq description nil)) - description)) - -(defun mml-minibuffer-read-disposition (type &optional default) - (unless default (setq default - (if (and (string-match "\\`text/" type) - (not (string-match "\\`text/rtf\\'" type))) - "inline" - "attachment"))) - (let ((disposition (completing-read - (format "Disposition (default %s): " default) - '(("attachment") ("inline") ("")) - nil t nil nil default))) - (if (not (equal disposition "")) - disposition - default))) - -(defun mml-quote-region (beg end) - "Quote the MML tags in the region." - (interactive "r") - (save-excursion - (save-restriction - ;; Temporarily narrow the region to defend from changes - ;; invalidating END. - (narrow-to-region beg end) - (goto-char (point-min)) - ;; Quote parts. - (while (re-search-forward - "<#!*/?\\(multipart\\|part\\|external\\|mml\\)" nil t) - ;; Insert ! after the #. - (goto-char (+ (match-beginning 0) 2)) - (insert "!"))))) - -(defun mml-insert-tag (name &rest plist) - "Insert an MML tag described by NAME and PLIST." - (when (symbolp name) - (setq name (symbol-name name))) - (insert "<#" name) - (while plist - (let ((key (pop plist)) - (value (pop plist))) - (when value - ;; Quote VALUE if it contains suspicious characters. - (when (string-match "[\"'\\~/*;() \t\n]" value) - (setq value (with-output-to-string - (let (print-escape-nonascii) - (prin1 value))))) - (insert (format " %s=%s" key value))))) - (insert ">\n")) - -(defun mml-insert-empty-tag (name &rest plist) - "Insert an empty MML tag described by NAME and PLIST." - (when (symbolp name) - (setq name (symbol-name name))) - (apply #'mml-insert-tag name plist) - (insert "<#/" name ">\n")) - -;;; Attachment functions. - -(defcustom mml-dnd-protocol-alist - '(("^file:///" . mml-dnd-attach-file) - ("^file://" . dnd-open-file) - ("^file:" . mml-dnd-attach-file)) - "The functions to call when a drop in `mml-mode' is made. -See `dnd-protocol-alist' for more information. When nil, behave -as in other buffers." - :type '(choice (repeat (cons (regexp) (function))) - (const :tag "Behave as in other buffers" nil)) - :version "22.1" ;; Gnus 5.10.9 - :group 'message) - -(defcustom mml-dnd-attach-options nil - "Which options should be queried when attaching a file via drag and drop. - -If it is a list, valid members are `type', `description' and -`disposition'. `disposition' implies `type'. If it is nil, -don't ask for options. If it is t, ask the user whether or not -to specify options." - :type '(choice - (const :tag "Non" nil) - (const :tag "Query" t) - (list :value (type description disposition) - (set :inline t - (const type) - (const description) - (const disposition)))) - :version "22.1" ;; Gnus 5.10.9 - :group 'message) - -(defun mml-attach-file (file &optional type description disposition) - "Attach a file to the outgoing MIME message. -The file is not inserted or encoded until you send the message with -`\\[message-send-and-exit]' or `\\[message-send]'. - -FILE is the name of the file to attach. TYPE is its -content-type, a string of the form \"type/subtype\". DESCRIPTION -is a one-line description of the attachment. The DISPOSITION -specifies how the attachment is intended to be displayed. It can -be either \"inline\" (displayed automatically within the message -body) or \"attachment\" (separate from the body)." - (interactive - (let* ((file (mml-minibuffer-read-file "Attach file: ")) - (type (mml-minibuffer-read-type file)) - (description (mml-minibuffer-read-description)) - (disposition (mml-minibuffer-read-disposition type))) - (list file type description disposition))) - (save-excursion - (unless (message-in-body-p) (goto-char (point-max))) - (mml-insert-empty-tag 'part - 'type type - 'filename file - 'disposition (or disposition "attachment") - 'description description))) - -(defun mml-dnd-attach-file (uri action) - "Attach a drag and drop file. - -Ask for type, description or disposition according to -`mml-dnd-attach-options'." - (let ((file (dnd-get-local-file-name uri t))) - (when (and file (file-regular-p file)) - (let ((mml-dnd-attach-options mml-dnd-attach-options) - type description disposition) - (setq mml-dnd-attach-options - (when (and (eq mml-dnd-attach-options t) - (not - (y-or-n-p - "Use default type, disposition and description? "))) - '(type description disposition))) - (when (or (memq 'type mml-dnd-attach-options) - (memq 'disposition mml-dnd-attach-options)) - (setq type (mml-minibuffer-read-type file))) - (when (memq 'description mml-dnd-attach-options) - (setq description (mml-minibuffer-read-description))) - (when (memq 'disposition mml-dnd-attach-options) - (setq disposition (mml-minibuffer-read-disposition type))) - (mml-attach-file file type description disposition))))) - -(defun mml-attach-buffer (buffer &optional type description) - "Attach a buffer to the outgoing MIME message. -See `mml-attach-file' for details of operation." - (interactive - (let* ((buffer (read-buffer "Attach buffer: ")) - (type (mml-minibuffer-read-type buffer "text/plain")) - (description (mml-minibuffer-read-description))) - (list buffer type description))) - (save-excursion - (unless (message-in-body-p) (goto-char (point-max))) - (mml-insert-empty-tag 'part 'type type 'buffer buffer - 'disposition "attachment" - 'description description))) - -(defun mml-attach-external (file &optional type description) - "Attach an external file into the buffer. -FILE is an ange-ftp/efs specification of the part location. -TYPE is the MIME type to use." - (interactive - (let* ((file (mml-minibuffer-read-file "Attach external file: ")) - (type (mml-minibuffer-read-type file)) - (description (mml-minibuffer-read-description))) - (list file type description))) - (save-excursion - (unless (message-in-body-p) (goto-char (point-max))) - (mml-insert-empty-tag 'external 'type type 'name file - 'disposition "attachment" 'description description))) - -(defun mml-insert-multipart (&optional type) - (interactive (list (completing-read "Multipart type (default mixed): " - '(("mixed") ("alternative") ("digest") ("parallel") - ("signed") ("encrypted")) - nil nil "mixed"))) - (or type - (setq type "mixed")) - (mml-insert-empty-tag "multipart" 'type type) - (forward-line -1)) - -(defun mml-insert-part (&optional type) - (interactive - (list (mml-minibuffer-read-type ""))) - (mml-insert-tag 'part 'type type 'disposition "inline") - (forward-line -1)) - -(defun mml-preview-insert-mail-followup-to () - "Insert a Mail-Followup-To header before previewing an article. -Should be adopted if code in `message-send-mail' is changed." - (when (and (message-mail-p) - (message-subscribed-p) - (not (mail-fetch-field "mail-followup-to")) - (message-make-mail-followup-to)) - (message-position-on-field "Mail-Followup-To" "X-Draft-From") - (insert (message-make-mail-followup-to)))) - -(defun mml-preview (&optional raw) - "Display current buffer with Gnus, in a new buffer. -If RAW, display a raw encoded MIME message." - (interactive "P") - (save-excursion - (let* ((buf (current-buffer)) - (message-options message-options) - (message-this-is-mail (message-mail-p)) - (message-this-is-news (message-news-p)) - (message-posting-charset (or (gnus-setup-posting-charset - (save-restriction - (message-narrow-to-headers-or-head) - (message-fetch-field "Newsgroups"))) - message-posting-charset))) - (message-options-set-recipient) - (pop-to-buffer (generate-new-buffer - (concat (if raw "*Raw MIME preview of " - "*MIME preview of ") (buffer-name)))) - (when (boundp 'gnus-buffers) - (push (current-buffer) gnus-buffers)) - (erase-buffer) - (insert-buffer-substring buf) - (mml-preview-insert-mail-followup-to) - (let ((message-deletable-headers (if (message-news-p) - nil - message-deletable-headers))) - (message-generate-headers - (copy-sequence (if (message-news-p) - message-required-news-headers - message-required-mail-headers)))) - (if (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "\n") nil t) - (replace-match "\n")) - (let ((mail-header-separator ""));; mail-header-separator is removed. - (mml-to-mime)) - (if raw - (when (fboundp 'set-buffer-multibyte) - (let ((s (buffer-string))) - ;; Insert the content into unibyte buffer. - (erase-buffer) - (mm-disable-multibyte) - (insert s))) - (let ((gnus-newsgroup-charset (car message-posting-charset)) - gnus-article-prepare-hook gnus-original-article-buffer) - (run-hooks 'gnus-article-decode-hook) - (let ((gnus-newsgroup-name "dummy") - (gnus-newsrc-hashtb (or gnus-newsrc-hashtb - (gnus-make-hashtable 5)))) - (gnus-article-prepare-display)))) - ;; Disable article-mode-map. - (use-local-map nil) - (gnus-make-local-hook 'kill-buffer-hook) - (add-hook 'kill-buffer-hook - (lambda () - (mm-destroy-parts gnus-article-mime-handles)) nil t) - (setq buffer-read-only t) - (local-set-key "q" (lambda () (interactive) (kill-buffer nil))) - (local-set-key "=" (lambda () (interactive) (delete-other-windows))) - (local-set-key "\r" - (lambda () - (interactive) - (widget-button-press (point)))) - (local-set-key gnus-mouse-2 - (lambda (event) - (interactive "@e") - (widget-button-press (widget-event-point event) event))) - (goto-char (point-min))))) - -(defun mml-validate () - "Validate the current MML document." - (interactive) - (mml-parse)) - -(defun mml-tweak-part (cont) - "Tweak a MML part." - (let ((tweak (cdr (assq 'tweak cont))) - func) - (cond - (tweak - (setq func - (or (cdr (assoc tweak mml-tweak-function-alist)) - (intern tweak)))) - (mml-tweak-type-alist - (let ((alist mml-tweak-type-alist) - (type (or (cdr (assq 'type cont)) "text/plain"))) - (while alist - (if (string-match (caar alist) type) - (setq func (cdar alist) - alist nil) - (setq alist (cdr alist))))))) - (if func - (funcall func cont) - cont) - (let ((alist mml-tweak-sexp-alist)) - (while alist - (if (eval (caar alist)) - (funcall (cdar alist) cont)) - (setq alist (cdr alist))))) - cont) - -(defun mml-tweak-externalize-attachments (cont) - "Tweak attached files as external parts." - (let (filename-cons) - (when (and (eq (car cont) 'part) - (not (cdr (assq 'buffer cont))) - (and (setq filename-cons (assq 'filename cont)) - (not (equal (cdr (assq 'nofile cont)) "yes")))) - (setcar cont 'external) - (setcar filename-cons 'name)))) - -(provide 'mml) - -;;; arch-tag: 583c96cf-1ffe-451b-a5e5-4733ae9ddd12 -;;; mml.el ends here diff --git a/xemacs-packages/gnus/lisp/mml1991.el b/xemacs-packages/gnus/lisp/mml1991.el deleted file mode 100644 index 07a972cd..00000000 --- a/xemacs-packages/gnus/lisp/mml1991.el +++ /dev/null @@ -1,314 +0,0 @@ -;;; mml1991.el --- Old PGP message format (RFC 1991) support for MML - -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Sascha Lüdecke , -;; Simon Josefsson (Mailcrypt interface, Gnus glue) -;; Keywords PGP - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile - (require 'cl) - (require 'mm-util)) - -(defvar mc-pgp-always-sign) - -(autoload 'quoted-printable-decode-region "qp") -(autoload 'quoted-printable-encode-region "qp") - -(defvar mml1991-use mml2015-use - "The package used for PGP.") - -(defvar mml1991-function-alist - '((mailcrypt mml1991-mailcrypt-sign - mml1991-mailcrypt-encrypt) - (gpg mml1991-gpg-sign - mml1991-gpg-encrypt) - (pgg mml1991-pgg-sign - mml1991-pgg-encrypt)) - "Alist of PGP functions.") - -;;; mailcrypt wrapper - -(eval-and-compile - (autoload 'mc-sign-generic "mc-toplev")) - -(defvar mml1991-decrypt-function 'mailcrypt-decrypt) -(defvar mml1991-verify-function 'mailcrypt-verify) - -(defun mml1991-mailcrypt-sign (cont) - (let ((text (current-buffer)) - headers signature - (result-buffer (get-buffer-create "*GPG Result*"))) - ;; Save MIME Content[^ ]+: headers from signing - (goto-char (point-min)) - (while (looking-at "^Content[^ ]+:") (forward-line)) - (unless (bobp) - (setq headers (buffer-string)) - (delete-region (point-min) (point))) - (goto-char (point-max)) - (unless (bolp) - (insert "\n")) - (quoted-printable-decode-region (point-min) (point-max)) - (with-temp-buffer - (setq signature (current-buffer)) - (insert-buffer-substring text) - (unless (mc-sign-generic (message-options-get 'message-sender) - nil nil nil nil) - (unless (> (point-max) (point-min)) - (pop-to-buffer result-buffer) - (error "Sign error"))) - (goto-char (point-min)) - (while (re-search-forward "\r+$" nil t) - (replace-match "" t t)) - (quoted-printable-encode-region (point-min) (point-max)) - (set-buffer text) - (delete-region (point-min) (point-max)) - (if headers (insert headers)) - (insert "\n") - (insert-buffer-substring signature) - (goto-char (point-max))))) - -(defun mml1991-mailcrypt-encrypt (cont &optional sign) - (let ((text (current-buffer)) - (mc-pgp-always-sign - (or mc-pgp-always-sign - sign - (eq t (or (message-options-get 'message-sign-encrypt) - (message-options-set - 'message-sign-encrypt - (or (y-or-n-p "Sign the message? ") - 'not)))) - 'never)) - cipher - (result-buffer (get-buffer-create "*GPG Result*"))) - ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED - (goto-char (point-min)) - (while (looking-at "^Content[^ ]+:") (forward-line)) - (unless (bobp) - (delete-region (point-min) (point))) - (mm-with-unibyte-current-buffer - (with-temp-buffer - (setq cipher (current-buffer)) - (insert-buffer-substring text) - (unless (mc-encrypt-generic - (or - (message-options-get 'message-recipients) - (message-options-set 'message-recipients - (read-string "Recipients: "))) - nil - (point-min) (point-max) - (message-options-get 'message-sender) - 'sign) - (unless (> (point-max) (point-min)) - (pop-to-buffer result-buffer) - (error "Encrypt error"))) - (goto-char (point-min)) - (while (re-search-forward "\r+$" nil t) - (replace-match "" t t)) - (set-buffer text) - (delete-region (point-min) (point-max)) - ;;(insert "Content-Type: application/pgp-encrypted\n\n") - ;;(insert "Version: 1\n\n") - (insert "\n") - (insert-buffer-substring cipher) - (goto-char (point-max)))))) - -;;; gpg wrapper - -(eval-and-compile - (autoload 'gpg-sign-cleartext "gpg")) - -(defun mml1991-gpg-sign (cont) - (let ((text (current-buffer)) - headers signature - (result-buffer (get-buffer-create "*GPG Result*"))) - ;; Save MIME Content[^ ]+: headers from signing - (goto-char (point-min)) - (while (looking-at "^Content[^ ]+:") (forward-line)) - (unless (bobp) - (setq headers (buffer-string)) - (delete-region (point-min) (point))) - (goto-char (point-max)) - (unless (bolp) - (insert "\n")) - (quoted-printable-decode-region (point-min) (point-max)) - (with-temp-buffer - (unless (gpg-sign-cleartext text (setq signature (current-buffer)) - result-buffer - nil - (message-options-get 'message-sender)) - (unless (> (point-max) (point-min)) - (pop-to-buffer result-buffer) - (error "Sign error"))) - (goto-char (point-min)) - (while (re-search-forward "\r+$" nil t) - (replace-match "" t t)) - (quoted-printable-encode-region (point-min) (point-max)) - (set-buffer text) - (delete-region (point-min) (point-max)) - (if headers (insert headers)) - (insert "\n") - (insert-buffer-substring signature) - (goto-char (point-max))))) - -(defun mml1991-gpg-encrypt (cont &optional sign) - (let ((text (current-buffer)) - cipher - (result-buffer (get-buffer-create "*GPG Result*"))) - ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED - (goto-char (point-min)) - (while (looking-at "^Content[^ ]+:") (forward-line)) - (unless (bobp) - (delete-region (point-min) (point))) - (mm-with-unibyte-current-buffer - (with-temp-buffer - (flet ((gpg-encrypt-func - (sign plaintext ciphertext result recipients &optional - passphrase sign-with-key armor textmode) - (if sign - (gpg-sign-encrypt - plaintext ciphertext result recipients passphrase - sign-with-key armor textmode) - (gpg-encrypt - plaintext ciphertext result recipients passphrase - armor textmode)))) - (unless (gpg-encrypt-func - sign - text (setq cipher (current-buffer)) - result-buffer - (split-string - (or - (message-options-get 'message-recipients) - (message-options-set 'message-recipients - (read-string "Recipients: "))) - "[ \f\t\n\r\v,]+") - nil - (message-options-get 'message-sender) - t t) ; armor & textmode - (unless (> (point-max) (point-min)) - (pop-to-buffer result-buffer) - (error "Encrypt error")))) - (goto-char (point-min)) - (while (re-search-forward "\r+$" nil t) - (replace-match "" t t)) - (set-buffer text) - (delete-region (point-min) (point-max)) - ;;(insert "Content-Type: application/pgp-encrypted\n\n") - ;;(insert "Version: 1\n\n") - (insert "\n") - (insert-buffer-substring cipher) - (goto-char (point-max)))))) - -;; pgg wrapper - -(eval-when-compile - (defvar pgg-default-user-id) - (defvar pgg-errors-buffer) - (defvar pgg-output-buffer)) - -(defun mml1991-pgg-sign (cont) - (let ((pgg-text-mode t) - (pgg-default-user-id (or (message-options-get 'mml-sender) - pgg-default-user-id)) - headers cte) - ;; Don't sign headers. - (goto-char (point-min)) - (when (re-search-forward "^$" nil t) - (setq headers (buffer-substring (point-min) (point))) - (save-restriction - (narrow-to-region (point-min) (point)) - (setq cte (mail-fetch-field "content-transfer-encoding"))) - (forward-line 1) - (delete-region (point-min) (point)) - (when cte - (setq cte (intern (downcase cte))) - (mm-decode-content-transfer-encoding cte))) - (unless (pgg-sign-region (point-min) (point-max) t) - (pop-to-buffer pgg-errors-buffer) - (error "Encrypt error")) - (delete-region (point-min) (point-max)) - (mm-with-unibyte-current-buffer - (insert-buffer-substring pgg-output-buffer) - (goto-char (point-min)) - (while (re-search-forward "\r+$" nil t) - (replace-match "" t t)) - (when cte - (mm-encode-content-transfer-encoding cte)) - (goto-char (point-min)) - (when headers - (insert headers)) - (insert "\n")) - t)) - -(defun mml1991-pgg-encrypt (cont &optional sign) - (goto-char (point-min)) - (when (re-search-forward "^$" nil t) - (let ((cte (save-restriction - (narrow-to-region (point-min) (point)) - (mail-fetch-field "content-transfer-encoding")))) - ;; Strip MIME headers since it will be ASCII armoured. - (forward-line 1) - (delete-region (point-min) (point)) - (when cte - (mm-decode-content-transfer-encoding (intern (downcase cte)))))) - (unless (let ((pgg-text-mode t)) - (pgg-encrypt-region - (point-min) (point-max) - (split-string - (or - (message-options-get 'message-recipients) - (message-options-set 'message-recipients - (read-string "Recipients: "))) - "[ \f\t\n\r\v,]+") - sign)) - (pop-to-buffer pgg-errors-buffer) - (error "Encrypt error")) - (delete-region (point-min) (point-max)) - (insert "\n") - (insert-buffer-substring pgg-output-buffer) - t) - -;;;###autoload -(defun mml1991-encrypt (cont &optional sign) - (let ((func (nth 2 (assq mml1991-use mml1991-function-alist)))) - (if func - (funcall func cont sign) - (error "Cannot find encrypt function")))) - -;;;###autoload -(defun mml1991-sign (cont) - (let ((func (nth 1 (assq mml1991-use mml1991-function-alist)))) - (if func - (funcall func cont) - (error "Cannot find sign function")))) - -(provide 'mml1991) - -;; Local Variables: -;; coding: iso-8859-1 -;; End: - -;;; arch-tag: e542be18-ab28-4393-9b33-97fe9cf30706 -;;; mml1991.el ends here diff --git a/xemacs-packages/gnus/lisp/mml2015.el b/xemacs-packages/gnus/lisp/mml2015.el deleted file mode 100644 index 06a46541..00000000 --- a/xemacs-packages/gnus/lisp/mml2015.el +++ /dev/null @@ -1,938 +0,0 @@ -;;; mml2015.el --- MIME Security with Pretty Good Privacy (PGP) - -;; Copyright (C) 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Shenghuo Zhu -;; Keywords: PGP MIME MML - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published -;; by the Free Software Foundation; either version 3, or (at your -;; option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; RFC 2015 is updated by RFC 3156, this file should be compatible -;; with both. - -;;; Code: - -(eval-when-compile (require 'cl)) -(require 'mm-decode) -(require 'mm-util) -(require 'mml) - -(defvar mc-pgp-always-sign) - -(defvar mml2015-use (or - (progn - (ignore-errors - (require 'pgg)) - (and (fboundp 'pgg-sign-region) - 'pgg)) - (progn - (ignore-errors - (require 'gpg)) - (and (fboundp 'gpg-sign-detached) - 'gpg)) - (progn (ignore-errors - (load "mc-toplev")) - (and (fboundp 'mc-encrypt-generic) - (fboundp 'mc-sign-generic) - (fboundp 'mc-cleanup-recipient-headers) - 'mailcrypt))) - "The package used for PGP/MIME.") - -;; Something is not RFC2015. -(defvar mml2015-function-alist - '((mailcrypt mml2015-mailcrypt-sign - mml2015-mailcrypt-encrypt - mml2015-mailcrypt-verify - mml2015-mailcrypt-decrypt - mml2015-mailcrypt-clear-verify - mml2015-mailcrypt-clear-decrypt) - (gpg mml2015-gpg-sign - mml2015-gpg-encrypt - mml2015-gpg-verify - mml2015-gpg-decrypt - mml2015-gpg-clear-verify - mml2015-gpg-clear-decrypt) - (pgg mml2015-pgg-sign - mml2015-pgg-encrypt - mml2015-pgg-verify - mml2015-pgg-decrypt - mml2015-pgg-clear-verify - mml2015-pgg-clear-decrypt)) - "Alist of PGP/MIME functions.") - -(defvar mml2015-result-buffer nil) - -(defcustom mml2015-unabbrev-trust-alist - '(("TRUST_UNDEFINED" . nil) - ("TRUST_NEVER" . nil) - ("TRUST_MARGINAL" . t) - ("TRUST_FULLY" . t) - ("TRUST_ULTIMATE" . t)) - "Map GnuPG trust output values to a boolean saying if you trust the key." - :version "22.1" - :group 'mime-security - :type '(repeat (cons (regexp :tag "GnuPG output regexp") - (boolean :tag "Trust key")))) - -;;; mailcrypt wrapper - -(eval-and-compile - (autoload 'mailcrypt-decrypt "mailcrypt") - (autoload 'mailcrypt-verify "mailcrypt") - (autoload 'mc-pgp-always-sign "mailcrypt") - (autoload 'mc-encrypt-generic "mc-toplev") - (autoload 'mc-cleanup-recipient-headers "mc-toplev") - (autoload 'mc-sign-generic "mc-toplev")) - -(eval-when-compile - (defvar mc-default-scheme) - (defvar mc-schemes)) - -(defvar mml2015-decrypt-function 'mailcrypt-decrypt) -(defvar mml2015-verify-function 'mailcrypt-verify) - -(defun mml2015-format-error (err) - (if (stringp (cadr err)) - (cadr err) - (format "%S" (cdr err)))) - -(defun mml2015-mailcrypt-decrypt (handle ctl) - (catch 'error - (let (child handles result) - (unless (setq child (mm-find-part-by-type - (cdr handle) - "application/octet-stream" nil t)) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Corrupted") - (throw 'error handle)) - (with-temp-buffer - (mm-insert-part child) - (setq result - (condition-case err - (funcall mml2015-decrypt-function) - (error - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details (mml2015-format-error err)) - nil) - (quit - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details "Quit.") - nil))) - (unless (car result) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Failed") - (throw 'error handle)) - (setq handles (mm-dissect-buffer t))) - (mm-destroy-parts handle) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info - (concat "OK" - (let ((sig (with-current-buffer mml2015-result-buffer - (mml2015-gpg-extract-signature-details)))) - (concat ", Signer: " sig)))) - (if (listp (car handles)) - handles - (list handles))))) - -(defun mml2015-mailcrypt-clear-decrypt () - (let (result) - (setq result - (condition-case err - (funcall mml2015-decrypt-function) - (error - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details (mml2015-format-error err)) - nil) - (quit - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details "Quit.") - nil))) - (if (car result) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "OK") - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Failed")))) - -(defun mml2015-fix-micalg (alg) - (and alg - ;; Mutt/1.2.5i has seen sending micalg=php-sha1 - (upcase (if (string-match "^p[gh]p-" alg) - (substring alg (match-end 0)) - alg)))) - -(defun mml2015-mailcrypt-verify (handle ctl) - (catch 'error - (let (part) - (unless (setq part (mm-find-raw-part-by-type - ctl (or (mm-handle-multipart-ctl-parameter - ctl 'protocol) - "application/pgp-signature") - t)) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Corrupted") - (throw 'error handle)) - (with-temp-buffer - (insert "-----BEGIN PGP SIGNED MESSAGE-----\n") - (insert (format "Hash: %s\n\n" - (or (mml2015-fix-micalg - (mm-handle-multipart-ctl-parameter - ctl 'micalg)) - "SHA1"))) - (save-restriction - (narrow-to-region (point) (point)) - (insert part "\n") - (goto-char (point-min)) - (while (not (eobp)) - (if (looking-at "^-") - (insert "- ")) - (forward-line))) - (unless (setq part (mm-find-part-by-type - (cdr handle) "application/pgp-signature" nil t)) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Corrupted") - (throw 'error handle)) - (save-restriction - (narrow-to-region (point) (point)) - (mm-insert-part part) - (goto-char (point-min)) - (if (re-search-forward "^-----BEGIN PGP [^-]+-----\r?$" nil t) - (replace-match "-----BEGIN PGP SIGNATURE-----" t t)) - (if (re-search-forward "^-----END PGP [^-]+-----\r?$" nil t) - (replace-match "-----END PGP SIGNATURE-----" t t))) - (let ((mc-gpg-debug-buffer (get-buffer-create " *gnus gpg debug*"))) - (unless (condition-case err - (prog1 - (funcall mml2015-verify-function) - (if (get-buffer " *mailcrypt stderr temp") - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details - (with-current-buffer " *mailcrypt stderr temp" - (buffer-string)))) - (if (get-buffer " *mailcrypt stdout temp") - (kill-buffer " *mailcrypt stdout temp")) - (if (get-buffer " *mailcrypt stderr temp") - (kill-buffer " *mailcrypt stderr temp")) - (if (get-buffer " *mailcrypt status temp") - (kill-buffer " *mailcrypt status temp")) - (if (get-buffer mc-gpg-debug-buffer) - (kill-buffer mc-gpg-debug-buffer))) - (error - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details (mml2015-format-error err)) - nil) - (quit - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details "Quit.") - nil)) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Failed") - (throw 'error handle)))) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "OK") - handle))) - -(defun mml2015-mailcrypt-clear-verify () - (let ((mc-gpg-debug-buffer (get-buffer-create " *gnus gpg debug*"))) - (if (condition-case err - (prog1 - (funcall mml2015-verify-function) - (if (get-buffer " *mailcrypt stderr temp") - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details - (with-current-buffer " *mailcrypt stderr temp" - (buffer-string)))) - (if (get-buffer " *mailcrypt stdout temp") - (kill-buffer " *mailcrypt stdout temp")) - (if (get-buffer " *mailcrypt stderr temp") - (kill-buffer " *mailcrypt stderr temp")) - (if (get-buffer " *mailcrypt status temp") - (kill-buffer " *mailcrypt status temp")) - (if (get-buffer mc-gpg-debug-buffer) - (kill-buffer mc-gpg-debug-buffer))) - (error - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details (mml2015-format-error err)) - nil) - (quit - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details "Quit.") - nil)) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "OK") - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Failed")))) - -(defun mml2015-mailcrypt-sign (cont) - (mc-sign-generic (message-options-get 'message-sender) - nil nil nil nil) - (let ((boundary (mml-compute-boundary cont)) - hash point) - (goto-char (point-min)) - (unless (re-search-forward "^-----BEGIN PGP SIGNED MESSAGE-----\r?$" nil t) - (error "Cannot find signed begin line")) - (goto-char (match-beginning 0)) - (forward-line 1) - (unless (looking-at "Hash:[ \t]*\\([a-zA-Z0-9]+\\)") - (error "Cannot not find PGP hash")) - (setq hash (match-string 1)) - (unless (re-search-forward "^$" nil t) - (error "Cannot not find PGP message")) - (forward-line 1) - (delete-region (point-min) (point)) - (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n" - boundary)) - (insert (format "\tmicalg=pgp-%s; protocol=\"application/pgp-signature\"\n" - (downcase hash))) - (insert (format "\n--%s\n" boundary)) - (setq point (point)) - (goto-char (point-max)) - (unless (re-search-backward "^-----END PGP SIGNATURE-----\r?$" nil t) - (error "Cannot find signature part")) - (replace-match "-----END PGP MESSAGE-----" t t) - (goto-char (match-beginning 0)) - (unless (re-search-backward "^-----BEGIN PGP SIGNATURE-----\r?$" - nil t) - (error "Cannot find signature part")) - (replace-match "-----BEGIN PGP MESSAGE-----" t t) - (goto-char (match-beginning 0)) - (save-restriction - (narrow-to-region point (point)) - (goto-char point) - (while (re-search-forward "^- -" nil t) - (replace-match "-" t t)) - (goto-char (point-max))) - (insert (format "--%s\n" boundary)) - (insert "Content-Type: application/pgp-signature\n\n") - (goto-char (point-max)) - (insert (format "--%s--\n" boundary)) - (goto-char (point-max)))) - -(defun mml2015-mailcrypt-encrypt (cont &optional sign) - (let ((mc-pgp-always-sign - (or mc-pgp-always-sign - sign - (eq t (or (message-options-get 'message-sign-encrypt) - (message-options-set - 'message-sign-encrypt - (or (y-or-n-p "Sign the message? ") - 'not)))) - 'never))) - (mm-with-unibyte-current-buffer - (mc-encrypt-generic - (or (message-options-get 'message-recipients) - (message-options-set 'message-recipients - (mc-cleanup-recipient-headers - (read-string "Recipients: ")))) - nil nil nil - (message-options-get 'message-sender)))) - (goto-char (point-min)) - (unless (looking-at "-----BEGIN PGP MESSAGE-----") - (error "Fail to encrypt the message")) - (let ((boundary (mml-compute-boundary cont))) - (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n" - boundary)) - (insert "\tprotocol=\"application/pgp-encrypted\"\n\n") - (insert (format "--%s\n" boundary)) - (insert "Content-Type: application/pgp-encrypted\n\n") - (insert "Version: 1\n\n") - (insert (format "--%s\n" boundary)) - (insert "Content-Type: application/octet-stream\n\n") - (goto-char (point-max)) - (insert (format "--%s--\n" boundary)) - (goto-char (point-max)))) - -;;; gpg wrapper - -(eval-and-compile - (autoload 'gpg-decrypt "gpg") - (autoload 'gpg-verify "gpg") - (autoload 'gpg-verify-cleartext "gpg") - (autoload 'gpg-sign-detached "gpg") - (autoload 'gpg-sign-encrypt "gpg") - (autoload 'gpg-encrypt "gpg") - (autoload 'gpg-passphrase-read "gpg")) - -(defun mml2015-gpg-passphrase () - (or (message-options-get 'gpg-passphrase) - (message-options-set 'gpg-passphrase (gpg-passphrase-read)))) - -(defun mml2015-gpg-decrypt-1 () - (let ((cipher (current-buffer)) plain result) - (if (with-temp-buffer - (prog1 - (gpg-decrypt cipher (setq plain (current-buffer)) - mml2015-result-buffer nil) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details - (with-current-buffer mml2015-result-buffer - (buffer-string))) - (set-buffer cipher) - (erase-buffer) - (insert-buffer-substring plain) - (goto-char (point-min)) - (while (search-forward "\r\n" nil t) - (replace-match "\n" t t)))) - '(t) - ;; Some wrong with the return value, check plain text buffer. - (if (> (point-max) (point-min)) - '(t) - nil)))) - -(defun mml2015-gpg-decrypt (handle ctl) - (let ((mml2015-decrypt-function 'mml2015-gpg-decrypt-1)) - (mml2015-mailcrypt-decrypt handle ctl))) - -(defun mml2015-gpg-clear-decrypt () - (let (result) - (setq result (mml2015-gpg-decrypt-1)) - (if (car result) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "OK") - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Failed")))) - -(defun mml2015-gpg-pretty-print-fpr (fingerprint) - (let* ((result "") - (fpr-length (string-width fingerprint)) - (n-slice 0) - slice) - (setq fingerprint (string-to-list fingerprint)) - (while fingerprint - (setq fpr-length (- fpr-length 4)) - (setq slice (butlast fingerprint fpr-length)) - (setq fingerprint (nthcdr 4 fingerprint)) - (setq n-slice (1+ n-slice)) - (setq result - (concat - result - (case n-slice - (1 slice) - (otherwise (concat " " slice)))))) - result)) - -(defun mml2015-gpg-extract-signature-details () - (goto-char (point-min)) - (let* ((expired (re-search-forward - "^\\[GNUPG:\\] SIGEXPIRED$" - nil t)) - (signer (and (re-search-forward - "^\\[GNUPG:\\] GOODSIG \\([0-9A-Za-z]*\\) \\(.*\\)$" - nil t) - (cons (match-string 1) (match-string 2)))) - (fprint (and (re-search-forward - "^\\[GNUPG:\\] VALIDSIG \\([0-9a-zA-Z]*\\) " - nil t) - (match-string 1))) - (trust (and (re-search-forward - "^\\[GNUPG:\\] \\(TRUST_.*\\)$" - nil t) - (match-string 1))) - (trust-good-enough-p - (cdr (assoc trust mml2015-unabbrev-trust-alist)))) - (cond ((and signer fprint) - (concat (cdr signer) - (unless trust-good-enough-p - (concat "\nUntrusted, Fingerprint: " - (mml2015-gpg-pretty-print-fpr fprint))) - (when expired - (format "\nWARNING: Signature from expired key (%s)" - (car signer))))) - ((re-search-forward - "^\\(gpg: \\)?Good signature from \"\\(.*\\)\"$" nil t) - (match-string 2)) - (t - "From unknown user")))) - -(defun mml2015-gpg-verify (handle ctl) - (catch 'error - (let (part message signature info-is-set-p) - (unless (setq part (mm-find-raw-part-by-type - ctl (or (mm-handle-multipart-ctl-parameter - ctl 'protocol) - "application/pgp-signature") - t)) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Corrupted") - (throw 'error handle)) - (with-temp-buffer - (setq message (current-buffer)) - (insert part) - ;; Convert to in verify mode. Sign and - ;; clearsign use --textmode. The conversion is not necessary. - ;; In clearverify, the conversion is not necessary either. - (goto-char (point-min)) - (end-of-line) - (while (not (eobp)) - (unless (eq (char-before) ?\r) - (insert "\r")) - (forward-line) - (end-of-line)) - (with-temp-buffer - (setq signature (current-buffer)) - (unless (setq part (mm-find-part-by-type - (cdr handle) "application/pgp-signature" nil t)) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Corrupted") - (throw 'error handle)) - (mm-insert-part part) - (unless (condition-case err - (prog1 - (gpg-verify message signature mml2015-result-buffer) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details - (with-current-buffer mml2015-result-buffer - (buffer-string)))) - (error - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details (mml2015-format-error err)) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Error.") - (setq info-is-set-p t) - nil) - (quit - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details "Quit.") - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Quit.") - (setq info-is-set-p t) - nil)) - (unless info-is-set-p - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Failed")) - (throw 'error handle))) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info - (with-current-buffer mml2015-result-buffer - (mml2015-gpg-extract-signature-details)))) - handle))) - -(defun mml2015-gpg-clear-verify () - (if (condition-case err - (prog1 - (gpg-verify-cleartext (current-buffer) mml2015-result-buffer) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details - (with-current-buffer mml2015-result-buffer - (buffer-string)))) - (error - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details (mml2015-format-error err)) - nil) - (quit - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details "Quit.") - nil)) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info - (with-current-buffer mml2015-result-buffer - (mml2015-gpg-extract-signature-details))) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Failed"))) - -(defun mml2015-gpg-sign (cont) - (let ((boundary (mml-compute-boundary cont)) - (text (current-buffer)) signature) - (goto-char (point-max)) - (unless (bolp) - (insert "\n")) - (with-temp-buffer - (unless (gpg-sign-detached text (setq signature (current-buffer)) - mml2015-result-buffer - nil - (message-options-get 'message-sender) - t t) ; armor & textmode - (unless (> (point-max) (point-min)) - (pop-to-buffer mml2015-result-buffer) - (error "Sign error"))) - (goto-char (point-min)) - (while (re-search-forward "\r+$" nil t) - (replace-match "" t t)) - (set-buffer text) - (goto-char (point-min)) - (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n" - boundary)) - ;;; FIXME: what is the micalg? - (insert "\tmicalg=pgp-sha1; protocol=\"application/pgp-signature\"\n") - (insert (format "\n--%s\n" boundary)) - (goto-char (point-max)) - (insert (format "\n--%s\n" boundary)) - (insert "Content-Type: application/pgp-signature\n\n") - (insert-buffer-substring signature) - (goto-char (point-max)) - (insert (format "--%s--\n" boundary)) - (goto-char (point-max))))) - -(defun mml2015-gpg-encrypt (cont &optional sign) - (let ((boundary (mml-compute-boundary cont)) - (text (current-buffer)) - cipher) - (mm-with-unibyte-current-buffer - (with-temp-buffer - ;; set up a function to call the correct gpg encrypt routine - ;; with the right arguments. (FIXME: this should be done - ;; differently.) - (flet ((gpg-encrypt-func - (sign plaintext ciphertext result recipients &optional - passphrase sign-with-key armor textmode) - (if sign - (gpg-sign-encrypt - plaintext ciphertext result recipients passphrase - sign-with-key armor textmode) - (gpg-encrypt - plaintext ciphertext result recipients passphrase - armor textmode)))) - (unless (gpg-encrypt-func - sign ; passed in when using signencrypt - text (setq cipher (current-buffer)) - mml2015-result-buffer - (split-string - (or - (message-options-get 'message-recipients) - (message-options-set 'message-recipients - (read-string "Recipients: "))) - "[ \f\t\n\r\v,]+") - nil - (message-options-get 'message-sender) - t t) ; armor & textmode - (unless (> (point-max) (point-min)) - (pop-to-buffer mml2015-result-buffer) - (error "Encrypt error")))) - (goto-char (point-min)) - (while (re-search-forward "\r+$" nil t) - (replace-match "" t t)) - (set-buffer text) - (delete-region (point-min) (point-max)) - (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n" - boundary)) - (insert "\tprotocol=\"application/pgp-encrypted\"\n\n") - (insert (format "--%s\n" boundary)) - (insert "Content-Type: application/pgp-encrypted\n\n") - (insert "Version: 1\n\n") - (insert (format "--%s\n" boundary)) - (insert "Content-Type: application/octet-stream\n\n") - (insert-buffer-substring cipher) - (goto-char (point-max)) - (insert (format "--%s--\n" boundary)) - (goto-char (point-max)))))) - -;;; pgg wrapper - -(eval-when-compile - (defvar pgg-default-user-id) - (defvar pgg-errors-buffer) - (defvar pgg-output-buffer)) - -(eval-and-compile - (autoload 'pgg-decrypt-region "pgg") - (autoload 'pgg-verify-region "pgg") - (autoload 'pgg-sign-region "pgg") - (autoload 'pgg-encrypt-region "pgg") - (autoload 'pgg-parse-armor "pgg-parse")) - -(defun mml2015-pgg-decrypt (handle ctl) - (catch 'error - (let ((pgg-errors-buffer mml2015-result-buffer) - child handles result decrypt-status) - (unless (setq child (mm-find-part-by-type - (cdr handle) - "application/octet-stream" nil t)) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Corrupted") - (throw 'error handle)) - (with-temp-buffer - (mm-insert-part child) - (if (condition-case err - (prog1 - (pgg-decrypt-region (point-min) (point-max)) - (setq decrypt-status - (with-current-buffer mml2015-result-buffer - (buffer-string))) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details - decrypt-status)) - (error - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details (mml2015-format-error err)) - nil) - (quit - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details "Quit.") - nil)) - (with-current-buffer pgg-output-buffer - (goto-char (point-min)) - (while (search-forward "\r\n" nil t) - (replace-match "\n" t t)) - (setq handles (mm-dissect-buffer t)) - (mm-destroy-parts handle) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "OK") - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details - (concat decrypt-status - (when (stringp (car handles)) - "\n" (mm-handle-multipart-ctl-parameter - handles 'gnus-details)))) - (if (listp (car handles)) - handles - (list handles))) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Failed") - (throw 'error handle)))))) - -(defun mml2015-pgg-clear-decrypt () - (let ((pgg-errors-buffer mml2015-result-buffer)) - (if (prog1 - (pgg-decrypt-region (point-min) (point-max)) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details - (with-current-buffer mml2015-result-buffer - (buffer-string)))) - (progn - (erase-buffer) - ;; Treat data which pgg returns as a unibyte string. - (mm-disable-multibyte) - (insert-buffer-substring pgg-output-buffer) - (goto-char (point-min)) - (while (search-forward "\r\n" nil t) - (replace-match "\n" t t)) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "OK")) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Failed")))) - -(defun mml2015-pgg-verify (handle ctl) - (let ((pgg-errors-buffer mml2015-result-buffer) - signature-file part signature) - (if (or (null (setq part (mm-find-raw-part-by-type - ctl (or (mm-handle-multipart-ctl-parameter - ctl 'protocol) - "application/pgp-signature") - t))) - (null (setq signature (mm-find-part-by-type - (cdr handle) "application/pgp-signature" nil t)))) - (progn - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Corrupted") - handle) - (with-temp-buffer - (insert part) - ;; Convert to in verify mode. Sign and - ;; clearsign use --textmode. The conversion is not necessary. - ;; In clearverify, the conversion is not necessary either. - (goto-char (point-min)) - (end-of-line) - (while (not (eobp)) - (unless (eq (char-before) ?\r) - (insert "\r")) - (forward-line) - (end-of-line)) - (with-temp-file (setq signature-file (mm-make-temp-file "pgg")) - (mm-insert-part signature)) - (if (condition-case err - (prog1 - (pgg-verify-region (point-min) (point-max) - signature-file t) - (goto-char (point-min)) - (while (search-forward "\r\n" nil t) - (replace-match "\n" t t)) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details - (concat (with-current-buffer pgg-output-buffer - (buffer-string)) - (with-current-buffer pgg-errors-buffer - (buffer-string))))) - (error - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details (mml2015-format-error err)) - nil) - (quit - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details "Quit.") - nil)) - (progn - (delete-file signature-file) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info - (with-current-buffer pgg-errors-buffer - (mml2015-gpg-extract-signature-details)))) - (delete-file signature-file) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Failed"))))) - handle) - -(defun mml2015-pgg-clear-verify () - (let ((pgg-errors-buffer mml2015-result-buffer) - (text (buffer-string)) - (coding-system buffer-file-coding-system)) - (if (condition-case err - (prog1 - (mm-with-unibyte-buffer - (insert (mm-encode-coding-string text coding-system)) - (pgg-verify-region (point-min) (point-max) nil t)) - (goto-char (point-min)) - (while (search-forward "\r\n" nil t) - (replace-match "\n" t t)) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details - (concat (with-current-buffer pgg-output-buffer - (buffer-string)) - (with-current-buffer pgg-errors-buffer - (buffer-string))))) - (error - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details (mml2015-format-error err)) - nil) - (quit - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details "Quit.") - nil)) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info - (with-current-buffer pgg-errors-buffer - (mml2015-gpg-extract-signature-details))) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Failed")))) - -(defun mml2015-pgg-sign (cont) - (let ((pgg-errors-buffer mml2015-result-buffer) - (boundary (mml-compute-boundary cont)) - (pgg-default-user-id (or (message-options-get 'mml-sender) - pgg-default-user-id)) - (pgg-text-mode t) - entry) - (unless (pgg-sign-region (point-min) (point-max)) - (pop-to-buffer mml2015-result-buffer) - (error "Sign error")) - (goto-char (point-min)) - (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n" - boundary)) - (if (setq entry (assq 2 (pgg-parse-armor - (with-current-buffer pgg-output-buffer - (buffer-string))))) - (setq entry (assq 'hash-algorithm (cdr entry)))) - (insert (format "\tmicalg=%s; " - (if (cdr entry) - (downcase (format "pgp-%s" (cdr entry))) - "pgp-sha1"))) - (insert "protocol=\"application/pgp-signature\"\n") - (insert (format "\n--%s\n" boundary)) - (goto-char (point-max)) - (insert (format "\n--%s\n" boundary)) - (insert "Content-Type: application/pgp-signature\n\n") - (insert-buffer-substring pgg-output-buffer) - (goto-char (point-max)) - (insert (format "--%s--\n" boundary)) - (goto-char (point-max)))) - -(defun mml2015-pgg-encrypt (cont &optional sign) - (let ((pgg-errors-buffer mml2015-result-buffer) - (pgg-text-mode t) - (boundary (mml-compute-boundary cont))) - (unless (pgg-encrypt-region (point-min) (point-max) - (split-string - (or - (message-options-get 'message-recipients) - (message-options-set 'message-recipients - (read-string "Recipients: "))) - "[ \f\t\n\r\v,]+") - sign) - (pop-to-buffer mml2015-result-buffer) - (error "Encrypt error")) - (delete-region (point-min) (point-max)) - (goto-char (point-min)) - (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n" - boundary)) - (insert "\tprotocol=\"application/pgp-encrypted\"\n\n") - (insert (format "--%s\n" boundary)) - (insert "Content-Type: application/pgp-encrypted\n\n") - (insert "Version: 1\n\n") - (insert (format "--%s\n" boundary)) - (insert "Content-Type: application/octet-stream\n\n") - (insert-buffer-substring pgg-output-buffer) - (goto-char (point-max)) - (insert (format "--%s--\n" boundary)) - (goto-char (point-max)))) - -;;; General wrapper - -(defun mml2015-clean-buffer () - (if (gnus-buffer-live-p mml2015-result-buffer) - (with-current-buffer mml2015-result-buffer - (erase-buffer) - t) - (setq mml2015-result-buffer - (gnus-get-buffer-create "*MML2015 Result*")) - nil)) - -(defsubst mml2015-clear-decrypt-function () - (nth 6 (assq mml2015-use mml2015-function-alist))) - -(defsubst mml2015-clear-verify-function () - (nth 5 (assq mml2015-use mml2015-function-alist))) - -;;;###autoload -(defun mml2015-decrypt (handle ctl) - (mml2015-clean-buffer) - (let ((func (nth 4 (assq mml2015-use mml2015-function-alist)))) - (if func - (funcall func handle ctl) - handle))) - -;;;###autoload -(defun mml2015-decrypt-test (handle ctl) - mml2015-use) - -;;;###autoload -(defun mml2015-verify (handle ctl) - (mml2015-clean-buffer) - (let ((func (nth 3 (assq mml2015-use mml2015-function-alist)))) - (if func - (funcall func handle ctl) - handle))) - -;;;###autoload -(defun mml2015-verify-test (handle ctl) - mml2015-use) - -;;;###autoload -(defun mml2015-encrypt (cont &optional sign) - (mml2015-clean-buffer) - (let ((func (nth 2 (assq mml2015-use mml2015-function-alist)))) - (if func - (funcall func cont sign) - (error "Cannot find encrypt function")))) - -;;;###autoload -(defun mml2015-sign (cont) - (mml2015-clean-buffer) - (let ((func (nth 1 (assq mml2015-use mml2015-function-alist)))) - (if func - (funcall func cont) - (error "Cannot find sign function")))) - -;;;###autoload -(defun mml2015-self-encrypt () - (mml2015-encrypt nil)) - -(provide 'mml2015) - -;;; arch-tag: b04701d5-0b09-44d8-bed8-de901bf435f2 -;;; mml2015.el ends here diff --git a/xemacs-packages/gnus/lisp/nnagent.el b/xemacs-packages/gnus/lisp/nnagent.el deleted file mode 100644 index 11390fa2..00000000 --- a/xemacs-packages/gnus/lisp/nnagent.el +++ /dev/null @@ -1,256 +0,0 @@ -;;; nnagent.el --- offline backend for Gnus - -;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news, mail - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(require 'nnheader) -(require 'nnoo) -(eval-when-compile (require 'cl)) -(require 'gnus-agent) -(require 'nnml) - -(nnoo-declare nnagent - nnml) - - - -(defconst nnagent-version "nnagent 1.0") - -(defvoo nnagent-directory nil - "Internal variable." - nnml-directory) - -(defvoo nnagent-active-file nil - "Internal variable." - nnml-active-file) - -(defvoo nnagent-newsgroups-file nil - "Internal variable." - nnml-newsgroups-file) - -(defvoo nnagent-get-new-mail nil - "Internal variable." - nnml-get-new-mail) - -;;; Interface functions. - -(nnoo-define-basics nnagent) - -(defun nnagent-server (server) - (and server (format "%s+%s" (car gnus-command-method) server))) - -(deffoo nnagent-open-server (server &optional defs) - (setq defs - `((nnagent-directory ,(gnus-agent-directory)) - (nnagent-active-file ,(gnus-agent-lib-file "active")) - (nnagent-newsgroups-file ,(gnus-agent-lib-file "newsgroups")) - (nnagent-get-new-mail nil))) - (nnoo-change-server 'nnagent - (nnagent-server server) - defs) - (let ((dir (gnus-agent-directory)) - err) - (cond - ((not (condition-case arg - (file-exists-p dir) - (ftp-error (setq err (format "%s" arg))))) - (nnagent-close-server) - (nnheader-report - 'nnagent (or err - (format "No such file or directory: %s" dir)))) - ((not (file-directory-p (file-truename dir))) - (nnagent-close-server) - (nnheader-report 'nnagent "Not a directory: %s" dir)) - (t - (nnheader-report 'nnagent "Opened server %s using directory %s" - server dir) - t)))) - -(deffoo nnagent-retrieve-groups (groups &optional server) - (save-excursion - (cond - ((file-exists-p (gnus-agent-lib-file "groups")) - (nnmail-find-file (gnus-agent-lib-file "groups")) - 'groups) - ((file-exists-p (gnus-agent-lib-file "active")) - (nnmail-find-file (gnus-agent-lib-file "active")) - 'active) - (t nil)))) - -(defun nnagent-request-type (group article) - (unless (stringp article) - (let ((gnus-agent nil)) - (if (not (gnus-check-backend-function - 'request-type (car gnus-command-method))) - 'unknown - (funcall (gnus-get-function gnus-command-method 'request-type) - (gnus-group-real-name group) article))))) - -(deffoo nnagent-request-newgroups (date server) - nil) - -(deffoo nnagent-request-update-info (group info &optional server) - nil) - -(deffoo nnagent-request-post (&optional server) - (gnus-agent-insert-meta-information 'news gnus-command-method) - (gnus-request-accept-article "nndraft:queue" nil t t)) - -(deffoo nnagent-request-set-mark (group action server) - (with-temp-buffer - (insert "(gnus-agent-synchronize-group-flags \"" - group - "\" '") - (gnus-pp action) - (insert " \"" - (gnus-method-to-server gnus-command-method) - "\"") - (insert ")\n") - (append-to-file (point-min) (point-max) (gnus-agent-lib-file "flags"))) - nil) - -(deffoo nnagent-retrieve-headers (articles &optional group server fetch-old) - (let ((file (gnus-agent-article-name ".overview" group)) - arts n first) - (save-excursion - (gnus-agent-load-alist group) - (setq arts (gnus-sorted-difference - articles (mapcar 'car gnus-agent-article-alist))) - ;; Assume that articles with smaller numbers than the first one - ;; Agent knows are gone. - (setq first (caar gnus-agent-article-alist)) - (when first - (while (and arts (< (car arts) first)) - (pop arts))) - (set-buffer nntp-server-buffer) - (erase-buffer) - (nnheader-insert-nov-file file (car articles)) - (goto-char (point-min)) - (gnus-parse-without-error - (while (and arts (not (eobp))) - (setq n (read (current-buffer))) - (when (> n (car arts)) - (beginning-of-line)) - (while (and arts (> n (car arts))) - (insert (format - "%d\t[Undownloaded article %d]\tGnus Agent\t\t\t\n" - (car arts) (car arts))) - (pop arts)) - (when (and arts (= n (car arts))) - (pop arts)) - (forward-line 1))) - (while arts - (insert (format - "%d\t[Undownloaded article %d]\tGnus Agent\t\t\t\n" - (car arts) (car arts))) - (pop arts)) - (if (and fetch-old - (not (numberp fetch-old))) - t ; Don't remove anything. - (nnheader-nov-delete-outside-range - (if fetch-old (max 1 (- (car articles) fetch-old)) - (car articles)) - (car (last articles))) - t) - 'nov))) - -(deffoo nnagent-request-expire-articles (articles group &optional server force) - articles) - -(deffoo nnagent-request-group (group &optional server dont-check) - (nnoo-parent-function 'nnagent 'nnml-request-group - (list group (nnagent-server server) dont-check))) - -(deffoo nnagent-close-group (group &optional server) - (nnoo-parent-function 'nnagent 'nnml-close-group - (list group (nnagent-server server)))) - -(deffoo nnagent-request-accept-article (group &optional server last) - (nnoo-parent-function 'nnagent 'nnml-request-accept-article - (list group (nnagent-server server) last))) - -(deffoo nnagent-request-article (id &optional group server buffer) - (nnoo-parent-function 'nnagent 'nnml-request-article - (list id group (nnagent-server server) buffer))) - -(deffoo nnagent-request-create-group (group &optional server args) - (nnoo-parent-function 'nnagent 'nnml-request-create-group - (list group (nnagent-server server) args))) - -(deffoo nnagent-request-delete-group (group &optional force server) - (nnoo-parent-function 'nnagent 'nnml-request-delete-group - (list group force (nnagent-server server)))) - -(deffoo nnagent-request-list (&optional server) - (nnoo-parent-function 'nnagent 'nnml-request-list - (list (nnagent-server server)))) - -(deffoo nnagent-request-list-newsgroups (&optional server) - (nnoo-parent-function 'nnagent 'nnml-request-list-newsgroups - (list (nnagent-server server)))) - -(deffoo nnagent-request-move-article - (article group server accept-form &optional last) - (nnoo-parent-function 'nnagent 'nnml-request-move-article - (list article group (nnagent-server server) - accept-form last))) - -(deffoo nnagent-request-rename-group (group new-name &optional server) - (nnoo-parent-function 'nnagent 'nnml-request-rename-group - (list group new-name (nnagent-server server)))) - -(deffoo nnagent-request-scan (&optional group server) - (nnoo-parent-function 'nnagent 'nnml-request-scan - (list group (nnagent-server server)))) - -(deffoo nnagent-set-status (article name value &optional group server) - (nnoo-parent-function 'nnagent 'nnml-set-status - (list article name value group (nnagent-server server)))) - -(deffoo nnagent-server-opened (&optional server) - (nnoo-parent-function 'nnagent 'nnml-server-opened - (list (nnagent-server server)))) - -(deffoo nnagent-status-message (&optional server) - (nnoo-parent-function 'nnagent 'nnml-status-message - (list (nnagent-server server)))) - -(deffoo nnagent-request-regenerate (server) - (nnoo-parent-function 'nnagent 'nnml-request-regenerate - (list (nnagent-server server)))) - -;; Use nnml functions for just about everything. -(nnoo-import nnagent - (nnml)) - - -;;; Internal functions. - -(provide 'nnagent) - -;;; arch-tag: af710b77-f816-4969-af31-6fd94fb42245 -;;; nnagent.el ends here diff --git a/xemacs-packages/gnus/lisp/nnbabyl.el b/xemacs-packages/gnus/lisp/nnbabyl.el deleted file mode 100644 index 04ce7c7e..00000000 --- a/xemacs-packages/gnus/lisp/nnbabyl.el +++ /dev/null @@ -1,672 +0,0 @@ -;;; nnbabyl.el --- rmail mbox access for Gnus - -;; Copyright (C) 1995, 1996, 1997, 1998, 1099, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Masanobu UMEDA -;; Keywords: news, mail - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; For an overview of what the interface functions do, please see the -;; Gnus sources. - -;;; Code: - -(require 'nnheader) -(condition-case nil - (require 'rmail) - (t (nnheader-message - 5 "Ignore rmail errors from this file, you don't have rmail"))) -(require 'nnmail) -(require 'nnoo) -(eval-when-compile (require 'cl)) - -(nnoo-declare nnbabyl) - -(defvoo nnbabyl-mbox-file (expand-file-name "~/RMAIL") - "The name of the rmail box file in the users home directory.") - -(defvoo nnbabyl-active-file (expand-file-name "~/.rmail-active") - "The name of the active file for the rmail box.") - -(defvoo nnbabyl-get-new-mail t - "If non-nil, nnbabyl will check the incoming mail file and split the mail.") - - -(defvoo nnbabyl-prepare-save-mail-hook nil - "Hook run narrowed to an article before saving.") - - - -(defvar nnbabyl-mail-delimiter "\^_") - -(defconst nnbabyl-version "nnbabyl 1.0" - "nnbabyl version.") - -(defvoo nnbabyl-mbox-buffer nil) -(defvoo nnbabyl-current-group nil) -(defvoo nnbabyl-status-string "") -(defvoo nnbabyl-group-alist nil) -(defvoo nnbabyl-active-timestamp nil) - -(defvoo nnbabyl-previous-buffer-mode nil) - -(eval-and-compile - (autoload 'gnus-set-text-properties "gnus-ems")) - - - -;;; Interface functions - -(nnoo-define-basics nnbabyl) - -(deffoo nnbabyl-retrieve-headers (articles &optional group server fetch-old) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (let ((number (length articles)) - (count 0) - (delim (concat "^" nnbabyl-mail-delimiter)) - article art-string start stop) - (nnbabyl-possibly-change-newsgroup group server) - (while (setq article (pop articles)) - (setq art-string (nnbabyl-article-string article)) - (set-buffer nnbabyl-mbox-buffer) - (end-of-line) - (when (or (search-forward art-string nil t) - (search-backward art-string nil t)) - (unless (re-search-backward delim nil t) - (goto-char (point-min))) - (while (and (not (looking-at ".+:")) - (zerop (forward-line 1)))) - (setq start (point)) - (search-forward "\n\n" nil t) - (setq stop (1- (point))) - (set-buffer nntp-server-buffer) - (insert "221 ") - (princ article (current-buffer)) - (insert " Article retrieved.\n") - (insert-buffer-substring nnbabyl-mbox-buffer start stop) - (goto-char (point-max)) - (insert ".\n")) - (and (numberp nnmail-large-newsgroup) - (> number nnmail-large-newsgroup) - (zerop (% (incf count) 20)) - (nnheader-message 5 "nnbabyl: Receiving headers... %d%%" - (/ (* count 100) number)))) - - (and (numberp nnmail-large-newsgroup) - (> number nnmail-large-newsgroup) - (nnheader-message 5 "nnbabyl: Receiving headers...done")) - - (set-buffer nntp-server-buffer) - (nnheader-fold-continuation-lines) - 'headers))) - -(deffoo nnbabyl-open-server (server &optional defs) - (nnoo-change-server 'nnbabyl server defs) - (nnbabyl-create-mbox) - (cond - ((not (file-exists-p nnbabyl-mbox-file)) - (nnbabyl-close-server) - (nnheader-report 'nnbabyl "No such file: %s" nnbabyl-mbox-file)) - ((file-directory-p nnbabyl-mbox-file) - (nnbabyl-close-server) - (nnheader-report 'nnbabyl "Not a regular file: %s" nnbabyl-mbox-file)) - (t - (nnheader-report 'nnbabyl "Opened server %s using mbox %s" server - nnbabyl-mbox-file) - t))) - -(deffoo nnbabyl-close-server (&optional server) - ;; Restore buffer mode. - (when (and (nnbabyl-server-opened) - nnbabyl-previous-buffer-mode) - (save-excursion - (set-buffer nnbabyl-mbox-buffer) - (narrow-to-region - (caar nnbabyl-previous-buffer-mode) - (cdar nnbabyl-previous-buffer-mode)) - (funcall (cdr nnbabyl-previous-buffer-mode)))) - (nnoo-close-server 'nnbabyl server) - (setq nnbabyl-mbox-buffer nil) - t) - -(deffoo nnbabyl-server-opened (&optional server) - (and (nnoo-current-server-p 'nnbabyl server) - nnbabyl-mbox-buffer - (buffer-name nnbabyl-mbox-buffer) - nntp-server-buffer - (buffer-name nntp-server-buffer))) - -(deffoo nnbabyl-request-article (article &optional newsgroup server buffer) - (nnbabyl-possibly-change-newsgroup newsgroup server) - (save-excursion - (set-buffer nnbabyl-mbox-buffer) - (goto-char (point-min)) - (when (search-forward (nnbabyl-article-string article) nil t) - (let (start stop summary-line) - (unless (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t) - (goto-char (point-min)) - (end-of-line)) - (while (and (not (looking-at ".+:")) - (zerop (forward-line 1)))) - (setq start (point)) - (or (when (re-search-forward - (concat "^" nnbabyl-mail-delimiter) nil t) - (beginning-of-line) - t) - (goto-char (point-max))) - (setq stop (point)) - (let ((nntp-server-buffer (or buffer nntp-server-buffer))) - (set-buffer nntp-server-buffer) - (erase-buffer) - (insert-buffer-substring nnbabyl-mbox-buffer start stop) - (goto-char (point-min)) - ;; If there is an EOOH header, then we have to remove some - ;; duplicated headers. - (setq summary-line (looking-at "Summary-line:")) - (when (search-forward "\n*** EOOH ***" nil t) - (if summary-line - ;; The headers to be deleted are located before the - ;; EOOH line... - (delete-region (point-min) (progn (forward-line 1) - (point))) - ;; ...or after. - (delete-region (progn (beginning-of-line) (point)) - (or (search-forward "\n\n" nil t) - (point))))) - (if (numberp article) - (cons nnbabyl-current-group article) - (nnbabyl-article-group-number))))))) - -(deffoo nnbabyl-request-group (group &optional server dont-check) - (let ((active (cadr (assoc group nnbabyl-group-alist)))) - (save-excursion - (cond - ((or (null active) - (null (nnbabyl-possibly-change-newsgroup group server))) - (nnheader-report 'nnbabyl "No such group: %s" group)) - (dont-check - (nnheader-report 'nnbabyl "Selected group %s" group) - (nnheader-insert "")) - (t - (nnheader-report 'nnbabyl "Selected group %s" group) - (nnheader-insert "211 %d %d %d %s\n" - (1+ (- (cdr active) (car active))) - (car active) (cdr active) group)))))) - -(deffoo nnbabyl-request-scan (&optional group server) - (nnbabyl-possibly-change-newsgroup group server) - (nnbabyl-read-mbox) - (nnmail-get-new-mail - 'nnbabyl - (lambda () - (save-excursion - (set-buffer nnbabyl-mbox-buffer) - (save-buffer))) - (file-name-directory nnbabyl-mbox-file) - group - (lambda () - (save-excursion - (let ((in-buf (current-buffer))) - (goto-char (point-min)) - (while (search-forward "\n\^_\n" nil t) - (delete-char -1)) - (set-buffer nnbabyl-mbox-buffer) - (goto-char (point-max)) - (search-backward "\n\^_" nil t) - (goto-char (match-end 0)) - (insert-buffer-substring in-buf))) - (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)))) - -(deffoo nnbabyl-close-group (group &optional server) - t) - -(deffoo nnbabyl-request-create-group (group &optional server args) - (nnmail-activate 'nnbabyl) - (unless (assoc group nnbabyl-group-alist) - (push (list group (cons 1 0)) - nnbabyl-group-alist) - (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)) - t) - -(deffoo nnbabyl-request-list (&optional server) - (save-excursion - (nnmail-find-file nnbabyl-active-file) - (setq nnbabyl-group-alist (nnmail-get-active)) - t)) - -(deffoo nnbabyl-request-newgroups (date &optional server) - (nnbabyl-request-list server)) - -(deffoo nnbabyl-request-list-newsgroups (&optional server) - (nnheader-report 'nnbabyl "nnbabyl: LIST NEWSGROUPS is not implemented.")) - -(deffoo nnbabyl-request-expire-articles - (articles newsgroup &optional server force) - (nnbabyl-possibly-change-newsgroup newsgroup server) - (let* ((is-old t) - rest) - (nnmail-activate 'nnbabyl) - - (save-excursion - (set-buffer nnbabyl-mbox-buffer) - (gnus-set-text-properties (point-min) (point-max) nil) - (while (and articles is-old) - (goto-char (point-min)) - (when (search-forward (nnbabyl-article-string (car articles)) nil t) - (if (setq is-old - (nnmail-expired-article-p - newsgroup - (buffer-substring - (point) (progn (end-of-line) (point))) force)) - (progn - (unless (eq nnmail-expiry-target 'delete) - (with-temp-buffer - (nnbabyl-request-article (car articles) - newsgroup server - (current-buffer)) - (let ((nnml-current-directory nil)) - (nnmail-expiry-target-group - nnmail-expiry-target newsgroup))) - (nnbabyl-possibly-change-newsgroup newsgroup server)) - (nnheader-message 5 "Deleting article %d in %s..." - (car articles) newsgroup) - (nnbabyl-delete-mail)) - (push (car articles) rest))) - (setq articles (cdr articles))) - (save-buffer) - ;; Find the lowest active article in this group. - (let ((active (nth 1 (assoc newsgroup nnbabyl-group-alist)))) - (goto-char (point-min)) - (while (and (not (search-forward - (nnbabyl-article-string (car active)) nil t)) - (<= (car active) (cdr active))) - (setcar active (1+ (car active))) - (goto-char (point-min)))) - (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file) - (nconc rest articles)))) - -(deffoo nnbabyl-request-move-article - (article group server accept-form &optional last) - (let ((buf (get-buffer-create " *nnbabyl move*")) - result) - (and - (nnbabyl-request-article article group server) - (save-excursion - (set-buffer buf) - (insert-buffer-substring nntp-server-buffer) - (goto-char (point-min)) - (while (re-search-forward - "^X-Gnus-Newsgroup:" - (save-excursion (search-forward "\n\n" nil t) (point)) t) - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point)))) - (setq result (eval accept-form)) - (kill-buffer (current-buffer)) - result) - (save-excursion - (nnbabyl-possibly-change-newsgroup group server) - (set-buffer nnbabyl-mbox-buffer) - (goto-char (point-min)) - (if (search-forward (nnbabyl-article-string article) nil t) - (nnbabyl-delete-mail)) - (and last (save-buffer)))) - result)) - -(deffoo nnbabyl-request-accept-article (group &optional server last) - (nnbabyl-possibly-change-newsgroup group server) - (nnmail-check-syntax) - (let ((buf (current-buffer)) - result beg) - (and - (nnmail-activate 'nnbabyl) - (save-excursion - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (forward-line -1) - (save-excursion - (while (re-search-backward "^X-Gnus-Newsgroup: " beg t) - (delete-region (point) (progn (forward-line 1) (point))))) - (when nnmail-cache-accepted-message-ids - (nnmail-cache-insert (nnmail-fetch-field "message-id") - group - (nnmail-fetch-field "subject") - (nnmail-fetch-field "from"))) - (setq result - (if (stringp group) - (list (cons group (nnbabyl-active-number group))) - (nnmail-article-group 'nnbabyl-active-number))) - (if (and (null result) - (yes-or-no-p "Moved to `junk' group; delete article? ")) - (setq result 'junk) - (setq result (car (nnbabyl-save-mail result)))) - (set-buffer nnbabyl-mbox-buffer) - (goto-char (point-max)) - (search-backward "\n\^_") - (goto-char (match-end 0)) - (insert-buffer-substring buf) - (when last - (when nnmail-cache-accepted-message-ids - (nnmail-cache-insert (nnmail-fetch-field "message-id") - group - (nnmail-fetch-field "subject") - (nnmail-fetch-field "from"))) - (save-buffer) - (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)) - result)))) - -(deffoo nnbabyl-request-replace-article (article group buffer) - (nnbabyl-possibly-change-newsgroup group) - (save-excursion - (set-buffer nnbabyl-mbox-buffer) - (goto-char (point-min)) - (if (not (search-forward (nnbabyl-article-string article) nil t)) - nil - (nnbabyl-delete-mail t t) - (insert-buffer-substring buffer) - (save-buffer) - t))) - -(deffoo nnbabyl-request-delete-group (group &optional force server) - (nnbabyl-possibly-change-newsgroup group server) - ;; Delete all articles in GROUP. - (if (not force) - () ; Don't delete the articles. - (save-excursion - (set-buffer nnbabyl-mbox-buffer) - (goto-char (point-min)) - ;; Delete all articles in this group. - (let ((ident (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":")) - found) - (while (search-forward ident nil t) - (setq found t) - (nnbabyl-delete-mail)) - (when found - (save-buffer))))) - ;; Remove the group from all structures. - (setq nnbabyl-group-alist - (delq (assoc group nnbabyl-group-alist) nnbabyl-group-alist) - nnbabyl-current-group nil) - ;; Save the active file. - (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file) - t) - -(deffoo nnbabyl-request-rename-group (group new-name &optional server) - (nnbabyl-possibly-change-newsgroup group server) - (save-excursion - (set-buffer nnbabyl-mbox-buffer) - (goto-char (point-min)) - (let ((ident (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":")) - (new-ident (concat "\nX-Gnus-Newsgroup: " new-name ":")) - found) - (while (search-forward ident nil t) - (replace-match new-ident t t) - (setq found t)) - (when found - (save-buffer)))) - (let ((entry (assoc group nnbabyl-group-alist))) - (and entry (setcar entry new-name)) - (setq nnbabyl-current-group nil) - ;; Save the new group alist. - (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file) - t)) - - -;;; Internal functions. - -;; If FORCE, delete article no matter how many X-Gnus-Newsgroup -;; headers there are. If LEAVE-DELIM, don't delete the Unix mbox -;; delimiter line. -(defun nnbabyl-delete-mail (&optional force leave-delim) - ;; Delete the current X-Gnus-Newsgroup line. - (unless force - (delete-region - (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point)))) - ;; Beginning of the article. - (save-excursion - (save-restriction - (widen) - (narrow-to-region - (save-excursion - (unless (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t) - (goto-char (point-min)) - (end-of-line)) - (if leave-delim (progn (forward-line 1) (point)) - (match-beginning 0))) - (progn - (forward-line 1) - (or (and (re-search-forward (concat "^" nnbabyl-mail-delimiter) - nil t) - (match-beginning 0)) - (point-max)))) - (goto-char (point-min)) - ;; Only delete the article if no other groups owns it as well. - (when (or force (not (re-search-forward "^X-Gnus-Newsgroup: " nil t))) - (delete-region (point-min) (point-max)))))) - -(defun nnbabyl-possibly-change-newsgroup (newsgroup &optional server) - (when (and server - (not (nnbabyl-server-opened server))) - (nnbabyl-open-server server)) - (when (or (not nnbabyl-mbox-buffer) - (not (buffer-name nnbabyl-mbox-buffer))) - (save-excursion (nnbabyl-read-mbox))) - (unless nnbabyl-group-alist - (nnmail-activate 'nnbabyl)) - (if newsgroup - (if (assoc newsgroup nnbabyl-group-alist) - (setq nnbabyl-current-group newsgroup) - (nnheader-report 'nnbabyl "No such group in file")) - t)) - -(defun nnbabyl-article-string (article) - (if (numberp article) - (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":" - (int-to-string article) " ") - (concat "\nMessage-ID: " article))) - -(defun nnbabyl-article-group-number () - (save-excursion - (goto-char (point-min)) - (when (re-search-forward "^X-Gnus-Newsgroup: +\\([^:]+\\):\\([0-9]+\\) " - nil t) - (cons (buffer-substring (match-beginning 1) (match-end 1)) - (string-to-number - (buffer-substring (match-beginning 2) (match-end 2))))))) - -(defun nnbabyl-insert-lines () - "Insert how many lines and chars there are in the body of the mail." - (let (lines chars) - (save-excursion - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - ;; There may be an EOOH line here... - (when (looking-at "\\*\\*\\* EOOH \\*\\*\\*") - (search-forward "\n\n" nil t)) - (setq chars (- (point-max) (point)) - lines (max (- (count-lines (point) (point-max)) 1) 0)) - ;; Move back to the end of the headers. - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (forward-char -1) - (save-excursion - (when (re-search-backward "^Lines: " nil t) - (delete-region (point) (progn (forward-line 1) (point))))) - (insert (format "Lines: %d\n" lines)) - chars)))) - -(defun nnbabyl-save-mail (group-art) - ;; Called narrowed to an article. - (nnbabyl-insert-lines) - (nnmail-insert-xref group-art) - (nnbabyl-insert-newsgroup-line group-art) - (run-hooks 'nnbabyl-prepare-save-mail-hook) - group-art) - -(defun nnbabyl-insert-newsgroup-line (group-art) - (save-excursion - (goto-char (point-min)) - (while (looking-at "From ") - (replace-match "Mail-from: From " t t) - (forward-line 1)) - ;; If there is a C-l at the beginning of the narrowed region, this - ;; isn't really a "save", but rather a "scan". - (goto-char (point-min)) - (unless (looking-at "\^L") - (save-excursion - (insert "\^L\n0, unseen,,\n*** EOOH ***\n") - (goto-char (point-max)) - (insert "\^_\n"))) - (when (search-forward "\n\n" nil t) - (forward-char -1) - (while group-art - (insert (format "X-Gnus-Newsgroup: %s:%d %s\n" - (caar group-art) (cdar group-art) - (current-time-string))) - (setq group-art (cdr group-art)))) - t)) - -(defun nnbabyl-active-number (group) - ;; Find the next article number in GROUP. - (let ((active (cadr (assoc group nnbabyl-group-alist)))) - (if active - (setcdr active (1+ (cdr active))) - ;; This group is new, so we create a new entry for it. - ;; This might be a bit naughty... creating groups on the drop of - ;; a hat, but I don't know... - (push (list group (setq active (cons 1 1))) - nnbabyl-group-alist)) - (cdr active))) - -(defun nnbabyl-create-mbox () - (unless (file-exists-p nnbabyl-mbox-file) - ;; Create a new, empty RMAIL mbox file. - (save-excursion - (set-buffer (setq nnbabyl-mbox-buffer - (create-file-buffer nnbabyl-mbox-file))) - (setq buffer-file-name nnbabyl-mbox-file) - (insert "BABYL OPTIONS:\n\n\^_") - (nnmail-write-region - (point-min) (point-max) nnbabyl-mbox-file t 'nomesg)))) - -(defun nnbabyl-read-mbox () - (nnmail-activate 'nnbabyl) - (nnbabyl-create-mbox) - - (unless (and nnbabyl-mbox-buffer - (buffer-name nnbabyl-mbox-buffer) - (save-excursion - (set-buffer nnbabyl-mbox-buffer) - (= (buffer-size) (nnheader-file-size nnbabyl-mbox-file)))) - ;; This buffer has changed since we read it last. Possibly. - (save-excursion - (let ((delim (concat "^" nnbabyl-mail-delimiter)) - (alist nnbabyl-group-alist) - start end number) - (set-buffer (setq nnbabyl-mbox-buffer - (nnheader-find-file-noselect - nnbabyl-mbox-file nil t))) - ;; Save previous buffer mode. - (setq nnbabyl-previous-buffer-mode - (cons (cons (point-min) (point-max)) - major-mode)) - - (buffer-disable-undo) - (widen) - (setq buffer-read-only nil) - (fundamental-mode) - - ;; Go through the group alist and compare against - ;; the rmail file. - (while alist - (goto-char (point-max)) - (when (and (re-search-backward - (format "^X-Gnus-Newsgroup: %s:\\([0-9]+\\) " - (caar alist)) - nil t) - (> (setq number - (string-to-number - (buffer-substring - (match-beginning 1) (match-end 1)))) - (cdadar alist))) - (setcdr (cadar alist) number)) - (setq alist (cdr alist))) - - ;; We go through the mbox and make sure that each and - ;; every mail belongs to some group or other. - (goto-char (point-min)) - (if (looking-at "\^L") - (setq start (point)) - (re-search-forward delim nil t) - (setq start (match-end 0))) - (while (re-search-forward delim nil t) - (setq end (match-end 0)) - (unless (search-backward "\nX-Gnus-Newsgroup: " start t) - (goto-char end) - (save-excursion - (save-restriction - (narrow-to-region (goto-char start) end) - (nnbabyl-save-mail - (nnmail-article-group 'nnbabyl-active-number)) - (setq end (point-max))))) - (goto-char (setq start end))) - (when (buffer-modified-p (current-buffer)) - (save-buffer)) - (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))))) - -(defun nnbabyl-remove-incoming-delims () - (goto-char (point-min)) - (while (search-forward "\^_" nil t) - (replace-match "?" t t))) - -(defun nnbabyl-check-mbox () - "Go through the nnbabyl mbox and make sure that no article numbers are reused." - (interactive) - (let ((idents (make-vector 1000 0)) - id) - (save-excursion - (when (or (not nnbabyl-mbox-buffer) - (not (buffer-name nnbabyl-mbox-buffer))) - (nnbabyl-read-mbox)) - (set-buffer nnbabyl-mbox-buffer) - (goto-char (point-min)) - (while (re-search-forward "^X-Gnus-Newsgroup: \\([^ ]+\\) " nil t) - (if (intern-soft (setq id (match-string 1)) idents) - (progn - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point))) - (nnheader-message 7 "Moving %s..." id) - (nnbabyl-save-mail - (nnmail-article-group 'nnbabyl-active-number))) - (intern id idents))) - (when (buffer-modified-p (current-buffer)) - (save-buffer)) - (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file) - (nnheader-message 5 "")))) - -(provide 'nnbabyl) - -;;; arch-tag: aa7ddedb-8c07-4c0e-beb0-58e795c2b81b -;;; nnbabyl.el ends here diff --git a/xemacs-packages/gnus/lisp/nndb.el b/xemacs-packages/gnus/lisp/nndb.el deleted file mode 100644 index 03da8ca1..00000000 --- a/xemacs-packages/gnus/lisp/nndb.el +++ /dev/null @@ -1,320 +0,0 @@ -;;; nndb.el --- nndb access for Gnus - -;; Copyright (C) 1997, 1998, 2000, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Masanobu UMEDA -;; Kai Grossjohann -;; Joe Hildebrand -;; David Blacka -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; This was based upon Kai Grossjohan's shamessly snarfed code and -;;; further modified by Joe Hildebrand. It has been updated for Red -;;; Gnus. - -;; TODO: -;; -;; * Fix bug where server connection can be lost and impossible to regain -;; This hasn't happened to me in a while; think it was fixed in Rgnus -;; -;; * make it handle different nndb servers seemlessly -;; -;; * Optimize expire if FORCE -;; -;; * Optimize move (only expire once) -;; -;; * Deal with add/deletion of groups -;; -;; * make the backend TOUCH an article when marked as expireable (will -;; make article expire 'expiry' days after that moment). - -;;- -;; Register nndb with known select methods. - -(require 'gnus-start) -(unless (assoc "nndb" gnus-valid-select-methods) - (gnus-declare-backend "nndb" 'mail 'respool 'address 'prompt-address)) - -;;; Code: - -(require 'nnmail) -(require 'nnheader) -(require 'nntp) -(eval-when-compile (require 'cl)) - -;; Declare nndb as derived from nntp - -(nnoo-declare nndb nntp) - -;; Variables specific to nndb - -;;- currently not used but just in case... -(defvoo nndb-deliver-program "nndel" - "*The program used to put a message in an NNDB group.") - -(defvoo nndb-server-side-expiry nil - "If t, expiry calculation will occur on the server side.") - -(defvoo nndb-set-expire-date-on-mark nil - "If t, the expiry date for a given article will be set to the time -it was marked as expireable; otherwise the date will be the time the -article was posted to nndb") - -;; Variables copied from nntp - -(defvoo nndb-server-opened-hook '(nntp-send-authinfo-from-file) - "Like nntp-server-opened-hook." - nntp-server-opened-hook) - -(defvoo nndb-address "localhost" - "*The name of the NNDB server." - nntp-address) - -(defvoo nndb-port-number 9000 - "*Port number to connect to." - nntp-port-number) - -;; change to 'news if you are actually using nndb for news -(defvoo nndb-article-type 'mail) - -(defvoo nndb-status-string nil "" nntp-status-string) - - - -(defconst nndb-version "nndb 0.7" - "Version numbers of this version of NNDB.") - - -;;; Interface functions. - -(nnoo-define-basics nndb) - -;;------------------------------------------------------------------ - -;; this function turns the lisp list into a string list. There is -;; probably a more efficient way to do this. -(defun nndb-build-article-string (articles) - (let (art-string art) - (while articles - (setq art (pop articles)) - (setq art-string (concat art-string art " "))) - art-string)) - -(defun nndb-build-expire-rest-list (total expire) - (let (art rest) - (while total - (setq art (pop total)) - (if (memq art expire) - () - (push art rest))) - rest)) - - -;; -(deffoo nndb-request-type (group &optional article) - nndb-article-type) - -;; nndb-request-update-info does not exist and is not needed - -;; nndb-request-update-mark does not exist; it should be used to TOUCH -;; articles as they are marked exipirable -(defun nndb-touch-article (group article) - (nntp-send-command nil "X-TOUCH" article)) - -(deffoo nndb-request-update-mark - (group article mark) - "Sets the expiry date for ARTICLE in GROUP to now, if the mark is 'E'" - (if (and nndb-set-expire-date-on-mark (string-equal mark "E")) - (nndb-touch-article group article)) - mark) - -;; nndb-request-create-group -- currently this isn't necessary; nndb -;; creates groups on demand. - -;; todo -- use some other time than the creation time of the article -;; best is time since article has been marked as expirable - -(defun nndb-request-expire-articles-local - (articles &optional group server force) - "Let gnus do the date check and issue the delete commands." - (let (msg art delete-list (num-delete 0) rest) - (nntp-possibly-change-group group server) - (while articles - (setq art (pop articles)) - (nntp-send-command "^\\([23]\\|^423\\).*\n" "X-DATE" art) - (setq msg (nndb-status-message)) - (if (string-match "^423" msg) - () - (or (string-match "'\\(.+\\)'" msg) - (error "Not a valid response for X-DATE command: %s" - msg)) - (if (nnmail-expired-article-p - group - (date-to-time (substring msg (match-beginning 1) (match-end 1))) - force) - (progn - (setq delete-list (concat delete-list " " (int-to-string art))) - (setq num-delete (1+ num-delete))) - (push art rest)))) - (if (> (length delete-list) 0) - (progn - (nnheader-message 5 "Deleting %s article(s) from %s" - (int-to-string num-delete) group) - (nntp-send-command "^[23].*\n" "X-DELETE" delete-list)) - ) - - (nnheader-message 5 "") - (nconc rest articles))) - -(defun nndb-get-remote-expire-response () - (let (list) - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (if (looking-at "^[34]") - ;; x-expire returned error--presume no articles were expirable) - (setq list nil) - ;; otherwise, pull all of the following numbers into the list - (re-search-forward "follows\r?\n?" nil t) - (while (re-search-forward "^[0-9]+$" nil t) - (push (string-to-number (match-string 0)) list))) - list)) - -(defun nndb-request-expire-articles-remote - (articles &optional group server force) - "Let the nndb backend expire articles" - (let (days art-string delete-list (num-delete 0)) - (nntp-possibly-change-group group server) - - ;; first calculate the wait period in days - (setq days (or (and nnmail-expiry-wait-function - (funcall nnmail-expiry-wait-function group)) - nnmail-expiry-wait)) - ;; now handle the special cases - (cond (force - (setq days 0)) - ((eq days 'never) - ;; This isn't an expirable group. - (setq days -1)) - ((eq days 'immediate) - (setq days 0))) - - - ;; build article string - (setq art-string (concat days " " (nndb-build-article-string articles))) - (nntp-send-command "^\.\r?\n\\|^[345].*\n" "X-EXPIRE" art-string) - - (setq delete-list (nndb-get-remote-expire-response)) - (setq num-delete (length delete-list)) - (if (> num-delete 0) - (nnheader-message 5 "Deleting %s article(s) from %s" - (int-to-string num-delete) group)) - - (nndb-build-expire-rest-list articles delete-list))) - -(deffoo nndb-request-expire-articles - (articles &optional group server force) - "Expires ARTICLES from GROUP on SERVER. -If FORCE, delete regardless of exiration date, otherwise use normal -expiry mechanism." - (if nndb-server-side-expiry - (nndb-request-expire-articles-remote articles group server force) - (nndb-request-expire-articles-local articles group server force))) - -(deffoo nndb-request-move-article - (article group server accept-form &optional last) - "Move ARTICLE (a number) from GROUP on SERVER. -Evals ACCEPT-FORM in current buffer, where the article is. -Optional LAST is ignored." - ;; we guess that the second arg in accept-form is the new group, - ;; which it will be for nndb, which is all that matters anyway - (let ((new-group (nth 1 accept-form)) result) - (nntp-possibly-change-group group server) - - ;; use the move command for nndb-to-nndb moves - (if (string-match "^nndb" new-group) - (let ((new-group-name (gnus-group-real-name new-group))) - (nntp-send-command "^[23].*\n" "X-MOVE" article new-group-name) - (cons new-group article)) - ;; else move normally - (let ((artbuf (get-buffer-create " *nndb move*"))) - (and - (nndb-request-article article group server artbuf) - (save-excursion - (set-buffer artbuf) - (insert-buffer-substring nntp-server-buffer) - (setq result (eval accept-form)) - (kill-buffer (current-buffer)) - result) - (nndb-request-expire-articles (list article) - group - server - t)) - result) - ))) - -(deffoo nndb-request-accept-article (group server &optional last) - "The article in the current buffer is put into GROUP." - (nntp-possibly-change-group group server) - (let (art msg) - (when (nntp-send-command "^[23].*\r?\n" "ACCEPT" group) - (nnheader-insert "") - (nntp-send-buffer "^[23].*\n")) - - (set-buffer nntp-server-buffer) - (setq msg (buffer-string)) - (or (string-match "^\\([0-9]+\\)" msg) - (error "nndb: %s" msg)) - (setq art (substring msg (match-beginning 1) (match-end 1))) - (nnheader-message 5 "nndb: accepted %s" art) - (list art))) - -(deffoo nndb-request-replace-article (article group buffer) - "ARTICLE is the number of the article in GROUP to be replaced with the contents of the BUFFER." - (set-buffer buffer) - (when (nntp-send-command "^[23].*\r?\n" "X-REPLACE" (int-to-string article)) - (nnheader-insert "") - (nntp-send-buffer "^[23.*\n") - (list (int-to-string article)))) - - ; nndb-request-delete-group does not exist - ; todo -- maybe later - - ; nndb-request-rename-group does not exist - ; todo -- maybe later - -;; -- standard compatability functions - -(deffoo nndb-status-message (&optional server) - "Return server status as a string." - (set-buffer nntp-server-buffer) - (buffer-string)) - -;; Import stuff from nntp - -(nnoo-import nndb - (nntp)) - -(provide 'nndb) - -;;; arch-tag: 83bd6fb4-58d9-4fed-a901-c6c625ad5f8a -;;; nndb.el ends here diff --git a/xemacs-packages/gnus/lisp/nndiary.el b/xemacs-packages/gnus/lisp/nndiary.el deleted file mode 100644 index 60ecd897..00000000 --- a/xemacs-packages/gnus/lisp/nndiary.el +++ /dev/null @@ -1,1595 +0,0 @@ -;;; nndiary.el --- A diary back end for Gnus - -;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Didier Verna -;; Maintainer: Didier Verna -;; Created: Fri Jul 16 18:55:42 1999 -;; Keywords: calendar mail news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - - -;;; Commentary: - -;; Contents management by FCM version 0.1. - -;; Description: -;; =========== - -;; nndiary is a mail back end designed to handle mails as diary event -;; reminders. It is now fully documented in the Gnus manual. - - -;; Bugs / Todo: -;; =========== - -;; * Respooling doesn't work because contrary to the request-scan function, -;; Gnus won't allow me to override the split methods when calling the -;; respooling back end functions. -;; * There's a bug in the time zone mechanism with variable TZ locations. -;; * We could allow a keyword like `ask' in X-Diary-* headers, that would mean -;; "ask for value upon reception of the message". -;; * We could add an optional header X-Diary-Reminders to specify a special -;; reminders value for this message. Suggested by Jody Klymak. -;; * We should check messages validity in other circumstances than just -;; moving an article from somewhere else (request-accept). For instance, -;; when editing / saving and so on. - - -;; Remarks: -;; ======= - -;; * nnoo. NNDiary is very similar to nnml. This makes the idea of using nnoo -;; (to derive nndiary from nnml) natural. However, my experience with nnoo -;; is that for reasonably complex back ends like this one, noo is a burden -;; rather than an help. It's tricky to use, not everything can be inherited, -;; what can be inherited and when is not very clear, and you've got to be -;; very careful because a little mistake can fuck up your other back ends, -;; especially because their variables will be use instead of your real ones. -;; Finally, I found it easier to just clone the needed parts of nnml, and -;; tracking nnml updates is not a big deal. - -;; IMHO, nnoo is actually badly designed. A much simpler, and yet more -;; powerful one would be to make *real* functions and variables for a new -;; back end based on another. Lisp is a reflexive language so that's a very -;; easy thing to do: inspect the function's form, replace occurences of -;; (even in strings) with , and you're done. - -;; * nndiary-get-new-mail, nndiary-mail-source and nndiary-split-methods: -;; NNDiary has some experimental parts, in the sense Gnus normally uses only -;; one mail back ends for mail retreival and splitting. This back end is -;; also an attempt to make it behave differently. For Gnus developpers: as -;; you can see if you snarf into the code, that was not a very difficult -;; thing to do. Something should be done about the respooling breakage -;; though. - - -;;; Code: - -(require 'nnoo) -(require 'nnheader) -(require 'nnmail) -(eval-when-compile (require 'cl)) - -(require 'gnus-start) -(require 'gnus-sum) - -;; Compatibility Functions ================================================= - -(eval-and-compile - (if (fboundp 'signal-error) - (defun nndiary-error (&rest args) - (apply #'signal-error 'nndiary args)) - (defun nndiary-error (&rest args) - (apply #'error args)))) - - -;; Back End behavior customization =========================================== - -(defgroup nndiary nil - "The Gnus Diary back end." - :version "22.1" - :group 'gnus-diary) - -(defcustom nndiary-mail-sources - `((file :path ,(expand-file-name "~/.nndiary"))) - "*NNDiary specific mail sources. -This variable is used by nndiary in place of the standard `mail-sources' -variable when `nndiary-get-new-mail' is set to non-nil. These sources -must contain diary messages ONLY." - :group 'nndiary - :group 'mail-source - :type 'sexp) - -(defcustom nndiary-split-methods '(("diary" "")) - "*NNDiary specific split methods. -This variable is used by nndiary in place of the standard -`nnmail-split-methods' variable when `nndiary-get-new-mail' is set to -non-nil." - :group 'nndiary - :group 'nnmail-split - :type '(choice (repeat :tag "Alist" (group (string :tag "Name") regexp)) - (function-item nnmail-split-fancy) - (function :tag "Other"))) - - -(defcustom nndiary-reminders '((0 . day)) - "*Different times when you want to be reminded of your appointments. -Diary articles will appear again, as if they'd been just received. - -Entries look like (3 . day) which means something like \"Please -Hortense, would you be so kind as to remind me of my appointments 3 days -before the date, thank you very much. Anda, hmmm... by the way, are you -doing anything special tonight ?\". - -The units of measure are 'minute 'hour 'day 'week 'month and 'year (no, -not 'century, sorry). - -NOTE: the units of measure actually express dates, not durations: if you -use 'week, messages will pop up on Sundays at 00:00 (or Mondays if -`nndiary-week-starts-on-monday' is non-nil) and *not* 7 days before the -appointment, if you use 'month, messages will pop up on the first day of -each months, at 00:00 and so on. - -If you really want to specify a duration (like 24 hours exactly), you can -use the equivalent in minutes (the smallest unit). A fuzz of 60 seconds -maximum in the reminder is not that painful, I think. Although this -scheme might appear somewhat weird at a first glance, it is very powerful. -In order to make this clear, here are some examples: - -- '(0 . day): this is the default value of `nndiary-reminders'. It means - pop up the appointments of the day each morning at 00:00. - -- '(1 . day): this means pop up the appointments the day before, at 00:00. - -- '(6 . hour): for an appointment at 18:30, this would pop up the - appointment message at 12:00. - -- '(360 . minute): for an appointment at 18:30 and 15 seconds, this would - pop up the appointment message at 12:30." - :group 'nndiary - :type '(repeat (cons :format "%v\n" - (integer :format "%v") - (choice :format "%[%v(s)%] before...\n" - :value day - (const :format "%v" minute) - (const :format "%v" hour) - (const :format "%v" day) - (const :format "%v" week) - (const :format "%v" month) - (const :format "%v" year))))) - -(defcustom nndiary-week-starts-on-monday nil - "*Whether a week starts on monday (otherwise, sunday)." - :type 'boolean - :group 'nndiary) - - -(defcustom nndiary-request-create-group-hooks nil - "*Hooks to run after `nndiary-request-create-group' is executed. -The hooks will be called with the full group name as argument." - :group 'nndiary - :type 'hook) - -(defcustom nndiary-request-update-info-hooks nil - "*Hooks to run after `nndiary-request-update-info-group' is executed. -The hooks will be called with the full group name as argument." - :group 'nndiary - :type 'hook) - -(defcustom nndiary-request-accept-article-hooks nil - "*Hooks to run before accepting an article. -Executed near the beginning of `nndiary-request-accept-article'. -The hooks will be called with the article in the current buffer." - :group 'nndiary - :type 'hook) - -(defcustom nndiary-check-directory-twice t - "*If t, check directories twice to avoid NFS failures." - :group 'nndiary - :type 'boolean) - - -;; Back End declaration ====================================================== - -;; Well, most of this is nnml clonage. - -(nnoo-declare nndiary) - -(defvoo nndiary-directory (nnheader-concat gnus-directory "diary/") - "Spool directory for the nndiary back end.") - -(defvoo nndiary-active-file - (expand-file-name "active" nndiary-directory) - "Active file for the nndiary back end.") - -(defvoo nndiary-newsgroups-file - (expand-file-name "newsgroups" nndiary-directory) - "Newsgroups description file for the nndiary back end.") - -(defvoo nndiary-get-new-mail nil - "Whether nndiary gets new mail and split it. -Contrary to traditional mail back ends, this variable can be set to t -even if your primary mail back end also retreives mail. In such a case, -NDiary uses its own mail-sources and split-methods.") - -(defvoo nndiary-nov-is-evil nil - "If non-nil, Gnus will never use nov databases for nndiary groups. -Using nov databases will speed up header fetching considerably. -This variable shouldn't be flipped much. If you have, for some reason, -set this to t, and want to set it to nil again, you should always run -the `nndiary-generate-nov-databases' command. The function will go -through all nnml directories and generate nov databases for them -all. This may very well take some time.") - -(defvoo nndiary-prepare-save-mail-hook nil - "*Hook run narrowed to an article before saving.") - -(defvoo nndiary-inhibit-expiry nil - "If non-nil, inhibit expiry.") - - - -(defconst nndiary-version "0.2-b14" - "Current Diary back end version.") - -(defun nndiary-version () - "Current Diary back end version." - (interactive) - (message "NNDiary version %s" nndiary-version)) - -(defvoo nndiary-nov-file-name ".overview") - -(defvoo nndiary-current-directory nil) -(defvoo nndiary-current-group nil) -(defvoo nndiary-status-string "" ) -(defvoo nndiary-nov-buffer-alist nil) -(defvoo nndiary-group-alist nil) -(defvoo nndiary-active-timestamp nil) -(defvoo nndiary-article-file-alist nil) - -(defvoo nndiary-generate-active-function 'nndiary-generate-active-info) -(defvoo nndiary-nov-buffer-file-name nil) -(defvoo nndiary-file-coding-system nnmail-file-coding-system) - -(defconst nndiary-headers - '(("Minute" 0 59) - ("Hour" 0 23) - ("Dom" 1 31) - ("Month" 1 12) - ("Year" 1971) - ("Dow" 0 6) - ("Time-Zone" (("Y" -43200) - - ("X" -39600) - - ("W" -36000) - - ("V" -32400) - - ("U" -28800) - ("PST" -28800) - - ("T" -25200) - ("MST" -25200) - ("PDT" -25200) - - ("S" -21600) - ("CST" -21600) - ("MDT" -21600) - - ("R" -18000) - ("EST" -18000) - ("CDT" -18000) - - ("Q" -14400) - ("AST" -14400) - ("EDT" -14400) - - ("P" -10800) - ("ADT" -10800) - - ("O" -7200) - - ("N" -3600) - - ("Z" 0) - ("GMT" 0) - ("UT" 0) - ("UTC" 0) - ("WET" 0) - - ("A" 3600) - ("CET" 3600) - ("MET" 3600) - ("MEZ" 3600) - ("BST" 3600) - ("WEST" 3600) - - ("B" 7200) - ("EET" 7200) - ("CEST" 7200) - ("MEST" 7200) - ("MESZ" 7200) - - ("C" 10800) - - ("D" 14400) - - ("E" 18000) - - ("F" 21600) - - ("G" 25200) - - ("H" 28800) - - ("I" 32400) - ("JST" 32400) - - ("K" 36000) - ("GST" 36000) - - ("L" 39600) - - ("M" 43200) - ("NZST" 43200) - - ("NZDT" 46800)))) - ;; List of NNDiary headers that specify the time spec. Each header name is - ;; followed by either two integers (specifying a range of possible values - ;; for this header) or one list (specifying all the possible values for this - ;; header). In the latter case, the list does NOT include the unspecifyed - ;; spec (*). - ;; For time zone values, we have symbolic time zone names associated with - ;; the (relative) number of seconds ahead GMT. - ) - -(defsubst nndiary-schedule () - (let (head) - (condition-case arg - (mapcar - (lambda (elt) - (setq head (nth 0 elt)) - (nndiary-parse-schedule (nth 0 elt) (nth 1 elt) (nth 2 elt))) - nndiary-headers) - (t - (nnheader-report 'nndiary "X-Diary-%s header parse error: %s." - head (cdr arg)) - nil)) - )) - -;;; Interface functions ===================================================== - -(nnoo-define-basics nndiary) - -(deffoo nndiary-retrieve-headers (sequence &optional group server fetch-old) - (when (nndiary-possibly-change-directory group server) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (let* ((file nil) - (number (length sequence)) - (count 0) - (file-name-coding-system nnmail-pathname-coding-system) - beg article - (nndiary-check-directory-twice - (and nndiary-check-directory-twice - ;; To speed up, disable it in some case. - (or (not (numberp nnmail-large-newsgroup)) - (<= number nnmail-large-newsgroup))))) - (if (stringp (car sequence)) - 'headers - (if (nndiary-retrieve-headers-with-nov sequence fetch-old) - 'nov - (while sequence - (setq article (car sequence)) - (setq file (nndiary-article-to-file article)) - (when (and file - (file-exists-p file) - (not (file-directory-p file))) - (insert (format "221 %d Article retrieved.\n" article)) - (setq beg (point)) - (nnheader-insert-head file) - (goto-char beg) - (if (search-forward "\n\n" nil t) - (forward-char -1) - (goto-char (point-max)) - (insert "\n\n")) - (insert ".\n") - (delete-region (point) (point-max))) - (setq sequence (cdr sequence)) - (setq count (1+ count)) - (and (numberp nnmail-large-newsgroup) - (> number nnmail-large-newsgroup) - (zerop (% count 20)) - (nnheader-message 6 "nndiary: Receiving headers... %d%%" - (/ (* count 100) number)))) - - (and (numberp nnmail-large-newsgroup) - (> number nnmail-large-newsgroup) - (nnheader-message 6 "nndiary: Receiving headers...done")) - - (nnheader-fold-continuation-lines) - 'headers)))))) - -(deffoo nndiary-open-server (server &optional defs) - (nnoo-change-server 'nndiary server defs) - (when (not (file-exists-p nndiary-directory)) - (ignore-errors (make-directory nndiary-directory t))) - (cond - ((not (file-exists-p nndiary-directory)) - (nndiary-close-server) - (nnheader-report 'nndiary "Couldn't create directory: %s" - nndiary-directory)) - ((not (file-directory-p (file-truename nndiary-directory))) - (nndiary-close-server) - (nnheader-report 'nndiary "Not a directory: %s" nndiary-directory)) - (t - (nnheader-report 'nndiary "Opened server %s using directory %s" - server nndiary-directory) - t))) - -(deffoo nndiary-request-regenerate (server) - (nndiary-possibly-change-directory nil server) - (nndiary-generate-nov-databases server) - t) - -(deffoo nndiary-request-article (id &optional group server buffer) - (nndiary-possibly-change-directory group server) - (let* ((nntp-server-buffer (or buffer nntp-server-buffer)) - (file-name-coding-system nnmail-pathname-coding-system) - path gpath group-num) - (if (stringp id) - (when (and (setq group-num (nndiary-find-group-number id)) - (cdr - (assq (cdr group-num) - (nnheader-article-to-file-alist - (setq gpath - (nnmail-group-pathname - (car group-num) - nndiary-directory)))))) - (setq path (concat gpath (int-to-string (cdr group-num))))) - (setq path (nndiary-article-to-file id))) - (cond - ((not path) - (nnheader-report 'nndiary "No such article: %s" id)) - ((not (file-exists-p path)) - (nnheader-report 'nndiary "No such file: %s" path)) - ((file-directory-p path) - (nnheader-report 'nndiary "File is a directory: %s" path)) - ((not (save-excursion (let ((nnmail-file-coding-system - nndiary-file-coding-system)) - (nnmail-find-file path)))) - (nnheader-report 'nndiary "Couldn't read file: %s" path)) - (t - (nnheader-report 'nndiary "Article %s retrieved" id) - ;; We return the article number. - (cons (if group-num (car group-num) group) - (string-to-number (file-name-nondirectory path))))))) - -(deffoo nndiary-request-group (group &optional server dont-check) - (let ((file-name-coding-system nnmail-pathname-coding-system)) - (cond - ((not (nndiary-possibly-change-directory group server)) - (nnheader-report 'nndiary "Invalid group (no such directory)")) - ((not (file-exists-p nndiary-current-directory)) - (nnheader-report 'nndiary "Directory %s does not exist" - nndiary-current-directory)) - ((not (file-directory-p nndiary-current-directory)) - (nnheader-report 'nndiary "%s is not a directory" - nndiary-current-directory)) - (dont-check - (nnheader-report 'nndiary "Group %s selected" group) - t) - (t - (nnheader-re-read-dir nndiary-current-directory) - (nnmail-activate 'nndiary) - (let ((active (nth 1 (assoc group nndiary-group-alist)))) - (if (not active) - (nnheader-report 'nndiary "No such group: %s" group) - (nnheader-report 'nndiary "Selected group %s" group) - (nnheader-insert "211 %d %d %d %s\n" - (max (1+ (- (cdr active) (car active))) 0) - (car active) (cdr active) group))))))) - -(deffoo nndiary-request-scan (&optional group server) - ;; Use our own mail sources and split methods while Gnus doesn't let us have - ;; multiple back ends for retrieving mail. - (let ((mail-sources nndiary-mail-sources) - (nnmail-split-methods nndiary-split-methods)) - (setq nndiary-article-file-alist nil) - (nndiary-possibly-change-directory group server) - (nnmail-get-new-mail 'nndiary 'nndiary-save-nov nndiary-directory group))) - -(deffoo nndiary-close-group (group &optional server) - (setq nndiary-article-file-alist nil) - t) - -(deffoo nndiary-request-create-group (group &optional server args) - (nndiary-possibly-change-directory nil server) - (nnmail-activate 'nndiary) - (cond - ((assoc group nndiary-group-alist) - t) - ((and (file-exists-p (nnmail-group-pathname group nndiary-directory)) - (not (file-directory-p (nnmail-group-pathname - group nndiary-directory)))) - (nnheader-report 'nndiary "%s is a file" - (nnmail-group-pathname group nndiary-directory))) - (t - (let (active) - (push (list group (setq active (cons 1 0))) - nndiary-group-alist) - (nndiary-possibly-create-directory group) - (nndiary-possibly-change-directory group server) - (let ((articles (nnheader-directory-articles nndiary-current-directory))) - (when articles - (setcar active (apply 'min articles)) - (setcdr active (apply 'max articles)))) - (nnmail-save-active nndiary-group-alist nndiary-active-file) - (run-hook-with-args 'nndiary-request-create-group-hooks - (gnus-group-prefixed-name group - (list "nndiary" server))) - t)) - )) - -(deffoo nndiary-request-list (&optional server) - (save-excursion - (let ((nnmail-file-coding-system nnmail-active-file-coding-system) - (file-name-coding-system nnmail-pathname-coding-system)) - (nnmail-find-file nndiary-active-file)) - (setq nndiary-group-alist (nnmail-get-active)) - t)) - -(deffoo nndiary-request-newgroups (date &optional server) - (nndiary-request-list server)) - -(deffoo nndiary-request-list-newsgroups (&optional server) - (save-excursion - (nnmail-find-file nndiary-newsgroups-file))) - -(deffoo nndiary-request-expire-articles (articles group &optional server force) - (nndiary-possibly-change-directory group server) - (let ((active-articles - (nnheader-directory-articles nndiary-current-directory)) - article rest number) - (nnmail-activate 'nndiary) - ;; Articles not listed in active-articles are already gone, - ;; so don't try to expire them. - (setq articles (gnus-intersection articles active-articles)) - (while articles - (setq article (nndiary-article-to-file (setq number (pop articles)))) - (if (and (nndiary-deletable-article-p group number) - ;; Don't use nnmail-expired-article-p. Our notion of expiration - ;; is a bit peculiar ... - (or force (nndiary-expired-article-p article))) - (progn - ;; Allow a special target group. - (unless (eq nnmail-expiry-target 'delete) - (with-temp-buffer - (nndiary-request-article number group server (current-buffer)) - (let ((nndiary-current-directory nil)) - (nnmail-expiry-target-group nnmail-expiry-target group))) - (nndiary-possibly-change-directory group server)) - (nnheader-message 5 "Deleting article %s in %s" number group) - (condition-case () - (funcall nnmail-delete-file-function article) - (file-error (push number rest))) - (setq active-articles (delq number active-articles)) - (nndiary-nov-delete-article group number)) - (push number rest))) - (let ((active (nth 1 (assoc group nndiary-group-alist)))) - (when active - (setcar active (or (and active-articles - (apply 'min active-articles)) - (1+ (cdr active))))) - (nnmail-save-active nndiary-group-alist nndiary-active-file)) - (nndiary-save-nov) - (nconc rest articles))) - -(deffoo nndiary-request-move-article - (article group server accept-form &optional last) - (let ((buf (get-buffer-create " *nndiary move*")) - result) - (nndiary-possibly-change-directory group server) - (nndiary-update-file-alist) - (and - (nndiary-deletable-article-p group article) - (nndiary-request-article article group server) - (let (nndiary-current-directory - nndiary-current-group - nndiary-article-file-alist) - (save-excursion - (set-buffer buf) - (insert-buffer-substring nntp-server-buffer) - (setq result (eval accept-form)) - (kill-buffer (current-buffer)) - result)) - (progn - (nndiary-possibly-change-directory group server) - (condition-case () - (funcall nnmail-delete-file-function - (nndiary-article-to-file article)) - (file-error nil)) - (nndiary-nov-delete-article group article) - (when last - (nndiary-save-nov) - (nnmail-save-active nndiary-group-alist nndiary-active-file)))) - result)) - -(deffoo nndiary-request-accept-article (group &optional server last) - (nndiary-possibly-change-directory group server) - (nnmail-check-syntax) - (run-hooks 'nndiary-request-accept-article-hooks) - (when (nndiary-schedule) - (let (result) - (when nnmail-cache-accepted-message-ids - (nnmail-cache-insert (nnmail-fetch-field "message-id") - group - (nnmail-fetch-field "subject"))) - (if (stringp group) - (and - (nnmail-activate 'nndiary) - (setq result - (car (nndiary-save-mail - (list (cons group (nndiary-active-number group)))))) - (progn - (nnmail-save-active nndiary-group-alist nndiary-active-file) - (and last (nndiary-save-nov)))) - (and - (nnmail-activate 'nndiary) - (if (and (not (setq result - (nnmail-article-group 'nndiary-active-number))) - (yes-or-no-p "Moved to `junk' group; delete article? ")) - (setq result 'junk) - (setq result (car (nndiary-save-mail result)))) - (when last - (nnmail-save-active nndiary-group-alist nndiary-active-file) - (when nnmail-cache-accepted-message-ids - (nnmail-cache-close)) - (nndiary-save-nov)))) - result)) - ) - -(deffoo nndiary-request-post (&optional server) - (nnmail-do-request-post 'nndiary-request-accept-article server)) - -(deffoo nndiary-request-replace-article (article group buffer) - (nndiary-possibly-change-directory group) - (save-excursion - (set-buffer buffer) - (nndiary-possibly-create-directory group) - (let ((chars (nnmail-insert-lines)) - (art (concat (int-to-string article) "\t")) - headers) - (when (ignore-errors - (nnmail-write-region - (point-min) (point-max) - (or (nndiary-article-to-file article) - (expand-file-name (int-to-string article) - nndiary-current-directory)) - nil (if (nnheader-be-verbose 5) nil 'nomesg)) - t) - (setq headers (nndiary-parse-head chars article)) - ;; Replace the NOV line in the NOV file. - (save-excursion - (set-buffer (nndiary-open-nov group)) - (goto-char (point-min)) - (if (or (looking-at art) - (search-forward (concat "\n" art) nil t)) - ;; Delete the old NOV line. - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point))) - ;; The line isn't here, so we have to find out where - ;; we should insert it. (This situation should never - ;; occur, but one likes to make sure...) - (while (and (looking-at "[0-9]+\t") - (< (string-to-number - (buffer-substring - (match-beginning 0) (match-end 0))) - article) - (zerop (forward-line 1))))) - (beginning-of-line) - (nnheader-insert-nov headers) - (nndiary-save-nov) - t))))) - -(deffoo nndiary-request-delete-group (group &optional force server) - (nndiary-possibly-change-directory group server) - (when force - ;; Delete all articles in GROUP. - (let ((articles - (directory-files - nndiary-current-directory t - (concat nnheader-numerical-short-files - "\\|" (regexp-quote nndiary-nov-file-name) "$"))) - article) - (while articles - (setq article (pop articles)) - (when (file-writable-p article) - (nnheader-message 5 "Deleting article %s in %s..." article group) - (funcall nnmail-delete-file-function article)))) - ;; Try to delete the directory itself. - (ignore-errors (delete-directory nndiary-current-directory))) - ;; Remove the group from all structures. - (setq nndiary-group-alist - (delq (assoc group nndiary-group-alist) nndiary-group-alist) - nndiary-current-group nil - nndiary-current-directory nil) - ;; Save the active file. - (nnmail-save-active nndiary-group-alist nndiary-active-file) - t) - -(deffoo nndiary-request-rename-group (group new-name &optional server) - (nndiary-possibly-change-directory group server) - (let ((new-dir (nnmail-group-pathname new-name nndiary-directory)) - (old-dir (nnmail-group-pathname group nndiary-directory))) - (when (ignore-errors - (make-directory new-dir t) - t) - ;; We move the articles file by file instead of renaming - ;; the directory -- there may be subgroups in this group. - ;; One might be more clever, I guess. - (let ((files (nnheader-article-to-file-alist old-dir))) - (while files - (rename-file - (concat old-dir (cdar files)) - (concat new-dir (cdar files))) - (pop files))) - ;; Move .overview file. - (let ((overview (concat old-dir nndiary-nov-file-name))) - (when (file-exists-p overview) - (rename-file overview (concat new-dir nndiary-nov-file-name)))) - (when (<= (length (directory-files old-dir)) 2) - (ignore-errors (delete-directory old-dir))) - ;; That went ok, so we change the internal structures. - (let ((entry (assoc group nndiary-group-alist))) - (when entry - (setcar entry new-name)) - (setq nndiary-current-directory nil - nndiary-current-group nil) - ;; Save the new group alist. - (nnmail-save-active nndiary-group-alist nndiary-active-file) - t)))) - -(deffoo nndiary-set-status (article name value &optional group server) - (nndiary-possibly-change-directory group server) - (let ((file (nndiary-article-to-file article))) - (cond - ((not (file-exists-p file)) - (nnheader-report 'nndiary "File %s does not exist" file)) - (t - (with-temp-file file - (nnheader-insert-file-contents file) - (nnmail-replace-status name value)) - t)))) - - -;;; Interface optional functions ============================================ - -(deffoo nndiary-request-update-info (group info &optional server) - (nndiary-possibly-change-directory group) - (let ((timestamp (gnus-group-parameter-value (gnus-info-params info) - 'timestamp t))) - (if (not timestamp) - (nnheader-report 'nndiary "Group %s doesn't have a timestamp" group) - ;; else - ;; Figure out which articles should be re-new'ed - (let ((articles (nndiary-flatten (gnus-info-read info) 0)) - article file unread buf) - (save-excursion - (setq buf (nnheader-set-temp-buffer " *nndiary update*")) - (while (setq article (pop articles)) - (setq file (concat nndiary-current-directory - (int-to-string article))) - (and (file-exists-p file) - (nndiary-renew-article-p file timestamp) - (push article unread))) - ;;(message "unread: %s" unread) - (sit-for 1) - (kill-buffer buf)) - (setq unread (sort unread '<)) - (and unread - (gnus-info-set-read info (gnus-update-read-articles - (gnus-info-group info) unread t))) - )) - (run-hook-with-args 'nndiary-request-update-info-hooks - (gnus-info-group info)) - t)) - - - -;;; Internal functions ====================================================== - -(defun nndiary-article-to-file (article) - (nndiary-update-file-alist) - (let (file) - (if (setq file (cdr (assq article nndiary-article-file-alist))) - (expand-file-name file nndiary-current-directory) - ;; Just to make sure nothing went wrong when reading over NFS -- - ;; check once more. - (if nndiary-check-directory-twice - (when (file-exists-p - (setq file (expand-file-name (number-to-string article) - nndiary-current-directory))) - (nndiary-update-file-alist t) - file))))) - -(defun nndiary-deletable-article-p (group article) - "Say whether ARTICLE in GROUP can be deleted." - (let (path) - (when (setq path (nndiary-article-to-file article)) - (when (file-writable-p path) - (or (not nnmail-keep-last-article) - (not (eq (cdr (nth 1 (assoc group nndiary-group-alist))) - article))))))) - -;; Find an article number in the current group given the Message-ID. -(defun nndiary-find-group-number (id) - (save-excursion - (set-buffer (get-buffer-create " *nndiary id*")) - (let ((alist nndiary-group-alist) - number) - ;; We want to look through all .overview files, but we want to - ;; start with the one in the current directory. It seems most - ;; likely that the article we are looking for is in that group. - (if (setq number (nndiary-find-id nndiary-current-group id)) - (cons nndiary-current-group number) - ;; It wasn't there, so we look through the other groups as well. - (while (and (not number) - alist) - (or (string= (caar alist) nndiary-current-group) - (setq number (nndiary-find-id (caar alist) id))) - (or number - (setq alist (cdr alist)))) - (and number - (cons (caar alist) number)))))) - -(defun nndiary-find-id (group id) - (erase-buffer) - (let ((nov (expand-file-name nndiary-nov-file-name - (nnmail-group-pathname group - nndiary-directory))) - number found) - (when (file-exists-p nov) - (nnheader-insert-file-contents nov) - (while (and (not found) - (search-forward id nil t)) ; We find the ID. - ;; And the id is in the fourth field. - (if (not (and (search-backward "\t" nil t 4) - (not (search-backward"\t" (gnus-point-at-bol) t)))) - (forward-line 1) - (beginning-of-line) - (setq found t) - ;; We return the article number. - (setq number - (ignore-errors (read (current-buffer)))))) - number))) - -(defun nndiary-retrieve-headers-with-nov (articles &optional fetch-old) - (if (or gnus-nov-is-evil nndiary-nov-is-evil) - nil - (let ((nov (expand-file-name nndiary-nov-file-name - nndiary-current-directory))) - (when (file-exists-p nov) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (nnheader-insert-file-contents nov) - (if (and fetch-old - (not (numberp fetch-old))) - t ; Don't remove anything. - (nnheader-nov-delete-outside-range - (if fetch-old (max 1 (- (car articles) fetch-old)) - (car articles)) - (car (last articles))) - t)))))) - -(defun nndiary-possibly-change-directory (group &optional server) - (when (and server - (not (nndiary-server-opened server))) - (nndiary-open-server server)) - (if (not group) - t - (let ((pathname (nnmail-group-pathname group nndiary-directory)) - (file-name-coding-system nnmail-pathname-coding-system)) - (when (not (equal pathname nndiary-current-directory)) - (setq nndiary-current-directory pathname - nndiary-current-group group - nndiary-article-file-alist nil)) - (file-exists-p nndiary-current-directory)))) - -(defun nndiary-possibly-create-directory (group) - (let ((dir (nnmail-group-pathname group nndiary-directory))) - (unless (file-exists-p dir) - (make-directory (directory-file-name dir) t) - (nnheader-message 5 "Creating mail directory %s" dir)))) - -(defun nndiary-save-mail (group-art) - "Called narrowed to an article." - (let (chars headers) - (setq chars (nnmail-insert-lines)) - (nnmail-insert-xref group-art) - (run-hooks 'nnmail-prepare-save-mail-hook) - (run-hooks 'nndiary-prepare-save-mail-hook) - (goto-char (point-min)) - (while (looking-at "From ") - (replace-match "X-From-Line: ") - (forward-line 1)) - ;; We save the article in all the groups it belongs in. - (let ((ga group-art) - first) - (while ga - (nndiary-possibly-create-directory (caar ga)) - (let ((file (concat (nnmail-group-pathname - (caar ga) nndiary-directory) - (int-to-string (cdar ga))))) - (if first - ;; It was already saved, so we just make a hard link. - (funcall nnmail-crosspost-link-function first file t) - ;; Save the article. - (nnmail-write-region (point-min) (point-max) file nil - (if (nnheader-be-verbose 5) nil 'nomesg)) - (setq first file))) - (setq ga (cdr ga)))) - ;; Generate a nov line for this article. We generate the nov - ;; line after saving, because nov generation destroys the - ;; header. - (setq headers (nndiary-parse-head chars)) - ;; Output the nov line to all nov databases that should have it. - (let ((ga group-art)) - (while ga - (nndiary-add-nov (caar ga) (cdar ga) headers) - (setq ga (cdr ga)))) - group-art)) - -(defun nndiary-active-number (group) - "Compute the next article number in GROUP." - (let ((active (cadr (assoc group nndiary-group-alist)))) - ;; The group wasn't known to nndiary, so we just create an active - ;; entry for it. - (unless active - ;; Perhaps the active file was corrupt? See whether - ;; there are any articles in this group. - (nndiary-possibly-create-directory group) - (nndiary-possibly-change-directory group) - (unless nndiary-article-file-alist - (setq nndiary-article-file-alist - (sort - (nnheader-article-to-file-alist nndiary-current-directory) - 'car-less-than-car))) - (setq active - (if nndiary-article-file-alist - (cons (caar nndiary-article-file-alist) - (caar (last nndiary-article-file-alist))) - (cons 1 0))) - (push (list group active) nndiary-group-alist)) - (setcdr active (1+ (cdr active))) - (while (file-exists-p - (expand-file-name (int-to-string (cdr active)) - (nnmail-group-pathname group nndiary-directory))) - (setcdr active (1+ (cdr active)))) - (cdr active))) - -(defun nndiary-add-nov (group article headers) - "Add a nov line for the GROUP base." - (save-excursion - (set-buffer (nndiary-open-nov group)) - (goto-char (point-max)) - (mail-header-set-number headers article) - (nnheader-insert-nov headers))) - -(defsubst nndiary-header-value () - (buffer-substring (match-end 0) (progn (end-of-line) (point)))) - -(defun nndiary-parse-head (chars &optional number) - "Parse the head of the current buffer." - (save-excursion - (save-restriction - (unless (zerop (buffer-size)) - (narrow-to-region - (goto-char (point-min)) - (if (search-forward "\n\n" nil t) (1- (point)) (point-max)))) - (let ((headers (nnheader-parse-naked-head))) - (mail-header-set-chars headers chars) - (mail-header-set-number headers number) - headers)))) - -(defun nndiary-open-nov (group) - (or (cdr (assoc group nndiary-nov-buffer-alist)) - (let ((buffer (get-buffer-create (format " *nndiary overview %s*" - group)))) - (save-excursion - (set-buffer buffer) - (set (make-local-variable 'nndiary-nov-buffer-file-name) - (expand-file-name - nndiary-nov-file-name - (nnmail-group-pathname group nndiary-directory))) - (erase-buffer) - (when (file-exists-p nndiary-nov-buffer-file-name) - (nnheader-insert-file-contents nndiary-nov-buffer-file-name))) - (push (cons group buffer) nndiary-nov-buffer-alist) - buffer))) - -(defun nndiary-save-nov () - (save-excursion - (while nndiary-nov-buffer-alist - (when (buffer-name (cdar nndiary-nov-buffer-alist)) - (set-buffer (cdar nndiary-nov-buffer-alist)) - (when (buffer-modified-p) - (nnmail-write-region 1 (point-max) nndiary-nov-buffer-file-name - nil 'nomesg)) - (set-buffer-modified-p nil) - (kill-buffer (current-buffer))) - (setq nndiary-nov-buffer-alist (cdr nndiary-nov-buffer-alist))))) - -;;;###autoload -(defun nndiary-generate-nov-databases (&optional server) - "Generate NOV databases in all nndiary directories." - (interactive (list (or (nnoo-current-server 'nndiary) ""))) - ;; Read the active file to make sure we don't re-use articles - ;; numbers in empty groups. - (nnmail-activate 'nndiary) - (unless (nndiary-server-opened server) - (nndiary-open-server server)) - (setq nndiary-directory (expand-file-name nndiary-directory)) - ;; Recurse down the directories. - (nndiary-generate-nov-databases-1 nndiary-directory nil t) - ;; Save the active file. - (nnmail-save-active nndiary-group-alist nndiary-active-file)) - -(defun nndiary-generate-nov-databases-1 (dir &optional seen no-active) - "Regenerate the NOV database in DIR." - (interactive "DRegenerate NOV in: ") - (setq dir (file-name-as-directory dir)) - ;; Only scan this sub-tree if we haven't been here yet. - (unless (member (file-truename dir) seen) - (push (file-truename dir) seen) - ;; We descend recursively - (let ((dirs (directory-files dir t nil t)) - dir) - (while (setq dir (pop dirs)) - (when (and (not (string-match "^\\." (file-name-nondirectory dir))) - (file-directory-p dir)) - (nndiary-generate-nov-databases-1 dir seen)))) - ;; Do this directory. - (let ((files (sort (nnheader-article-to-file-alist dir) - 'car-less-than-car))) - (if (not files) - (let* ((group (nnheader-file-to-group - (directory-file-name dir) nndiary-directory)) - (info (cadr (assoc group nndiary-group-alist)))) - (when info - (setcar info (1+ (cdr info))))) - (funcall nndiary-generate-active-function dir) - ;; Generate the nov file. - (nndiary-generate-nov-file dir files) - (unless no-active - (nnmail-save-active nndiary-group-alist nndiary-active-file)))))) - -(eval-when-compile (defvar files)) -(defun nndiary-generate-active-info (dir) - ;; Update the active info for this group. - (let* ((group (nnheader-file-to-group - (directory-file-name dir) nndiary-directory)) - (entry (assoc group nndiary-group-alist)) - (last (or (caadr entry) 0))) - (setq nndiary-group-alist (delq entry nndiary-group-alist)) - (push (list group - (cons (or (caar files) (1+ last)) - (max last - (or (let ((f files)) - (while (cdr f) (setq f (cdr f))) - (caar f)) - 0)))) - nndiary-group-alist))) - -(defun nndiary-generate-nov-file (dir files) - (let* ((dir (file-name-as-directory dir)) - (nov (concat dir nndiary-nov-file-name)) - (nov-buffer (get-buffer-create " *nov*")) - chars file headers) - (save-excursion - ;; Init the nov buffer. - (set-buffer nov-buffer) - (buffer-disable-undo) - (erase-buffer) - (set-buffer nntp-server-buffer) - ;; Delete the old NOV file. - (when (file-exists-p nov) - (funcall nnmail-delete-file-function nov)) - (while files - (unless (file-directory-p (setq file (concat dir (cdar files)))) - (erase-buffer) - (nnheader-insert-file-contents file) - (narrow-to-region - (goto-char (point-min)) - (progn - (search-forward "\n\n" nil t) - (setq chars (- (point-max) (point))) - (max 1 (1- (point))))) - (unless (zerop (buffer-size)) - (goto-char (point-min)) - (setq headers (nndiary-parse-head chars (caar files))) - (save-excursion - (set-buffer nov-buffer) - (goto-char (point-max)) - (nnheader-insert-nov headers))) - (widen)) - (setq files (cdr files))) - (save-excursion - (set-buffer nov-buffer) - (nnmail-write-region 1 (point-max) nov nil 'nomesg) - (kill-buffer (current-buffer)))))) - -(defun nndiary-nov-delete-article (group article) - (save-excursion - (set-buffer (nndiary-open-nov group)) - (when (nnheader-find-nov-line article) - (delete-region (point) (progn (forward-line 1) (point))) - (when (bobp) - (let ((active (cadr (assoc group nndiary-group-alist))) - num) - (when active - (if (eobp) - (setf (car active) (1+ (cdr active))) - (when (and (setq num (ignore-errors (read (current-buffer)))) - (numberp num)) - (setf (car active) num))))))) - t)) - -(defun nndiary-update-file-alist (&optional force) - (when (or (not nndiary-article-file-alist) - force) - (setq nndiary-article-file-alist - (nnheader-article-to-file-alist nndiary-current-directory)))) - - -(defun nndiary-string-to-number (str min &optional max) - ;; Like `string-to-number' but barf if STR is not exactly an integer, and not - ;; within the specified bounds. - ;; Signals are caught by `nndiary-schedule'. - (if (not (string-match "^[ \t]*[0-9]+[ \t]*$" str)) - (nndiary-error "not an integer value") - ;; else - (let ((val (string-to-number str))) - (and (or (< val min) - (and max (> val max))) - (nndiary-error "value out of range")) - val))) - -(defun nndiary-parse-schedule-value (str min-or-values max) - ;; Parse the schedule string STR, or signal an error. - ;; Signals are caught by `nndary-schedule'. - (if (string-match "[ \t]*\\*[ \t]*" str) - ;; unspecifyed - nil - ;; specifyed - (if (listp min-or-values) - ;; min-or-values is values - ;; #### NOTE: this is actually only a hack for time zones. - (let ((val (and (string-match "[ \t]*\\([^ \t]+\\)[ \t]*" str) - (match-string 1 str)))) - (if (and val (setq val (assoc val min-or-values))) - (list (cadr val)) - (nndiary-error "invalid syntax"))) - ;; min-or-values is min - (mapcar - (lambda (val) - (let ((res (split-string val "-"))) - (cond - ((= (length res) 1) - (nndiary-string-to-number (car res) min-or-values max)) - ((= (length res) 2) - ;; don't know if crontab accepts this, but ensure - ;; that BEG is <= END - (let ((beg (nndiary-string-to-number (car res) min-or-values max)) - (end (nndiary-string-to-number (cadr res) min-or-values max))) - (cond ((< beg end) - (cons beg end)) - ((= beg end) - beg) - (t - (cons end beg))))) - (t - (nndiary-error "invalid syntax"))) - )) - (split-string str ","))) - )) - -;; ### FIXME: remove this function if it's used only once. -(defun nndiary-parse-schedule (head min-or-values max) - ;; Parse the cron-like value of header X-Diary-HEAD in current buffer. - ;; - Returns nil if `*' - ;; - Otherwise returns a list of integers and/or ranges (BEG . END) - ;; The exception is the Timze-Zone value which is always of the form (STR). - ;; Signals are caught by `nndary-schedule'. - (let ((header (format "^X-Diary-%s: \\(.*\\)$" head))) - (goto-char (point-min)) - (if (not (re-search-forward header nil t)) - (nndiary-error "header missing") - ;; else - (nndiary-parse-schedule-value (match-string 1) min-or-values max)) - )) - -(defun nndiary-max (spec) - ;; Returns the max of specification SPEC, or nil for permanent schedules. - (unless (null spec) - (let ((elts spec) - (max 0) - elt) - (while (setq elt (pop elts)) - (if (integerp elt) - (and (> elt max) (setq max elt)) - (and (> (cdr elt) max) (setq max (cdr elt))))) - max))) - -(defun nndiary-flatten (spec min &optional max) - ;; flatten the spec by expanding ranges to all possible values. - (let (flat n) - (cond ((null spec) - ;; this happens when I flatten something else than one of my - ;; schedules (a list of read articles for instance). - (unless (null max) - (setq n min) - (while (<= n max) - (push n flat) - (setq n (1+ n))))) - (t - (let ((elts spec) - elt) - (while (setq elt (pop elts)) - (if (integerp elt) - (push elt flat) - ;; else - (setq n (car elt)) - (while (<= n (cdr elt)) - (push n flat) - (setq n (1+ n)))))))) - flat)) - -(defun nndiary-unflatten (spec) - ;; opposite of flatten: build ranges if possible - (setq spec (sort spec '<)) - (let (min max res) - (while (setq min (pop spec)) - (setq max min) - (while (and (car spec) (= (car spec) (1+ max))) - (setq max (1+ max)) - (pop spec)) - (if (= max min) - (setq res (append res (list min))) - (setq res (append res (list (cons min max)))))) - res)) - -(defun nndiary-compute-reminders (date) - ;; Returns a list of times corresponding to the reminders of date DATE. - ;; See the comment in `nndiary-reminders' about rounding. - (let* ((reminders nndiary-reminders) - (date-elts (decode-time date)) - ;; ### NOTE: out-of-range values are accepted by encode-time. This - ;; makes our life easier. - (monday (- (nth 3 date-elts) - (if nndiary-week-starts-on-monday - (if (zerop (nth 6 date-elts)) - 6 - (- (nth 6 date-elts) 1)) - (nth 6 date-elts)))) - reminder res) - ;; remove the DOW and DST entries - (setcdr (nthcdr 5 date-elts) (nthcdr 8 date-elts)) - (while (setq reminder (pop reminders)) - (push - (cond ((eq (cdr reminder) 'minute) - (subtract-time - (apply 'encode-time 0 (nthcdr 1 date-elts)) - (seconds-to-time (* (car reminder) 60.0)))) - ((eq (cdr reminder) 'hour) - (subtract-time - (apply 'encode-time 0 0 (nthcdr 2 date-elts)) - (seconds-to-time (* (car reminder) 3600.0)))) - ((eq (cdr reminder) 'day) - (subtract-time - (apply 'encode-time 0 0 0 (nthcdr 3 date-elts)) - (seconds-to-time (* (car reminder) 86400.0)))) - ((eq (cdr reminder) 'week) - (subtract-time - (apply 'encode-time 0 0 0 monday (nthcdr 4 date-elts)) - (seconds-to-time (* (car reminder) 604800.0)))) - ((eq (cdr reminder) 'month) - (subtract-time - (apply 'encode-time 0 0 0 1 (nthcdr 4 date-elts)) - (seconds-to-time (* (car reminder) 18748800.0)))) - ((eq (cdr reminder) 'year) - (subtract-time - (apply 'encode-time 0 0 0 1 1 (nthcdr 5 date-elts)) - (seconds-to-time (* (car reminder) 400861056.0))))) - res)) - (sort res 'time-less-p))) - -(defun nndiary-last-occurence (sched) - ;; Returns the last occurence of schedule SCHED as an Emacs time struct, or - ;; nil for permanent schedule or errors. - (let ((minute (nndiary-max (nth 0 sched))) - (hour (nndiary-max (nth 1 sched))) - (year (nndiary-max (nth 4 sched))) - (time-zone (or (and (nth 6 sched) (car (nth 6 sched))) - (current-time-zone)))) - (when year - (or minute (setq minute 59)) - (or hour (setq hour 23)) - ;; I'll just compute all possible values and test them by decreasing - ;; order until one succeeds. This is probably quide rude, but I got - ;; bored in finding a good algorithm for doing that ;-) - ;; ### FIXME: remove identical entries. - (let ((dom-list (nth 2 sched)) - (month-list (sort (nndiary-flatten (nth 3 sched) 1 12) '>)) - (year-list (sort (nndiary-flatten (nth 4 sched) 1971) '>)) - (dow-list (nth 5 sched))) - ;; Special case: an asterisk in one of the days specifications means - ;; that only the other should be taken into account. If both are - ;; unspecified, you would get all possible days in both. - (cond ((null dow-list) - ;; this gets all days if dom-list is nil - (setq dom-list (nndiary-flatten dom-list 1 31))) - ((null dom-list) - ;; this also gets all days if dow-list is nil - (setq dow-list (nndiary-flatten dow-list 0 6))) - (t - (setq dom-list (nndiary-flatten dom-list 1 31)) - (setq dow-list (nndiary-flatten dow-list 0 6)))) - (or - (catch 'found - (while (setq year (pop year-list)) - (let ((months month-list) - month) - (while (setq month (pop months)) - ;; Now we must merge the Dows with the Doms. To do that, we - ;; have to know which day is the 1st one for this month. - ;; Maybe there's simpler, but decode-time(encode-time) will - ;; give us the answer. - (let ((first (nth 6 (decode-time - (encode-time 0 0 0 1 month year - time-zone)))) - (max (cond ((= month 2) - (if (date-leap-year-p year) 29 28)) - ((<= month 7) - (if (zerop (% month 2)) 30 31)) - (t - (if (zerop (% month 2)) 31 30)))) - (doms dom-list) - (dows dow-list) - day days) - ;; first, review the doms to see if they are valid. - (while (setq day (pop doms)) - (and (<= day max) - (push day days))) - ;; second add all possible dows - (while (setq day (pop dows)) - ;; days start at 1. - (setq day (1+ (- day first))) - (and (< day 0) (setq day (+ 7 day))) - (while (<= day max) - (push day days) - (setq day (+ 7 day)))) - ;; Finally, if we have some days, they are valid - (when days - (sort days '>) - (throw 'found - (encode-time 0 minute hour - (car days) month year time-zone))) - ))))) - ;; There's an upper limit, but we didn't find any last occurence. - ;; This means that the schedule is undecidable. This can happen if - ;; you happen to say something like "each Feb 31 until 2038". - (progn - (nnheader-report 'nndiary "Undecidable schedule") - nil)) - )))) - -(defun nndiary-next-occurence (sched now) - ;; Returns the next occurence of schedule SCHED, starting from time NOW. - ;; If there's no next occurence, returns the last one (if any) which is then - ;; in the past. - (let* ((today (decode-time now)) - (this-minute (nth 1 today)) - (this-hour (nth 2 today)) - (this-day (nth 3 today)) - (this-month (nth 4 today)) - (this-year (nth 5 today)) - (minute-list (sort (nndiary-flatten (nth 0 sched) 0 59) '<)) - (hour-list (sort (nndiary-flatten (nth 1 sched) 0 23) '<)) - (dom-list (nth 2 sched)) - (month-list (sort (nndiary-flatten (nth 3 sched) 1 12) '<)) - (years (if (nth 4 sched) - (sort (nndiary-flatten (nth 4 sched) 1971) '<) - t)) - (dow-list (nth 5 sched)) - (year (1- this-year)) - (time-zone (or (and (nth 6 sched) (car (nth 6 sched))) - (current-time-zone)))) - ;; Special case: an asterisk in one of the days specifications means that - ;; only the other should be taken into account. If both are unspecified, - ;; you would get all possible days in both. - (cond ((null dow-list) - ;; this gets all days if dom-list is nil - (setq dom-list (nndiary-flatten dom-list 1 31))) - ((null dom-list) - ;; this also gets all days if dow-list is nil - (setq dow-list (nndiary-flatten dow-list 0 6))) - (t - (setq dom-list (nndiary-flatten dom-list 1 31)) - (setq dow-list (nndiary-flatten dow-list 0 6)))) - ;; Remove past years. - (unless (eq years t) - (while (and (car years) (< (car years) this-year)) - (pop years))) - (if years - ;; Because we might not be limited in years, we must guard against - ;; infinite loops. Appart from cases like Feb 31, there are probably - ;; other ones, (no monday XXX 2nd etc). I don't know any algorithm to - ;; decide this, so I assume that if we reach 10 years later, the - ;; schedule is undecidable. - (or - (catch 'found - (while (if (eq years t) - (and (setq year (1+ year)) - (<= year (+ 10 this-year))) - (setq year (pop years))) - (let ((months month-list) - month) - ;; Remove past months for this year. - (and (= year this-year) - (while (and (car months) (< (car months) this-month)) - (pop months))) - (while (setq month (pop months)) - ;; Now we must merge the Dows with the Doms. To do that, we - ;; have to know which day is the 1st one for this month. - ;; Maybe there's simpler, but decode-time(encode-time) will - ;; give us the answer. - (let ((first (nth 6 (decode-time - (encode-time 0 0 0 1 month year - time-zone)))) - (max (cond ((= month 2) - (if (date-leap-year-p year) 29 28)) - ((<= month 7) - (if (zerop (% month 2)) 30 31)) - (t - (if (zerop (% month 2)) 31 30)))) - (doms dom-list) - (dows dow-list) - day days) - ;; first, review the doms to see if they are valid. - (while (setq day (pop doms)) - (and (<= day max) - (push day days))) - ;; second add all possible dows - (while (setq day (pop dows)) - ;; days start at 1. - (setq day (1+ (- day first))) - (and (< day 0) (setq day (+ 7 day))) - (while (<= day max) - (push day days) - (setq day (+ 7 day)))) - ;; Aaaaaaall right. Now we have a valid list of DAYS for - ;; this month and this year. - (when days - (setq days (sort days '<)) - ;; Remove past days for this year and this month. - (and (= year this-year) - (= month this-month) - (while (and (car days) (< (car days) this-day)) - (pop days))) - (while (setq day (pop days)) - (let ((hours hour-list) - hour) - ;; Remove past hours for this year, this month and - ;; this day. - (and (= year this-year) - (= month this-month) - (= day this-day) - (while (and (car hours) - (< (car hours) this-hour)) - (pop hours))) - (while (setq hour (pop hours)) - (let ((minutes minute-list) - minute) - ;; Remove past hours for this year, this month, - ;; this day and this hour. - (and (= year this-year) - (= month this-month) - (= day this-day) - (= hour this-hour) - (while (and (car minutes) - (< (car minutes) this-minute)) - (pop minutes))) - (while (setq minute (pop minutes)) - ;; Ouch! Here, we've got a complete valid - ;; schedule. It's a good one if it's in the - ;; future. - (let ((time (encode-time 0 minute hour day - month year - time-zone))) - (and (time-less-p now time) - (throw 'found time))) - )))) - )) - ))) - )) - (nndiary-last-occurence sched)) - ;; else - (nndiary-last-occurence sched)) - )) - -(defun nndiary-expired-article-p (file) - (with-temp-buffer - (if (nnheader-insert-head file) - (let ((sched (nndiary-schedule))) - ;; An article has expired if its last schedule (if any) is in the - ;; past. A permanent schedule never expires. - (and sched - (setq sched (nndiary-last-occurence sched)) - (time-less-p sched (current-time)))) - ;; else - (nnheader-report 'nndiary "Could not read file %s" file) - nil) - )) - -(defun nndiary-renew-article-p (file timestamp) - (erase-buffer) - (if (nnheader-insert-head file) - (let ((now (current-time)) - (sched (nndiary-schedule))) - ;; The article should be re-considered as unread if there's a reminder - ;; between the group timestamp and the current time. - (when (and sched (setq sched (nndiary-next-occurence sched now))) - (let ((reminders ;; add the next occurence itself at the end. - (append (nndiary-compute-reminders sched) (list sched)))) - (while (and reminders (time-less-p (car reminders) timestamp)) - (pop reminders)) - ;; The reminders might be empty if the last date is in the past, - ;; or we've got at least the next occurence itself left. All past - ;; dates are renewed. - (or (not reminders) - (time-less-p (car reminders) now))) - )) - ;; else - (nnheader-report 'nndiary "Could not read file %s" file) - nil)) - -;; The end... =============================================================== - -(mapcar - (lambda (elt) - (let ((header (intern (format "X-Diary-%s" (car elt))))) - ;; Required for building NOV databases and some other stuff - (add-to-list 'gnus-extra-headers header) - (add-to-list 'nnmail-extra-headers header))) - nndiary-headers) - -(unless (assoc "nndiary" gnus-valid-select-methods) - (gnus-declare-backend "nndiary" 'post-mail 'respool 'address)) - -(provide 'nndiary) - - -;;; arch-tag: 9c542b95-92e7-4ace-a038-330ab296e203 -;;; nndiary.el ends here diff --git a/xemacs-packages/gnus/lisp/nndir.el b/xemacs-packages/gnus/lisp/nndir.el deleted file mode 100644 index 85aff9c8..00000000 --- a/xemacs-packages/gnus/lisp/nndir.el +++ /dev/null @@ -1,102 +0,0 @@ -;;; nndir.el --- single directory newsgroup access for Gnus - -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(require 'nnheader) -(require 'nnmh) -(require 'nnml) -(require 'nnoo) -(eval-when-compile (require 'cl)) - -(nnoo-declare nndir - nnml nnmh) - -(defvoo nndir-directory nil - "Where nndir will look for groups." - nnml-current-directory nnmh-current-directory) - -(defvoo nndir-nov-is-evil nil - "*Non-nil means that nndir will never retrieve NOV headers." - nnml-nov-is-evil) - - - -(defvoo nndir-current-group "" nil nnml-current-group nnmh-current-group) -(defvoo nndir-top-directory nil nil nnml-directory nnmh-directory) -(defvoo nndir-get-new-mail nil nil nnml-get-new-mail nnmh-get-new-mail) - -(defvoo nndir-status-string "" nil nnmh-status-string) -(defconst nndir-version "nndir 1.0") - - - -;;; Interface functions. - -(nnoo-define-basics nndir) - -(deffoo nndir-open-server (server &optional defs) - (setq nndir-directory - (or (cadr (assq 'nndir-directory defs)) - server)) - (unless (assq 'nndir-directory defs) - (push `(nndir-directory ,server) defs)) - (push `(nndir-current-group - ,(file-name-nondirectory (directory-file-name nndir-directory))) - defs) - (push `(nndir-top-directory - ,(file-name-directory (directory-file-name nndir-directory))) - defs) - (nnoo-change-server 'nndir server defs) - (let (err) - (cond - ((not (condition-case arg - (file-exists-p nndir-directory) - (ftp-error (setq err (format "%s" arg))))) - (nndir-close-server) - (nnheader-report - 'nndir (or err "No such file or directory: %s" nndir-directory))) - ((not (file-directory-p (file-truename nndir-directory))) - (nndir-close-server) - (nnheader-report 'nndir "Not a directory: %s" nndir-directory)) - (t - (nnheader-report 'nndir "Opened server %s using directory %s" - server nndir-directory) - t)))) - -(nnoo-map-functions nndir - (nnml-retrieve-headers 0 nndir-current-group 0 0) - (nnml-request-article 0 nndir-current-group 0 0) - (nnmh-request-group nndir-current-group 0 0) - (nnml-close-group nndir-current-group 0) - (nnml-request-list (nnoo-current-server 'nndir) nndir-directory) - (nnml-request-newsgroups (nnoo-current-server 'nndir) nndir-directory)) - -(provide 'nndir) - -;;; arch-tag: 56f09f68-0e4e-4816-818a-df80b4a394c8 -;;; nndir.el ends here diff --git a/xemacs-packages/gnus/lisp/nndoc.el b/xemacs-packages/gnus/lisp/nndoc.el deleted file mode 100644 index b3df29fd..00000000 --- a/xemacs-packages/gnus/lisp/nndoc.el +++ /dev/null @@ -1,1028 +0,0 @@ -;;; nndoc.el --- single file access for Gnus - -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Masanobu UMEDA -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; For Outlook mail boxes format, see http://mbx2mbox.sourceforge.net/ - -;;; Code: - -(require 'nnheader) -(require 'message) -(require 'nnmail) -(require 'nnoo) -(require 'gnus-util) -(require 'mm-util) -(eval-when-compile (require 'cl)) - -(nnoo-declare nndoc) - -(defvoo nndoc-article-type 'guess - "*Type of the file. -One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward', -`rfc934', `rfc822-forward', `mime-parts', `standard-digest', -`slack-digest', `clari-briefs', `nsmail', `outlook', `oe-dbx', -`mailman', `exim-bounce', or `guess'.") - -(defvoo nndoc-post-type 'mail - "*Whether the nndoc group is `mail' or `post'.") - -(defvoo nndoc-open-document-hook 'nnheader-ms-strip-cr - "Hook run after opening a document. -The default function removes all trailing carriage returns -from the document.") - -(defvar nndoc-type-alist - `((mmdf - (article-begin . "^\^A\^A\^A\^A\n") - (body-end . "^\^A\^A\^A\^A\n")) - (mime-digest - (article-begin . "") - (head-begin . "^ ?\n") - (head-end . "^ ?$") - (body-end . "") - (file-end . "") - (subtype digest guess)) - (mime-parts - (generate-head-function . nndoc-generate-mime-parts-head) - (article-transform-function . nndoc-transform-mime-parts)) - (nsmail - (article-begin . "^From - ")) - (news - (article-begin . "^Path:")) - (rnews - (article-begin . "^#! *rnews +\\([0-9]+\\) *\n") - (body-end-function . nndoc-rnews-body-end)) - (mbox - (article-begin-function . nndoc-mbox-article-begin) - (body-end-function . nndoc-mbox-body-end)) - (babyl - (article-begin . "\^_\^L *\n") - (body-end . "\^_") - (body-begin-function . nndoc-babyl-body-begin) - (head-begin-function . nndoc-babyl-head-begin)) - (exim-bounce - (article-begin . "^------ This is a copy of the message, including all the headers. ------\n\n") - (body-end-function . nndoc-exim-bounce-body-end-function)) - (rfc934 - (article-begin . "^--.*\n+") - (body-end . "^--.*$") - (prepare-body-function . nndoc-unquote-dashes)) - (mailman - (article-begin . "^--__--__--\n\nMessage:") - (body-end . "^--__--__--$") - (prepare-body-function . nndoc-unquote-dashes)) - (clari-briefs - (article-begin . "^ \\*") - (body-end . "^\t------*[ \t]^*\n^ \\*") - (body-begin . "^\t") - (head-end . "^\t") - (generate-head-function . nndoc-generate-clari-briefs-head) - (article-transform-function . nndoc-transform-clari-briefs)) - - (standard-digest - (first-article . ,(concat "^" (make-string 70 ?-) "\n *\n+")) - (article-begin . ,(concat "^\n" (make-string 30 ?-) "\n *\n+")) - (prepare-body-function . nndoc-unquote-dashes) - (body-end-function . nndoc-digest-body-end) - (head-end . "^ *$") - (body-begin . "^ *\n") - (file-end . "^End of .*digest.*[0-9].*\n\\*\\*\\|^End of.*Digest *$") - (subtype digest guess)) - (slack-digest - (article-begin . "^------------------------------*[\n \t]+") - (head-end . "^ ?$") - (body-end-function . nndoc-digest-body-end) - (body-begin . "^ ?$") - (file-end . "^End of") - (prepare-body-function . nndoc-unquote-dashes) - (subtype digest guess)) - (lanl-gov-announce - (article-begin . "^\\\\\\\\\n") - (head-begin . "^Paper.*:") - (head-end . "\\(^\\\\\\\\.*\n\\|-----------------\\)") - (body-begin . "") - (body-end . "\\(-------------------------------------------------\\|%-%-%-%-%-%-%-%-%-%-%-%-%-%-\\|%%--%%--%%--%%--%%--%%--%%--%%--\\|%%%---%%%---%%%---%%%---\\)") - (file-end . "\\(^Title: Recent Seminal\\|%%%---%%%---%%%---%%%---\\)") - (generate-head-function . nndoc-generate-lanl-gov-head) - (article-transform-function . nndoc-transform-lanl-gov-announce) - (subtype preprints guess)) - (rfc822-forward - (article-begin . "^\n+") - (body-end-function . nndoc-rfc822-forward-body-end-function) - (generate-head-function . nndoc-rfc822-forward-generate-head) - (generate-article-function . nndoc-rfc822-forward-generate-article)) - (outlook - (article-begin-function . nndoc-outlook-article-begin) - (body-end . "\0")) - (oe-dbx ;; Outlook Express DBX format - (dissection-function . nndoc-oe-dbx-dissection) - (generate-head-function . nndoc-oe-dbx-generate-head) - (generate-article-function . nndoc-oe-dbx-generate-article)) - (forward - (article-begin . "^-+ \\(Start of \\)?forwarded message.*\n+") - (body-end . "^-+ End \\(of \\)?forwarded message.*$") - (prepare-body-function . nndoc-unquote-dashes)) - (mail-in-mail ;; Wild guess on mailer daemon's messages or others - (article-begin-function . nndoc-mail-in-mail-article-begin)) - (guess - (guess . t) - (subtype nil)) - (digest - (guess . t) - (subtype nil)) - (preprints - (guess . t) - (subtype nil)))) - -(defvar nndoc-binary-file-names ".[Dd][Bb][Xx]$" - "Regexp for binary nndoc file names.") - - -(defvoo nndoc-file-begin nil) -(defvoo nndoc-first-article nil) -(defvoo nndoc-article-begin nil) -(defvoo nndoc-head-begin nil) -(defvoo nndoc-head-end nil) -(defvoo nndoc-file-end nil) -(defvoo nndoc-body-begin nil) -(defvoo nndoc-body-end-function nil) -(defvoo nndoc-body-begin-function nil) -(defvoo nndoc-head-begin-function nil) -(defvoo nndoc-body-end nil) -;; nndoc-dissection-alist is a list of sublists. Each sublist holds the -;; following items. ARTICLE acts as the association key and is an ordinal -;; starting at 1. HEAD-BEGIN [0], HEAD-END [1], BODY-BEGIN [2] and BODY-END -;; [3] are positions in the `nndoc' buffer. LINE-COUNT [4] is a count of -;; lines in the body. For MIME dissections only, ARTICLE-INSERT [5] and -;; SUMMARY-INSERT [6] give headers to insert for full article or summary line -;; generation, respectively. Other headers usually follow directly from the -;; buffer. Value `nil' means no insert. -(defvoo nndoc-dissection-alist nil) -(defvoo nndoc-prepare-body-function nil) -(defvoo nndoc-generate-head-function nil) -(defvoo nndoc-article-transform-function nil) -(defvoo nndoc-article-begin-function nil) -(defvoo nndoc-generate-article-function nil) -(defvoo nndoc-dissection-function nil) - -(defvoo nndoc-status-string "") -(defvoo nndoc-group-alist nil) -(defvoo nndoc-current-buffer nil - "Current nndoc news buffer.") -(defvoo nndoc-address nil) - -(defconst nndoc-version "nndoc 1.0" - "nndoc version.") - - - -;;; Interface functions - -(nnoo-define-basics nndoc) - -(deffoo nndoc-retrieve-headers (articles &optional newsgroup server fetch-old) - (when (nndoc-possibly-change-buffer newsgroup server) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (let (article entry) - (if (stringp (car articles)) - 'headers - (while articles - (when (setq entry (cdr (assq (setq article (pop articles)) - nndoc-dissection-alist))) - (insert (format "221 %d Article retrieved.\n" article)) - (if nndoc-generate-head-function - (funcall nndoc-generate-head-function article) - (insert-buffer-substring - nndoc-current-buffer (car entry) (nth 1 entry))) - (goto-char (point-max)) - (unless (eq (char-after (1- (point))) ?\n) - (insert "\n")) - (insert (format "Lines: %d\n" (nth 4 entry))) - (insert ".\n"))) - - (nnheader-fold-continuation-lines) - 'headers))))) - -(deffoo nndoc-request-article (article &optional newsgroup server buffer) - (nndoc-possibly-change-buffer newsgroup server) - (save-excursion - (let ((buffer (or buffer nntp-server-buffer)) - (entry (cdr (assq article nndoc-dissection-alist))) - beg) - (set-buffer buffer) - (erase-buffer) - (when entry - (cond - ((stringp article) nil) - (nndoc-generate-article-function - (funcall nndoc-generate-article-function article)) - (t - (insert-buffer-substring - nndoc-current-buffer (car entry) (nth 1 entry)) - (insert "\n") - (setq beg (point)) - (insert-buffer-substring - nndoc-current-buffer (nth 2 entry) (nth 3 entry)) - (goto-char beg) - (when nndoc-prepare-body-function - (funcall nndoc-prepare-body-function)) - (when nndoc-article-transform-function - (funcall nndoc-article-transform-function article)) - t)))))) - -(deffoo nndoc-request-group (group &optional server dont-check) - "Select news GROUP." - (let (number) - (cond - ((not (nndoc-possibly-change-buffer group server)) - (nnheader-report 'nndoc "No such file or buffer: %s" - nndoc-address)) - (dont-check - (nnheader-report 'nndoc "Selected group %s" group) - t) - ((zerop (setq number (length nndoc-dissection-alist))) - (nndoc-close-group group) - (nnheader-report 'nndoc "No articles in group %s" group)) - (t - (nnheader-insert "211 %d %d %d %s\n" number 1 number group))))) - -(deffoo nndoc-request-type (group &optional article) - (cond ((not article) 'unknown) - (nndoc-post-type nndoc-post-type) - (t 'unknown))) - -(deffoo nndoc-close-group (group &optional server) - (nndoc-possibly-change-buffer group server) - (and nndoc-current-buffer - (buffer-name nndoc-current-buffer) - (kill-buffer nndoc-current-buffer)) - (setq nndoc-group-alist (delq (assoc group nndoc-group-alist) - nndoc-group-alist)) - (setq nndoc-current-buffer nil) - (nnoo-close-server 'nndoc server) - (setq nndoc-dissection-alist nil) - t) - -(deffoo nndoc-request-list (&optional server) - nil) - -(deffoo nndoc-request-newgroups (date &optional server) - nil) - -(deffoo nndoc-request-list-newsgroups (&optional server) - nil) - - -;;; Internal functions. - -(defun nndoc-possibly-change-buffer (group source) - (let (buf) - (cond - ;; The current buffer is this group's buffer. - ((and nndoc-current-buffer - (buffer-name nndoc-current-buffer) - (eq nndoc-current-buffer - (setq buf (cdr (assoc group nndoc-group-alist)))))) - ;; We change buffers by taking an old from the group alist. - ;; `source' is either a string (a file name) or a buffer object. - (buf - (setq nndoc-current-buffer buf)) - ;; It's a totally new group. - ((or (and (bufferp nndoc-address) - (buffer-name nndoc-address)) - (and (stringp nndoc-address) - (file-exists-p nndoc-address) - (not (file-directory-p nndoc-address)))) - (push (cons group (setq nndoc-current-buffer - (get-buffer-create - (concat " *nndoc " group "*")))) - nndoc-group-alist) - (setq nndoc-dissection-alist nil) - (save-excursion - (set-buffer nndoc-current-buffer) - (erase-buffer) - (if (and (stringp nndoc-address) - (string-match nndoc-binary-file-names nndoc-address)) - (let ((coding-system-for-read 'binary)) - (mm-insert-file-contents nndoc-address)) - (if (stringp nndoc-address) - (nnheader-insert-file-contents nndoc-address) - (insert-buffer-substring nndoc-address)) - (run-hooks 'nndoc-open-document-hook))))) - ;; Initialize the nndoc structures according to this new document. - (when (and nndoc-current-buffer - (not nndoc-dissection-alist)) - (save-excursion - (set-buffer nndoc-current-buffer) - (nndoc-set-delims) - (if (eq nndoc-article-type 'mime-parts) - (nndoc-dissect-mime-parts) - (nndoc-dissect-buffer)))) - (unless nndoc-current-buffer - (nndoc-close-server)) - ;; Return whether we managed to select a file. - nndoc-current-buffer)) - -;;; -;;; Deciding what document type we have -;;; - -(defun nndoc-set-delims () - "Set the nndoc delimiter variables according to the type of the document." - (let ((vars '(nndoc-file-begin - nndoc-first-article - nndoc-article-begin-function - nndoc-head-begin nndoc-head-end - nndoc-file-end nndoc-article-begin - nndoc-body-begin nndoc-body-end-function nndoc-body-end - nndoc-prepare-body-function nndoc-article-transform-function - nndoc-generate-head-function nndoc-body-begin-function - nndoc-head-begin-function - nndoc-generate-article-function - nndoc-dissection-function))) - (while vars - (set (pop vars) nil))) - (let (defs) - ;; Guess away until we find the real file type. - (while (assq 'guess (setq defs (cdr (assq nndoc-article-type - nndoc-type-alist)))) - (setq nndoc-article-type (nndoc-guess-type nndoc-article-type))) - ;; Set the nndoc variables. - (while defs - (set (intern (format "nndoc-%s" (caar defs))) - (cdr (pop defs)))))) - -(defun nndoc-guess-type (subtype) - (let ((alist nndoc-type-alist) - results result entry) - (while (and (not result) - (setq entry (pop alist))) - (when (memq subtype (or (cdr (assq 'subtype entry)) '(guess))) - (goto-char (point-min)) - ;; Remove blank lines. - (while (eq (following-char) ?\n) - (delete-char 1)) - (when (numberp (setq result (funcall (intern - (format "nndoc-%s-type-p" - (car entry)))))) - (push (cons result entry) results) - (setq result nil)))) - (unless (or result results) - (error "Document is not of any recognized type")) - (if result - (car entry) - (cadar (last (sort results 'car-less-than-car)))))) - -;;; -;;; Built-in type predicates and functions -;;; - -(defun nndoc-mbox-type-p () - (when (looking-at message-unix-mail-delimiter) - t)) - -(defun nndoc-mbox-article-begin () - (when (re-search-forward (concat "^" message-unix-mail-delimiter) nil t) - (goto-char (match-beginning 0)))) - -(defun nndoc-mbox-body-end () - (let ((beg (point)) - len end) - (when - (save-excursion - (and (re-search-backward - (concat "^" message-unix-mail-delimiter) nil t) - (setq end (point)) - (search-forward "\n\n" beg t) - (re-search-backward - "^Content-Length:[ \t]*\\([0-9]+\\) *$" end t) - (setq len (string-to-number (match-string 1))) - (search-forward "\n\n" beg t) - (unless (= (setq len (+ (point) len)) (point-max)) - (and (< len (point-max)) - (goto-char len) - (looking-at message-unix-mail-delimiter))))) - (goto-char len)))) - -(defun nndoc-mmdf-type-p () - (when (looking-at "\^A\^A\^A\^A$") - t)) - -(defun nndoc-news-type-p () - (when (looking-at "^Path:.*\n") - t)) - -(defun nndoc-rnews-type-p () - (when (looking-at "#! *rnews") - t)) - -(defun nndoc-rnews-body-end () - (and (re-search-backward nndoc-article-begin nil t) - (forward-line 1) - (goto-char (+ (point) (string-to-number (match-string 1)))))) - -(defun nndoc-babyl-type-p () - (when (re-search-forward "\^_\^L *\n" nil t) - t)) - -(defun nndoc-babyl-body-begin () - (re-search-forward "^\n" nil t) - (when (looking-at "\\*\\*\\* EOOH \\*\\*\\*") - (let ((next (or (save-excursion - (re-search-forward nndoc-article-begin nil t)) - (point-max)))) - (unless (re-search-forward "^\n" next t) - (goto-char next) - (forward-line -1) - (insert "\n") - (forward-line -1))))) - -(defun nndoc-babyl-head-begin () - (when (re-search-forward "^[0-9].*\n" nil t) - (when (looking-at "\\*\\*\\* EOOH \\*\\*\\*") - (forward-line 1)) - t)) - -(defun nndoc-forward-type-p () - (when (and (re-search-forward "^-+ \\(Start of \\)?forwarded message.*\n+" - nil t) - (looking-at "[\r\n]*[a-zA-Z][a-zA-Z0-9-]*:\\|^>?From ")) - t)) - -(defun nndoc-rfc934-type-p () - (when (and (re-search-forward "^-+ Start of forwarded.*\n+" nil t) - (not (re-search-forward "^Subject:.*digest" nil t)) - (not (re-search-backward "^From:" nil t 2)) - (not (re-search-forward "^From:" nil t 2))) - t)) - -(defun nndoc-mailman-type-p () - (when (re-search-forward "^--__--__--\n+" nil t) - t)) - -(defun nndoc-rfc822-forward-type-p () - (save-restriction - (message-narrow-to-head) - (when (re-search-forward "^Content-Type: *message/rfc822" nil t) - t))) - -(defun nndoc-rfc822-forward-body-end-function () - (goto-char (point-max))) - -(defun nndoc-rfc822-forward-generate-article (article &optional head) - (let ((entry (cdr (assq article nndoc-dissection-alist))) - (begin (point)) - encoding) - (with-current-buffer nndoc-current-buffer - (save-restriction - (message-narrow-to-head) - (setq encoding (message-fetch-field "content-transfer-encoding")))) - (insert-buffer-substring nndoc-current-buffer (car entry) (nth 3 entry)) - (when encoding - (save-restriction - (narrow-to-region begin (point-max)) - (mm-decode-content-transfer-encoding - (intern (downcase (mail-header-strip encoding)))))) - (when head - (goto-char begin) - (when (search-forward "\n\n" nil t) - (delete-region (1- (point)) (point-max))))) - t) - -(defun nndoc-rfc822-forward-generate-head (article) - (nndoc-rfc822-forward-generate-article article 'head)) - -(defun nndoc-mime-parts-type-p () - (let ((case-fold-search t) - (limit (search-forward "\n\n" nil t))) - (goto-char (point-min)) - (when (and limit - (re-search-forward - (concat "\ -^Content-Type:[ \t]*multipart/[a-z]+ *; *\\(\\(\n[ \t]\\)?.*;\\)*" - "\\(\n[ \t]\\)?[ \t]*boundary=\"?[^\"\n]*[^\" \t\n]") - limit t)) - t))) - -(defun nndoc-transform-mime-parts (article) - (let* ((entry (cdr (assq article nndoc-dissection-alist))) - (headers (nth 5 entry))) - (when headers - (goto-char (point-min)) - (insert headers)))) - -(defun nndoc-generate-mime-parts-head (article) - (let* ((entry (cdr (assq article nndoc-dissection-alist))) - (headers (nth 6 entry))) - (save-restriction - (narrow-to-region (point) (point)) - (insert-buffer-substring - nndoc-current-buffer (car entry) (nth 1 entry)) - (goto-char (point-max))) - (when headers - (insert headers)))) - -(defun nndoc-clari-briefs-type-p () - (when (let ((case-fold-search nil)) - (re-search-forward "^\t[^a-z]+ ([^a-z]+) --" nil t)) - t)) - -(defun nndoc-transform-clari-briefs (article) - (goto-char (point-min)) - (when (looking-at " *\\*\\(.*\\)\n") - (replace-match "" t t)) - (nndoc-generate-clari-briefs-head article)) - -(defun nndoc-generate-clari-briefs-head (article) - (let ((entry (cdr (assq article nndoc-dissection-alist))) - subject from) - (save-excursion - (set-buffer nndoc-current-buffer) - (save-restriction - (narrow-to-region (car entry) (nth 3 entry)) - (goto-char (point-min)) - (when (looking-at " *\\*\\(.*\\)$") - (setq subject (match-string 1)) - (when (string-match "[ \t]+$" subject) - (setq subject (substring subject 0 (match-beginning 0))))) - (when - (let ((case-fold-search nil)) - (re-search-forward - "^\t\\([^a-z]+\\(,[^(]+\\)? ([^a-z]+)\\) --" nil t)) - (setq from (match-string 1))))) - (insert "From: " "clari@clari.net (" (or from "unknown") ")" - "\nSubject: " (or subject "(no subject)") "\n"))) - -(defun nndoc-exim-bounce-type-p () - (and (re-search-forward "^------ This is a copy of the message, including all the headers. ------" nil t) - t)) - -(defun nndoc-exim-bounce-body-end-function () - (goto-char (point-max))) - - -(defun nndoc-mime-digest-type-p () - (let ((case-fold-search t) - boundary-id b-delimiter entry) - (when (and - (re-search-forward - (concat "^Content-Type: *multipart/digest;[ \t\n]*[ \t]" - "boundary=\"?\\([^\"\n]*[^\" \t\n]\\)") - nil t) - (match-beginning 1)) - (setq boundary-id (match-string 1) - b-delimiter (concat "\n--" boundary-id "[ \t]*$")) - (setq entry (assq 'mime-digest nndoc-type-alist)) - (setcdr entry - (list - (cons 'head-begin "^ ?\n") - (cons 'head-end "^ ?$") - (cons 'body-begin "^ ?\n") - (cons 'article-begin b-delimiter) - (cons 'body-end-function 'nndoc-digest-body-end) - (cons 'file-end (concat "^--" boundary-id "--[ \t]*$")))) - t))) - -(defun nndoc-standard-digest-type-p () - (when (and (re-search-forward (concat "^" (make-string 70 ?-) "\n\n") nil t) - (re-search-forward - (concat "\n\n" (make-string 30 ?-) "\n\n") nil t)) - t)) - -(defun nndoc-digest-body-end () - (and (re-search-forward nndoc-article-begin nil t) - (goto-char (match-beginning 0)))) - -(defun nndoc-slack-digest-type-p () - 0) - -(defun nndoc-lanl-gov-announce-type-p () - (when (let ((case-fold-search nil)) - (re-search-forward "^\\\\\\\\\nPaper\\( (\\*cross-listing\\*)\\)?: [a-zA-Z-\\.]+/[0-9]+" nil t)) - t)) - -(defun nndoc-transform-lanl-gov-announce (article) - (goto-char (point-max)) - (when (re-search-backward "^\\\\\\\\ +( *\\([^ ]*\\) , *\\([^ ]*\\))" nil t) - (replace-match "\n\nGet it at \\1 (\\2)" t nil)) - (goto-char (point-min)) - (while (re-search-forward "^\\\\\\\\$" nil t) - (replace-match "" t nil)) - (goto-char (point-min)) - (when (re-search-forward "^replaced with revised version +\\(.*[^ ]\\) +" nil t) - (replace-match "Date: \\1 (revised) " t nil)) - (goto-char (point-min)) - (unless (re-search-forward "^From" nil t) - (goto-char (point-min)) - (when (re-search-forward "^Authors?: \\(.*\\)" nil t) - (goto-char (point-min)) - (insert "From: " (match-string 1) "\n")))) - -(defun nndoc-generate-lanl-gov-head (article) - (let ((entry (cdr (assq article nndoc-dissection-alist))) - (from "") - subject date) - (save-excursion - (set-buffer nndoc-current-buffer) - (save-restriction - (narrow-to-region (car entry) (nth 1 entry)) - (goto-char (point-min)) - (when (looking-at "^Paper.*: \\([a-zA-Z-\\.]+/[0-9]+\\)") - (setq subject (concat " (" (match-string 1) ")")) - (when (re-search-forward "^From: \\(.*\\)" nil t) - (setq from (concat "<" - (cadr (funcall gnus-extract-address-components - (match-string 1))) ">"))) - (if (re-search-forward "^Date: +\\([^(]*\\)" nil t) - (setq date (match-string 1)) - (when (re-search-forward "^replaced with revised version +\\([^(]*\\)" nil t) - (setq date (match-string 1)))) - (when (re-search-forward "^Title: \\([^\f]*\\)\nAuthors?: \\(.*\\)" - nil t) - (setq subject (concat (match-string 1) subject)) - (setq from (concat (match-string 2) " " from)))))) - (while (and from (string-match "(\[^)\]*)" from)) - (setq from (replace-match "" t t from))) - (insert "From: " (or from "unknown") - "\nSubject: " (or subject "(no subject)") "\n") - (if date (insert "Date: " date)))) - -(defun nndoc-nsmail-type-p () - (when (looking-at "From - ") - t)) - -(defun nndoc-outlook-article-begin () - (prog1 (re-search-forward "From:\\|Received:" nil t) - (goto-char (match-beginning 0)))) - -(defun nndoc-outlook-type-p () - ;; FIXME: Is JMF the magic of outlook mailbox? -- ShengHuo. - (looking-at "JMF")) - -(defun nndoc-oe-dbx-type-p () - (looking-at (mm-string-as-multibyte "\317\255\022\376"))) - -(defun nndoc-read-little-endian () - (+ (prog1 (char-after) (forward-char 1)) - (lsh (prog1 (char-after) (forward-char 1)) 8) - (lsh (prog1 (char-after) (forward-char 1)) 16) - (lsh (prog1 (char-after) (forward-char 1)) 24))) - -(defun nndoc-oe-dbx-decode-block () - (list - (nndoc-read-little-endian) ;; this address - (nndoc-read-little-endian) ;; next address offset - (nndoc-read-little-endian) ;; blocksize - (nndoc-read-little-endian))) ;; next address - -(defun nndoc-oe-dbx-dissection () - (let ((i 0) blk p tp) - (goto-char 60117) ;; 0x0000EAD4+1 - (setq p (point)) - (unless (eobp) - (setq blk (nndoc-oe-dbx-decode-block))) - (while (and blk (> (car blk) 0) (or (zerop (nth 3 blk)) - (> (nth 3 blk) p))) - (push (list (incf i) p nil nil nil 0) nndoc-dissection-alist) - (while (and (> (car blk) 0) (> (nth 3 blk) p)) - (goto-char (1+ (nth 3 blk))) - (setq blk (nndoc-oe-dbx-decode-block))) - (if (or (<= (car blk) p) - (<= (nth 1 blk) 0) - (not (zerop (nth 3 blk)))) - (setq blk nil) - (setq tp (+ (car blk) (nth 1 blk) 17)) - (if (or (<= tp p) (>= tp (point-max))) - (setq blk nil) - (goto-char tp) - (setq p tp - blk (nndoc-oe-dbx-decode-block))))))) - -(defun nndoc-oe-dbx-generate-article (article &optional head) - (let ((entry (cdr (assq article nndoc-dissection-alist))) - (cur (current-buffer)) - (begin (point)) - blk p) - (with-current-buffer nndoc-current-buffer - (setq p (car entry)) - (while (> p (point-min)) - (goto-char p) - (setq blk (nndoc-oe-dbx-decode-block)) - (setq p (point)) - (with-current-buffer cur - (insert-buffer-substring nndoc-current-buffer p (+ p (nth 2 blk)))) - (setq p (1+ (nth 3 blk))))) - (goto-char begin) - (while (re-search-forward "\r$" nil t) - (delete-backward-char 1)) - (when head - (goto-char begin) - (when (search-forward "\n\n" nil t) - (setcar (cddddr entry) (count-lines (point) (point-max))) - (delete-region (1- (point)) (point-max)))) - t)) - -(defun nndoc-oe-dbx-generate-head (article) - (nndoc-oe-dbx-generate-article article 'head)) - -(defun nndoc-mail-in-mail-type-p () - (let (found) - (save-excursion - (catch 'done - (while (re-search-forward "\n\n[-A-Za-z0-9]+:" nil t) - (setq found 0) - (forward-line) - (while (looking-at "[ \t]\\|[-A-Za-z0-9]+:") - (if (looking-at "[-A-Za-z0-9]+:") - (setq found (1+ found))) - (forward-line)) - (if (and (> found 0) (looking-at "\n")) - (throw 'done 9999))) - nil)))) - -(defun nndoc-mail-in-mail-article-begin () - (let (point found) - (if (catch 'done - (while (re-search-forward "\n\n\\([-A-Za-z0-9]+:\\)" nil t) - (setq found 0) - (setq point (match-beginning 1)) - (forward-line) - (while (looking-at "[ \t]\\|[-A-Za-z0-9]+:") - (if (looking-at "[-A-Za-z0-9]+:") - (setq found (1+ found))) - (forward-line)) - (if (and (> found 0) (looking-at "\n")) - (throw 'done t))) - nil) - (goto-char point)))) - -(deffoo nndoc-request-accept-article (group &optional server last) - nil) - -;;; -;;; Functions for dissecting the documents -;;; - -(defun nndoc-search (regexp) - (prog1 - (re-search-forward regexp nil t) - (beginning-of-line))) - -(defun nndoc-dissect-buffer () - "Go through the document and partition it into heads/bodies/articles." - (let ((i 0) - (first t) - art-begin head-begin head-end body-begin body-end) - (setq nndoc-dissection-alist nil) - (save-excursion - (set-buffer nndoc-current-buffer) - (goto-char (point-min)) - ;; Remove blank lines. - (while (eq (following-char) ?\n) - (delete-char 1)) - (if nndoc-dissection-function - (funcall nndoc-dissection-function) - ;; Find the beginning of the file. - (when nndoc-file-begin - (nndoc-search nndoc-file-begin)) - ;; Go through the file. - (while (if (and first nndoc-first-article) - (nndoc-search nndoc-first-article) - (if art-begin - (goto-char art-begin) - (nndoc-article-begin))) - (setq first nil - art-begin nil) - (cond (nndoc-head-begin-function - (funcall nndoc-head-begin-function)) - (nndoc-head-begin - (nndoc-search nndoc-head-begin))) - (if (or (eobp) - (and nndoc-file-end - (looking-at nndoc-file-end))) - (goto-char (point-max)) - (setq head-begin (point)) - (nndoc-search (or nndoc-head-end "^$")) - (setq head-end (point)) - (if nndoc-body-begin-function - (funcall nndoc-body-begin-function) - (nndoc-search (or nndoc-body-begin "^\n"))) - (setq body-begin (point)) - (or (and nndoc-body-end-function - (funcall nndoc-body-end-function)) - (and nndoc-body-end - (nndoc-search nndoc-body-end)) - (and (nndoc-article-begin) - (setq art-begin (point))) - (progn - (goto-char (point-max)) - (when nndoc-file-end - (and (re-search-backward nndoc-file-end nil t) - (beginning-of-line))))) - (setq body-end (point)) - (push (list (incf i) head-begin head-end body-begin body-end - (count-lines body-begin body-end)) - nndoc-dissection-alist))))))) - -(defun nndoc-article-begin () - (if nndoc-article-begin-function - (funcall nndoc-article-begin-function) - (ignore-errors - (nndoc-search nndoc-article-begin)))) - -(defun nndoc-unquote-dashes () - "Unquote quoted non-separators in digests." - (while (re-search-forward "^- -"nil t) - (replace-match "-" t t))) - -;; Against compiler warnings. -(defvar nndoc-mime-split-ordinal) - -(defun nndoc-dissect-mime-parts () - "Go through a MIME composite article and partition it into sub-articles. -When a MIME entity contains sub-entities, dissection produces one article for -the header of this entity, and one article per sub-entity." - (setq nndoc-dissection-alist nil - nndoc-mime-split-ordinal 0) - (save-excursion - (set-buffer nndoc-current-buffer) - (nndoc-dissect-mime-parts-sub (point-min) (point-max) nil nil nil))) - -(defun nndoc-dissect-mime-parts-sub (head-begin body-end article-insert - position parent) - "Dissect an entity, within a composite MIME message. -The complete message or MIME entity extends from HEAD-BEGIN to BODY-END. -ARTICLE-INSERT should be added at beginning for generating a full article. -The string POSITION holds a dotted decimal representation of the article -position in the hierarchical structure, it is nil for the outer entity. -PARENT is the message-ID of the parent summary line, or nil for none." - (let ((case-fold-search t) - (message-id (nnmail-message-id)) - head-end body-begin summary-insert message-rfc822 multipart-any - subject content-type type subtype boundary-regexp) - ;; Gracefully handle a missing body. - (goto-char head-begin) - (if (or (and (eq (char-after) ?\n) (or (forward-char 1) t)) - (search-forward "\n\n" body-end t)) - (setq head-end (1- (point)) - body-begin (point)) - (setq head-end body-end - body-begin body-end)) - (narrow-to-region head-begin head-end) - ;; Save MIME attributes. - (goto-char head-begin) - (setq content-type (message-fetch-field "Content-Type")) - (when content-type - (when (string-match - "^ *\\([^ \t\n/;]+\\)/\\([^ \t\n/;]+\\)" content-type) - (setq type (downcase (match-string 1 content-type)) - subtype (downcase (match-string 2 content-type)) - message-rfc822 (and (string= type "message") - (string= subtype "rfc822")) - multipart-any (string= type "multipart"))) - (when (string-match ";[ \t\n]*name=\\([^ \t\n;]+\\)" content-type) - (setq subject (match-string 1 content-type))) - (when (string-match "boundary=\"?\\([^\"\n]*[^\" \t\n]\\)" content-type) - (setq boundary-regexp (concat "^--" - (regexp-quote - (match-string 1 content-type)) - "\\(--\\)?[ \t]*\n")))) - (unless subject - (when (or multipart-any (not article-insert)) - (setq subject (message-fetch-field "Subject")))) - (unless type - (setq type "text" - subtype "plain")) - ;; Prepare the article and summary inserts. - (unless article-insert - (setq article-insert (buffer-string) - head-end head-begin)) - ;; Fix MIME-Version - (unless (string-match "MIME-Version:" article-insert) - (setq article-insert - (concat article-insert "MIME-Version: 1.0\n"))) - (setq summary-insert article-insert) - ;; - summary Subject. - (setq summary-insert - (let ((line (concat "Subject: <" position - (and position multipart-any ".") - (and multipart-any "*") - (and (or position multipart-any) " ") - (cond ((string= subtype "plain") type) - ((string= subtype "basic") type) - (t subtype)) - ">" - (and subject " ") - subject - "\n"))) - (if (string-match "Subject:.*\n\\([ \t].*\n\\)*" summary-insert) - (replace-match line t t summary-insert) - (concat summary-insert line)))) - ;; - summary Message-ID. - (setq summary-insert - (let ((line (concat "Message-ID: " message-id "\n"))) - (if (string-match "Message-ID:.*\n\\([ \t].*\n\\)*" summary-insert) - (replace-match line t t summary-insert) - (concat summary-insert line)))) - ;; - summary References. - (when parent - (setq summary-insert - (let ((line (concat "References: " parent "\n"))) - (if (string-match "References:.*\n\\([ \t].*\n\\)*" - summary-insert) - (replace-match line t t summary-insert) - (concat summary-insert line))))) - ;; Generate dissection information for this entity. - (push (list (incf nndoc-mime-split-ordinal) - head-begin head-end body-begin body-end - (count-lines body-begin body-end) - article-insert summary-insert) - nndoc-dissection-alist) - ;; Recurse for all sub-entities, if any. - (widen) - (cond - (message-rfc822 - (save-excursion - (nndoc-dissect-mime-parts-sub body-begin body-end nil - position message-id))) - ((and multipart-any boundary-regexp) - (let ((part-counter 0) - part-begin part-end eof-flag) - (while (string-match "\ -^\\(Lines\\|Content-\\(Type\\|Transfer-Encoding\\|Disposition\\)\\):.*\n\\([ \t].*\n\\)*" - article-insert) - (setq article-insert (replace-match "" t t article-insert))) - (let ((case-fold-search nil)) - (goto-char body-begin) - (setq eof-flag (not (re-search-forward boundary-regexp body-end t))) - (while (not eof-flag) - (setq part-begin (point)) - (cond ((re-search-forward boundary-regexp body-end t) - (or (not (match-string 1)) - (string= (match-string 1) "") - (setq eof-flag t)) - (forward-line -1) - (setq part-end (point)) - (forward-line 1)) - (t (setq part-end body-end - eof-flag t))) - (save-excursion - (nndoc-dissect-mime-parts-sub - part-begin part-end article-insert - (concat position - (and position ".") - (format "%d" (incf part-counter))) - message-id))))))))) - -;;;###autoload -(defun nndoc-add-type (definition &optional position) - "Add document DEFINITION to the list of nndoc document definitions. -If POSITION is nil or `last', the definition will be added -as the last checked definition, if t or `first', add as the -first definition, and if any other symbol, add after that -symbol in the alist." - ;; First remove any old instances. - (gnus-pull (car definition) nndoc-type-alist) - ;; Then enter the new definition in the proper place. - (cond - ((or (null position) (eq position 'last)) - (setq nndoc-type-alist (nconc nndoc-type-alist (list definition)))) - ((or (eq position t) (eq position 'first)) - (push definition nndoc-type-alist)) - (t - (let ((list (memq (assq position nndoc-type-alist) - nndoc-type-alist))) - (unless list - (error "No such position: %s" position)) - (setcdr list (cons definition (cdr list))))))) - -(provide 'nndoc) - -;;; arch-tag: f5c2970e-0387-47ac-a0b3-6cc317dffabe -;;; nndoc.el ends here diff --git a/xemacs-packages/gnus/lisp/nndraft.el b/xemacs-packages/gnus/lisp/nndraft.el deleted file mode 100644 index 94ba8b7e..00000000 --- a/xemacs-packages/gnus/lisp/nndraft.el +++ /dev/null @@ -1,314 +0,0 @@ -;;; nndraft.el --- draft article access for Gnus - -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(require 'nnheader) -(require 'nnmail) -(require 'gnus-start) -(require 'nnmh) -(require 'nnoo) -(require 'mm-util) -(eval-when-compile (require 'cl)) - -(nnoo-declare nndraft - nnmh) - -(defvoo nndraft-directory (nnheader-concat gnus-directory "drafts/") - "Where nndraft will store its files." - nnmh-directory) - - - -(defvoo nndraft-current-group "" nil nnmh-current-group) -(defvoo nndraft-get-new-mail nil nil nnmh-get-new-mail) -(defvoo nndraft-current-directory nil nil nnmh-current-directory) - -(defconst nndraft-version "nndraft 1.0") -(defvoo nndraft-status-string "" nil nnmh-status-string) - - - -;;; Interface functions. - -(nnoo-define-basics nndraft) - -(deffoo nndraft-open-server (server &optional defs) - (nnoo-change-server 'nndraft server defs) - (cond - ((not (file-exists-p nndraft-directory)) - (nndraft-close-server) - (nnheader-report 'nndraft "No such file or directory: %s" - nndraft-directory)) - ((not (file-directory-p (file-truename nndraft-directory))) - (nndraft-close-server) - (nnheader-report 'nndraft "Not a directory: %s" nndraft-directory)) - (t - (nnheader-report 'nndraft "Opened server %s using directory %s" - server nndraft-directory) - t))) - -(deffoo nndraft-retrieve-headers (articles &optional group server fetch-old) - (nndraft-possibly-change-group group) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (let* (article) - ;; We don't support fetching by Message-ID. - (if (stringp (car articles)) - 'headers - (while articles - (narrow-to-region (point) (point)) - (when (nndraft-request-article - (setq article (pop articles)) group server (current-buffer)) - (goto-char (point-min)) - (if (search-forward "\n\n" nil t) - (forward-line -1) - (goto-char (point-max))) - (delete-region (point) (point-max)) - (goto-char (point-min)) - (insert (format "221 %d Article retrieved.\n" article)) - (widen) - (goto-char (point-max)) - (insert ".\n"))) - - (nnheader-fold-continuation-lines) - 'headers)))) - -(deffoo nndraft-request-article (id &optional group server buffer) - (nndraft-possibly-change-group group) - (when (numberp id) - ;; We get the newest file of the auto-saved file and the - ;; "real" file. - (let* ((file (nndraft-article-filename id)) - (auto (nndraft-auto-save-file-name file)) - (newest (if (file-newer-than-file-p file auto) file auto)) - (nntp-server-buffer (or buffer nntp-server-buffer))) - (when (and (file-exists-p newest) - (let ((nnmail-file-coding-system - (if (file-newer-than-file-p file auto) - (if (member group '("drafts" "delayed")) - message-draft-coding-system - mm-text-coding-system) - mm-auto-save-coding-system))) - (nnmail-find-file newest))) - (save-excursion - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - ;; If there's a mail header separator in this file, - ;; we remove it. - (when (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$") nil t) - (replace-match "" t t))) - t)))) - -(deffoo nndraft-request-restore-buffer (article &optional group server) - "Request a new buffer that is restored to the state of ARTICLE." - (nndraft-possibly-change-group group) - (when (nndraft-request-article article group server (current-buffer)) - (message-remove-header "xref") - (message-remove-header "lines") - ;; Articles in nndraft:queue are considered as sent messages. The - ;; Date field should be the time when they are sent. - ;;(message-remove-header "date") - t)) - -(deffoo nndraft-request-update-info (group info &optional server) - (nndraft-possibly-change-group group) - (gnus-info-set-read - info - (gnus-update-read-articles (gnus-group-prefixed-name group '(nndraft "")) - (nndraft-articles) t)) - (let ((marks (nth 3 info))) - (when marks - ;; Nix out all marks except the `unsend'-able article marks. - (setcar (nthcdr 3 info) - (if (assq 'unsend marks) - (list (assq 'unsend marks)) - nil)))) - t) - -(defun nndraft-generate-headers () - (save-excursion - (message-generate-headers - (message-headers-to-generate - message-required-headers message-draft-headers nil)))) - -(deffoo nndraft-request-associate-buffer (group) - "Associate the current buffer with some article in the draft group." - (nndraft-open-server "") - (nndraft-request-group group) - (nndraft-possibly-change-group group) - (let ((gnus-verbose-backends nil) - (buf (current-buffer)) - article file) - (with-temp-buffer - (insert-buffer-substring buf) - (setq article (nndraft-request-accept-article - group (nnoo-current-server 'nndraft) t 'noinsert) - file (nndraft-article-filename article))) - (setq buffer-file-name (expand-file-name file) - buffer-auto-save-file-name (make-auto-save-file-name)) - (clear-visited-file-modtime) - (let ((hook (if (boundp 'write-contents-functions) - 'write-contents-functions - 'write-contents-hooks))) - (gnus-make-local-hook hook) - (add-hook hook 'nndraft-generate-headers nil t)) - article)) - -(deffoo nndraft-request-group (group &optional server dont-check) - (nndraft-possibly-change-group group) - (unless dont-check - (let* ((pathname (nnmail-group-pathname group nndraft-directory)) - (file-name-coding-system nnmail-pathname-coding-system) - dir file) - (nnheader-re-read-dir pathname) - (setq dir (mapcar (lambda (name) (string-to-number (substring name 1))) - (ignore-errors (directory-files - pathname nil "^#[0-9]+#$" t)))) - (dolist (n dir) - (unless (file-exists-p - (setq file (expand-file-name (int-to-string n) pathname))) - (rename-file (nndraft-auto-save-file-name file) file))))) - (nnoo-parent-function 'nndraft - 'nnmh-request-group - (list group server dont-check))) - -(deffoo nndraft-request-move-article (article group server - accept-form &optional last) - (nndraft-possibly-change-group group) - (let ((buf (get-buffer-create " *nndraft move*")) - result) - (and - (nndraft-request-article article group server) - (save-excursion - (set-buffer buf) - (erase-buffer) - (insert-buffer-substring nntp-server-buffer) - (setq result (eval accept-form)) - (kill-buffer (current-buffer)) - result) - (null (nndraft-request-expire-articles (list article) group server 'force)) - result))) - -(deffoo nndraft-request-expire-articles (articles group &optional server force) - (nndraft-possibly-change-group group) - (let* ((nnmh-allow-delete-final t) - (res (nnoo-parent-function 'nndraft - 'nnmh-request-expire-articles - (list articles group server force))) - article) - ;; Delete all the "state" files of articles that have been expired. - (while articles - (unless (memq (setq article (pop articles)) res) - (let ((auto (nndraft-auto-save-file-name - (nndraft-article-filename article)))) - (when (file-exists-p auto) - (funcall nnmail-delete-file-function auto))) - (dolist (backup - (let ((kept-new-versions 1) - (kept-old-versions 0)) - (find-backup-file-name - (nndraft-article-filename article)))) - (when (file-exists-p backup) - (funcall nnmail-delete-file-function backup))))) - res)) - -(deffoo nndraft-request-accept-article (group &optional server last noinsert) - (nndraft-possibly-change-group group) - (let ((gnus-verbose-backends nil)) - (nnoo-parent-function 'nndraft 'nnmh-request-accept-article - (list group server last noinsert)))) - -(deffoo nndraft-request-replace-article (article group buffer) - (nndraft-possibly-change-group group) - (let ((nnmail-file-coding-system - (if (member group '("drafts" "delayed")) - message-draft-coding-system - mm-text-coding-system))) - (nnoo-parent-function 'nndraft 'nnmh-request-replace-article - (list article group buffer)))) - -(deffoo nndraft-request-create-group (group &optional server args) - (nndraft-possibly-change-group group) - (if (file-exists-p nndraft-current-directory) - (if (file-directory-p nndraft-current-directory) - t - nil) - (condition-case () - (progn - (gnus-make-directory nndraft-current-directory) - t) - (file-error nil)))) - - -;;; Low-Level Interface - -(defun nndraft-possibly-change-group (group) - (when (and group - (not (equal group nndraft-current-group))) - (nndraft-open-server "") - (setq nndraft-current-group group) - (setq nndraft-current-directory - (nnheader-concat nndraft-directory group)))) - -(defun nndraft-article-filename (article &rest args) - (apply 'concat - (file-name-as-directory nndraft-current-directory) - (int-to-string article) - args)) - -(defun nndraft-auto-save-file-name (file) - (save-excursion - (prog1 - (progn - (set-buffer (get-buffer-create " *draft tmp*")) - (setq buffer-file-name file) - (make-auto-save-file-name)) - (kill-buffer (current-buffer))))) - -(defun nndraft-articles () - "Return the list of messages in the group." - (gnus-make-directory nndraft-current-directory) - (sort - (mapcar 'string-to-number - (directory-files nndraft-current-directory nil "\\`[0-9]+\\'" t)) - '<)) - -(nnoo-import nndraft - (nnmh - nnmh-retrieve-headers - nnmh-request-group - nnmh-close-group - nnmh-request-list - nnmh-request-newsgroups)) - -(provide 'nndraft) - -;;; arch-tag: 3ce26ca0-41cb-48b1-8703-4dad35e188aa -;;; nndraft.el ends here diff --git a/xemacs-packages/gnus/lisp/nneething.el b/xemacs-packages/gnus/lisp/nneething.el deleted file mode 100644 index 0f466a35..00000000 --- a/xemacs-packages/gnus/lisp/nneething.el +++ /dev/null @@ -1,432 +0,0 @@ -;;; nneething.el --- arbitrary file access for Gnus - -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Masanobu UMEDA -;; Keywords: news, mail - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'nnheader) -(require 'nnmail) -(require 'nnoo) -(require 'gnus-util) - -(nnoo-declare nneething) - -(defvoo nneething-map-file-directory - (nnheader-concat gnus-directory ".nneething/") - "Where nneething stores the map files.") - -(defvoo nneething-map-file ".nneething" - "Name of the map files.") - -(defvoo nneething-exclude-files nil - "Regexp saying what files to exclude from the group. -If this variable is nil, no files will be excluded.") - -(defvoo nneething-include-files nil - "Regexp saying what files to include in the group. -If this variable is non-nil, only files matching this regexp will be -included.") - - - -;;; Internal variables. - -(defconst nneething-version "nneething 1.0" - "nneething version.") - -(defvoo nneething-current-directory nil - "Current news group directory.") - -(defvoo nneething-status-string "") - -(defvoo nneething-work-buffer " *nneething work*") - -(defvoo nneething-group nil) -(defvoo nneething-map nil) -(defvoo nneething-read-only nil) -(defvoo nneething-active nil) -(defvoo nneething-address nil) - - - -;;; Interface functions. - -(nnoo-define-basics nneething) - -(deffoo nneething-retrieve-headers (articles &optional group server fetch-old) - (nneething-possibly-change-directory group) - - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (let* ((number (length articles)) - (count 0) - (large (and (numberp nnmail-large-newsgroup) - (> number nnmail-large-newsgroup))) - article file) - - (if (stringp (car articles)) - 'headers - - (while (setq article (pop articles)) - (setq file (nneething-file-name article)) - - (when (and (file-exists-p file) - (or (file-directory-p file) - (not (zerop (nnheader-file-size file))))) - (insert (format "221 %d Article retrieved.\n" article)) - (nneething-insert-head file) - (insert ".\n")) - - (incf count) - - (and large - (zerop (% count 20)) - (nnheader-message 5 "nneething: Receiving headers... %d%%" - (/ (* count 100) number)))) - - (when large - (nnheader-message 5 "nneething: Receiving headers...done")) - - (nnheader-fold-continuation-lines) - 'headers)))) - -(deffoo nneething-request-article (id &optional group server buffer) - (nneething-possibly-change-directory group) - (let ((file (unless (stringp id) - (nneething-file-name id))) - (nntp-server-buffer (or buffer nntp-server-buffer))) - (and (stringp file) ; We did not request by Message-ID. - (file-exists-p file) ; The file exists. - (not (file-directory-p file)) ; It's not a dir. - (save-excursion - (let ((nnmail-file-coding-system 'binary)) - (nnmail-find-file file)) ; Insert the file in the nntp buf. - (unless (nnheader-article-p) ; Either it's a real article... - (let ((type - (unless (file-directory-p file) - (or (cdr (assoc (concat "." (file-name-extension file)) - mailcap-mime-extensions)) - "text/plain"))) - (charset - (mm-detect-mime-charset-region (point-min) (point-max))) - (encoding)) - (unless (string-match "\\`text/" type) - (base64-encode-region (point-min) (point-max)) - (setq encoding "base64")) - (goto-char (point-min)) - (nneething-make-head file (current-buffer) - nil type charset encoding)) - (insert "\n")) - t)))) - -(deffoo nneething-request-group (group &optional server dont-check) - (nneething-possibly-change-directory group server) - (unless dont-check - (nneething-create-mapping) - (if (> (car nneething-active) (cdr nneething-active)) - (nnheader-insert "211 0 1 0 %s\n" group) - (nnheader-insert - "211 %d %d %d %s\n" - (- (1+ (cdr nneething-active)) (car nneething-active)) - (car nneething-active) (cdr nneething-active) - group))) - t) - -(deffoo nneething-request-list (&optional server dir) - (nnheader-report 'nneething "LIST is not implemented.")) - -(deffoo nneething-request-newgroups (date &optional server) - (nnheader-report 'nneething "NEWSGROUPS is not implemented.")) - -(deffoo nneething-request-type (group &optional article) - 'unknown) - -(deffoo nneething-close-group (group &optional server) - (setq nneething-current-directory nil) - t) - -(deffoo nneething-open-server (server &optional defs) - (nnheader-init-server-buffer) - (if (nneething-server-opened server) - t - (unless (assq 'nneething-address defs) - (setq defs (append defs (list (list 'nneething-address server))))) - (nnoo-change-server 'nneething server defs))) - - -;;; Internal functions. - -(defun nneething-possibly-change-directory (group &optional server) - (when (and server - (not (nneething-server-opened server))) - (nneething-open-server server)) - (when (and group - (not (equal nneething-group group))) - (setq nneething-group group) - (setq nneething-map nil) - (setq nneething-active (cons 1 0)) - (nneething-create-mapping))) - -(defun nneething-map-file () - ;; We make sure that the .nneething directory exists. - (gnus-make-directory nneething-map-file-directory) - ;; We store it in a special directory under the user's home dir. - (concat (file-name-as-directory nneething-map-file-directory) - nneething-group nneething-map-file)) - -(defun nneething-create-mapping () - ;; Read nneething-active and nneething-map. - (when (file-exists-p nneething-address) - (let ((map-file (nneething-map-file)) - (files (directory-files nneething-address)) - touched map-files) - (when (file-exists-p map-file) - (ignore-errors - (load map-file nil t t))) - (unless nneething-active - (setq nneething-active (cons 1 0))) - ;; Old nneething had a different map format. - (when (and (cdar nneething-map) - (atom (cdar nneething-map))) - (setq nneething-map - (mapcar (lambda (n) - (list (cdr n) (car n) - (nth 5 (file-attributes - (nneething-file-name (car n)))))) - nneething-map))) - ;; Remove files matching the exclusion regexp. - (when nneething-exclude-files - (let ((f files) - prev) - (while f - (if (string-match nneething-exclude-files (car f)) - (if prev (setcdr prev (cdr f)) - (setq files (cdr files))) - (setq prev f)) - (setq f (cdr f))))) - ;; Remove files not matching the inclusion regexp. - (when nneething-include-files - (let ((f files) - prev) - (while f - (if (not (string-match nneething-include-files (car f))) - (if prev (setcdr prev (cdr f)) - (setq files (cdr files))) - (setq prev f)) - (setq f (cdr f))))) - ;; Remove deleted files from the map. - (let ((map nneething-map) - prev) - (while map - (if (and (member (cadr (car map)) files) - ;; We also remove files that have changed mod times. - (equal (nth 5 (file-attributes - (nneething-file-name (cadr (car map))))) - (cadr (cdar map)))) - (progn - (push (cadr (car map)) map-files) - (setq prev map)) - (setq touched t) - (if prev - (setcdr prev (cdr map)) - (setq nneething-map (cdr nneething-map)))) - (setq map (cdr map)))) - ;; Find all new files and enter them into the map. - (while files - (unless (member (car files) map-files) - ;; This file is not in the map, so we enter it. - (setq touched t) - (setcdr nneething-active (1+ (cdr nneething-active))) - (push (list (cdr nneething-active) (car files) - (nth 5 (file-attributes - (nneething-file-name (car files))))) - nneething-map)) - (setq files (cdr files))) - (when (and touched - (not nneething-read-only)) - (with-temp-file map-file - (insert "(setq nneething-map '") - (gnus-prin1 nneething-map) - (insert ")\n(setq nneething-active '") - (gnus-prin1 nneething-active) - (insert ")\n")))))) - -(defun nneething-insert-head (file) - "Insert the head of FILE." - (when (nneething-get-head file) - (insert-buffer-substring nneething-work-buffer) - (goto-char (point-max)))) - -(defun nneething-encode-file-name (file &optional coding-system) - "Encode the name of the FILE in CODING-SYSTEM." - (let ((pos 0) buf) - (setq file (mm-encode-coding-string - file (or coding-system nnmail-pathname-coding-system))) - (while (string-match "[^-0-9a-zA-Z_:/.]" file pos) - (setq buf (cons (format "%%%02x" (aref file (match-beginning 0))) - (cons (substring file pos (match-beginning 0)) buf)) - pos (match-end 0))) - (apply (function concat) - (nreverse (cons (substring file pos) buf))))) - -(defun nneething-decode-file-name (file &optional coding-system) - "Decode the name of the FILE is encoded in CODING-SYSTEM." - (let ((pos 0) buf) - (while (string-match "%\\([0-9a-fA-F][0-9a-fA-F]\\)" file pos) - (setq buf (cons (string (string-to-number (match-string 1 file) 16)) - (cons (substring file pos (match-beginning 0)) buf)) - pos (match-end 0))) - (mm-decode-coding-string - (apply (function concat) - (nreverse (cons (substring file pos) buf))) - (or coding-system nnmail-pathname-coding-system)))) - -(defun nneething-get-file-name (id) - "Extract the file name from the message ID string." - (when (string-match "\\`\\'" id) - (nneething-decode-file-name (match-string 1 id)))) - -(defun nneething-make-head (file &optional buffer extra-msg - mime-type mime-charset mime-encoding) - "Create a head by looking at the file attributes of FILE." - (let ((atts (file-attributes file))) - (insert - "Subject: " (file-name-nondirectory file) (or extra-msg "") "\n" - "Message-ID: \n" - (if (equal '(0 0) (nth 5 atts)) "" - (concat "Date: " (current-time-string (nth 5 atts)) "\n")) - (or (when buffer - (save-excursion - (set-buffer buffer) - (when (re-search-forward "<[a-zA-Z0-9_]@[-a-zA-Z0-9_]>" 1000 t) - (concat "From: " (match-string 0) "\n")))) - (nneething-from-line (nth 2 atts) file)) - (if (> (string-to-number (int-to-string (nth 7 atts))) 0) - (concat "Chars: " (int-to-string (nth 7 atts)) "\n") - "") - (if buffer - (save-excursion - (set-buffer buffer) - (concat "Lines: " (int-to-string - (count-lines (point-min) (point-max))) - "\n")) - "") - (if mime-type - (concat "Content-Type: " mime-type - (if mime-charset - (concat "; charset=" - (if (stringp mime-charset) - mime-charset - (symbol-name mime-charset))) - "") - (if mime-encoding - (concat "\nContent-Transfer-Encoding: " mime-encoding) - "") - "\nMIME-Version: 1.0\n") - "")))) - -(defun nneething-from-line (uid &optional file) - "Return a From header based of UID." - (let* ((login (condition-case nil - (user-login-name uid) - (error - (cond ((= uid (user-uid)) (user-login-name)) - ((zerop uid) "root") - (t (int-to-string uid)))))) - (name (condition-case nil - (user-full-name uid) - (error - (cond ((= uid (user-uid)) (user-full-name)) - ((zerop uid) "Ms. Root"))))) - (host (if (string-match "\\`/[^/@]*@\\([^:/]+\\):" file) - (prog1 - (substring file - (match-beginning 1) - (match-end 1)) - (when (string-match - "/\\(users\\|home\\)/\\([^/]+\\)/" file) - (setq login (substring file - (match-beginning 2) - (match-end 2)) - name nil))) - (system-name)))) - (concat "From: " login "@" host - (if name (concat " (" name ")") "") "\n"))) - -(defun nneething-get-head (file) - "Either find the head in FILE or make a head for FILE." - (save-excursion - (set-buffer (get-buffer-create nneething-work-buffer)) - (setq case-fold-search nil) - (buffer-disable-undo) - (erase-buffer) - (cond - ((not (file-exists-p file)) - ;; The file do not exist. - nil) - ((or (file-directory-p file) - (file-symlink-p file)) - ;; It's a dir, so we fudge a head. - (nneething-make-head file) t) - (t - ;; We examine the file. - (condition-case () - (progn - (nnheader-insert-head file) - (if (nnheader-article-p) - (delete-region - (progn - (goto-char (point-min)) - (or (and (search-forward "\n\n" nil t) - (1- (point))) - (point-max))) - (point-max)) - (goto-char (point-min)) - (nneething-make-head file (current-buffer)) - (delete-region (point) (point-max)))) - (file-error - (nneething-make-head file (current-buffer) " (unreadable)"))) - t)))) - -(defun nneething-file-name (article) - "Return the file name of ARTICLE." - (let ((dir (file-name-as-directory nneething-address)) - fname) - (if (numberp article) - (if (setq fname (cadr (assq article nneething-map))) - (expand-file-name fname dir) - (mm-make-temp-file (expand-file-name "nneething" dir))) - (expand-file-name article dir)))) - -(provide 'nneething) - -;;; arch-tag: 1277f386-88f2-4459-bb24-f3f45962a6c5 -;;; nneething.el ends here diff --git a/xemacs-packages/gnus/lisp/nnfolder.el b/xemacs-packages/gnus/lisp/nnfolder.el deleted file mode 100644 index 727fcb0a..00000000 --- a/xemacs-packages/gnus/lisp/nnfolder.el +++ /dev/null @@ -1,1278 +0,0 @@ -;;; nnfolder.el --- mail folder access for Gnus - -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Simon Josefsson (adding MARKS) -;; ShengHuo Zhu (adding NOV) -;; Scott Byer -;; Lars Magne Ingebrigtsen -;; Masanobu UMEDA -;; Keywords: mail - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(require 'nnheader) -(require 'message) -(require 'nnmail) -(require 'nnoo) -(eval-when-compile (require 'cl)) -(require 'gnus) -(require 'gnus-util) -(require 'gnus-range) - -(eval-and-compile - (autoload 'gnus-article-unpropagatable-p "gnus-sum") - (autoload 'gnus-intersection "gnus-range")) - -(nnoo-declare nnfolder) - -(defvoo nnfolder-directory (expand-file-name message-directory) - "The name of the nnfolder directory.") - -(defvoo nnfolder-nov-directory nil - "The name of the nnfolder NOV directory. -If nil, `nnfolder-directory' is used.") - -(defvoo nnfolder-marks-directory nil - "The name of the nnfolder MARKS directory. -If nil, `nnfolder-directory' is used.") - -(defvoo nnfolder-active-file - (nnheader-concat nnfolder-directory "active") - "The name of the active file.") - -;; I renamed this variable to something more in keeping with the general GNU -;; style. -SLB - -(defvoo nnfolder-ignore-active-file nil - "If non-nil, the active file is ignored. -This causes nnfolder to do some extra work in order to determine the -true active ranges of an mbox file. Note that the active file is -still saved, but its values are not used. This costs some extra time -when scanning an mbox when opening it.") - -(defvoo nnfolder-distrust-mbox nil - "If non-nil, the folder will be distrusted. -This means that nnfolder will not trust the user with respect to -inserting unaccounted for mail in the middle of an mbox file. This -can greatly slow down scans, which now must scan the entire file for -unmarked messages. When nil, scans occur forward from the last marked -message, a huge time saver for large mailboxes.") - -(defvoo nnfolder-newsgroups-file - (concat (file-name-as-directory nnfolder-directory) "newsgroups") - "Mail newsgroups description file.") - -(defvoo nnfolder-get-new-mail t - "If non-nil, nnfolder will check the incoming mail file and split the mail.") - -(defvoo nnfolder-prepare-save-mail-hook nil - "Hook run narrowed to an article before saving.") - -(defvoo nnfolder-save-buffer-hook nil - "Hook run before saving the nnfolder mbox buffer.") - - -(defvoo nnfolder-inhibit-expiry nil - "If non-nil, inhibit expiry.") - - - -(defconst nnfolder-version "nnfolder 2.0" - "nnfolder version.") - -(defconst nnfolder-article-marker "X-Gnus-Article-Number: " - "String used to demarcate what the article number for a message is.") - -(defvoo nnfolder-current-group nil) -(defvoo nnfolder-current-buffer nil) -(defvoo nnfolder-status-string "") -(defvoo nnfolder-group-alist nil) -(defvoo nnfolder-buffer-alist nil) -(defvoo nnfolder-scantime-alist nil) -(defvoo nnfolder-active-timestamp nil) -(defvoo nnfolder-active-file-coding-system mm-text-coding-system) -(defvoo nnfolder-active-file-coding-system-for-write - nnmail-active-file-coding-system) -(defvoo nnfolder-file-coding-system mm-text-coding-system) -(defvoo nnfolder-file-coding-system-for-write nnheader-file-coding-system - "Coding system for save nnfolder file. -if nil, `nnfolder-file-coding-system' is used.") ; FIXME: fill-in the doc-string of this variable - -(defvoo nnfolder-nov-is-evil nil - "If non-nil, Gnus will never generate and use nov databases for mail groups. -Using nov databases will speed up header fetching considerably. -This variable shouldn't be flipped much. If you have, for some reason, -set this to t, and want to set it to nil again, you should always run -the `nnfolder-generate-active-file' command. The function will go -through all nnfolder directories and generate nov databases for them -all. This may very well take some time.") - -(defvoo nnfolder-nov-file-suffix ".nov") - -(defvoo nnfolder-nov-buffer-alist nil) - -(defvar nnfolder-nov-buffer-file-name nil) - -(defvoo nnfolder-marks-is-evil nil - "If non-nil, Gnus will never generate and use marks file for mail groups. -Using marks files makes it possible to backup and restore mail groups -separately from `.newsrc.eld'. If you have, for some reason, set -this to t, and want to set it to nil again, you should always remove -the corresponding marks file (usually base nnfolder file name -concatenated with `.mrk', but see `nnfolder-marks-file-suffix') for -the group. Then the marks file will be regenerated properly by Gnus.") - -(defvoo nnfolder-marks nil) - -(defvoo nnfolder-marks-file-suffix ".mrk") - -(defvar nnfolder-marks-modtime (gnus-make-hashtable)) - - - -;;; Interface functions - -(nnoo-define-basics nnfolder) - -(deffoo nnfolder-retrieve-headers (articles &optional group server fetch-old) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (let (article start stop num) - (nnfolder-possibly-change-group group server) - (when nnfolder-current-buffer - (set-buffer nnfolder-current-buffer) - (goto-char (point-min)) - (if (stringp (car articles)) - 'headers - (if (nnfolder-retrieve-headers-with-nov articles fetch-old) - 'nov - (setq articles (gnus-sorted-intersection - ;; Is ARTICLES sorted? - (sort articles '<) - (nnfolder-existing-articles))) - (while (setq article (pop articles)) - (set-buffer nnfolder-current-buffer) - (cond ((nnfolder-goto-article article) - (setq start (point)) - (setq stop (if (search-forward "\n\n" nil t) - (1- (point)) - (point-max))) - (set-buffer nntp-server-buffer) - (insert (format "221 %d Article retrieved.\n" article)) - (insert-buffer-substring nnfolder-current-buffer - start stop) - (goto-char (point-max)) - (insert ".\n")) - - ;; If we couldn't find this article, skip over ranges - ;; of missing articles so we don't search the whole file - ;; for each of them. - ((numberp article) - (setq start (point)) - (and - ;; Check that we are either at BOF or after an - ;; article with a lower number. We do this so we - ;; won't be confused by out-of-order article numbers, - ;; as caused by active file bogosity. - (cond - ((bobp)) - ((search-backward (concat "\n" nnfolder-article-marker) - nil t) - (goto-char (match-end 0)) - (setq num (string-to-number - (buffer-substring - (point) (gnus-point-at-eol)))) - (goto-char start) - (< num article))) - ;; Check that we are before an article with a - ;; higher number. - (search-forward (concat "\n" nnfolder-article-marker) - nil t) - (progn - (setq num (string-to-number - (buffer-substring - (point) (gnus-point-at-eol)))) - (> num article)) - ;; Discard any article numbers before the one we're - ;; now looking at. - (while (and articles - (< (car articles) num)) - (setq articles (cdr articles)))) - (goto-char start)))) - (set-buffer nntp-server-buffer) - (nnheader-fold-continuation-lines) - 'headers)))))) - -(deffoo nnfolder-open-server (server &optional defs) - (nnoo-change-server 'nnfolder server defs) - (nnmail-activate 'nnfolder t) - (gnus-make-directory nnfolder-directory) - (unless (or gnus-nov-is-evil nnfolder-nov-is-evil) - (and nnfolder-nov-directory - (gnus-make-directory nnfolder-nov-directory))) - (unless nnfolder-marks-is-evil - (and nnfolder-marks-directory - (gnus-make-directory nnfolder-marks-directory))) - (cond - ((not (file-exists-p nnfolder-directory)) - (nnfolder-close-server) - (nnheader-report 'nnfolder "Couldn't create directory: %s" - nnfolder-directory)) - ((not (file-directory-p (file-truename nnfolder-directory))) - (nnfolder-close-server) - (nnheader-report 'nnfolder "Not a directory: %s" nnfolder-directory)) - (t - (nnmail-activate 'nnfolder) - (nnheader-report 'nnfolder "Opened server %s using directory %s" - server nnfolder-directory) - t))) - -(deffoo nnfolder-request-close () - (let ((alist nnfolder-buffer-alist)) - (while alist - (nnfolder-close-group (caar alist) nil t) - (setq alist (cdr alist)))) - (nnoo-close-server 'nnfolder) - (setq nnfolder-buffer-alist nil - nnfolder-group-alist nil)) - -(deffoo nnfolder-request-article (article &optional group server buffer) - (nnfolder-possibly-change-group group server) - (save-excursion - (set-buffer nnfolder-current-buffer) - (goto-char (point-min)) - (when (nnfolder-goto-article article) - (let (start stop) - (setq start (point)) - (forward-line 1) - (unless (and (nnmail-search-unix-mail-delim) - (forward-line -1)) - (goto-char (point-max))) - (setq stop (point)) - (let ((nntp-server-buffer (or buffer nntp-server-buffer))) - (set-buffer nntp-server-buffer) - (erase-buffer) - (insert-buffer-substring nnfolder-current-buffer start stop) - (goto-char (point-min)) - (while (looking-at "From ") - (delete-char 5) - (insert "X-From-Line: ") - (forward-line 1)) - (if (numberp article) - (cons nnfolder-current-group article) - (goto-char (point-min)) - (cons nnfolder-current-group - (if (search-forward (concat "\n" nnfolder-article-marker) - nil t) - (string-to-number (buffer-substring - (point) (gnus-point-at-eol))) - -1)))))))) - -(deffoo nnfolder-request-group (group &optional server dont-check) - (nnfolder-possibly-change-group group server t) - (save-excursion - (if (not (assoc group nnfolder-group-alist)) - (nnheader-report 'nnfolder "No such group: %s" group) - (if dont-check - (progn - (nnheader-report 'nnfolder "Selected group %s" group) - t) - (let* ((active (assoc group nnfolder-group-alist)) - (group (car active)) - (range (cadr active))) - (cond - ((null active) - (nnheader-report 'nnfolder "No such group: %s" group)) - ((null nnfolder-current-group) - (nnheader-report 'nnfolder "Empty group: %s" group)) - (t - (nnheader-report 'nnfolder "Selected group %s" group) - (nnheader-insert "211 %d %d %d %s\n" - (1+ (- (cdr range) (car range))) - (car range) (cdr range) group)))))))) - -(deffoo nnfolder-request-scan (&optional group server) - (nnfolder-possibly-change-group nil server) - (when nnfolder-get-new-mail - (nnfolder-possibly-change-group group server) - (nnmail-get-new-mail - 'nnfolder - (lambda () - (let ((bufs nnfolder-buffer-alist)) - (save-excursion - (while bufs - (if (not (gnus-buffer-live-p (nth 1 (car bufs)))) - (setq nnfolder-buffer-alist - (delq (car bufs) nnfolder-buffer-alist)) - (set-buffer (nth 1 (car bufs))) - (nnfolder-save-buffer) - (kill-buffer (current-buffer))) - (setq bufs (cdr bufs)))))) - nnfolder-directory - group))) - -;; Don't close the buffer if we're not shutting down the server. This way, -;; we can keep the buffer in the group buffer cache, and not have to grovel -;; over the buffer again unless we add new mail to it or modify it in some -;; way. - -(deffoo nnfolder-close-group (group &optional server force) - ;; Make sure we _had_ the group open. - (when (or (assoc group nnfolder-buffer-alist) - (equal group nnfolder-current-group)) - (let ((inf (assoc group nnfolder-buffer-alist))) - (when inf - (when (and nnfolder-current-group - nnfolder-current-buffer) - (push (list nnfolder-current-group nnfolder-current-buffer) - nnfolder-buffer-alist)) - (setq nnfolder-buffer-alist - (delq inf nnfolder-buffer-alist)) - (setq nnfolder-current-buffer (cadr inf) - nnfolder-current-group (car inf)))) - (when (and nnfolder-current-buffer - (buffer-name nnfolder-current-buffer)) - (save-excursion - (set-buffer nnfolder-current-buffer) - ;; If the buffer was modified, write the file out now. - (nnfolder-save-buffer) - ;; If we're shutting the server down, we need to kill the - ;; buffer and remove it from the open buffer list. Or, of - ;; course, if we're trying to minimize our space impact. - (kill-buffer (current-buffer)) - (setq nnfolder-buffer-alist (delq (assoc group nnfolder-buffer-alist) - nnfolder-buffer-alist))))) - (setq nnfolder-current-group nil - nnfolder-current-buffer nil) - t) - -(deffoo nnfolder-request-create-group (group &optional server args) - (nnfolder-possibly-change-group nil server) - (nnmail-activate 'nnfolder) - (when (and group - (not (assoc group nnfolder-group-alist))) - (push (list group (cons 1 0)) nnfolder-group-alist) - (nnfolder-save-active nnfolder-group-alist nnfolder-active-file) - (save-current-buffer - (nnfolder-read-folder group))) - t) - -(deffoo nnfolder-request-list (&optional server) - (nnfolder-possibly-change-group nil server) - (save-excursion - (let ((nnmail-file-coding-system nnfolder-active-file-coding-system)) - (nnmail-find-file nnfolder-active-file) - (setq nnfolder-group-alist (nnmail-get-active))) - t)) - -(deffoo nnfolder-request-newgroups (date &optional server) - (nnfolder-possibly-change-group nil server) - (nnfolder-request-list server)) - -(deffoo nnfolder-request-list-newsgroups (&optional server) - (nnfolder-possibly-change-group nil server) - (save-excursion - (let ((nnmail-file-coding-system nnfolder-file-coding-system)) - (nnmail-find-file nnfolder-newsgroups-file)))) - -;; Return a list consisting of all article numbers existing in the -;; current folder. - -(defun nnfolder-existing-articles () - (save-excursion - (when nnfolder-current-buffer - (set-buffer nnfolder-current-buffer) - (goto-char (point-min)) - (let ((marker (concat "\n" nnfolder-article-marker)) - (number "[0-9]+") - numbers) - (while (and (search-forward marker nil t) - (re-search-forward number nil t)) - (let ((newnum (string-to-number (match-string 0)))) - (if (nnmail-within-headers-p) - (push newnum numbers)))) - ;; The article numbers are increasing, so this result is sorted. - (nreverse numbers))))) - -(deffoo nnfolder-request-expire-articles - (articles newsgroup &optional server force) - (nnfolder-possibly-change-group newsgroup server) - (let* ((is-old t) - ;; The articles we have deleted so far. - (deleted-articles nil) - ;; The articles that really exist and will - ;; be expired if they are old enough. - (maybe-expirable - (gnus-sorted-intersection articles (nnfolder-existing-articles)))) - (nnmail-activate 'nnfolder) - - (save-excursion - (set-buffer nnfolder-current-buffer) - ;; Since messages are sorted in arrival order and expired in the - ;; same order, we can stop as soon as we find a message that is - ;; too old. - (while (and maybe-expirable is-old) - (goto-char (point-min)) - (when (and (nnfolder-goto-article (car maybe-expirable)) - (search-forward (concat "\n" nnfolder-article-marker) - nil t)) - (forward-sexp) - (when (setq is-old - (nnmail-expired-article-p - newsgroup - (buffer-substring - (point) (progn (end-of-line) (point))) - force nnfolder-inhibit-expiry)) - (unless (eq nnmail-expiry-target 'delete) - (with-temp-buffer - (nnfolder-request-article (car maybe-expirable) - newsgroup server (current-buffer)) - (let ((nnfolder-current-directory nil)) - (nnmail-expiry-target-group - nnmail-expiry-target newsgroup))) - (nnfolder-possibly-change-group newsgroup server)) - (nnheader-message 5 "Deleting article %d in %s..." - (car maybe-expirable) newsgroup) - (nnfolder-delete-mail) - (unless (or gnus-nov-is-evil nnfolder-nov-is-evil) - (nnfolder-nov-delete-article newsgroup (car maybe-expirable))) - ;; Must remember which articles were actually deleted - (push (car maybe-expirable) deleted-articles))) - (setq maybe-expirable (cdr maybe-expirable))) - (unless nnfolder-inhibit-expiry - (nnheader-message 5 "Deleting articles...done")) - (nnfolder-save-buffer) - (nnfolder-adjust-min-active newsgroup) - (nnfolder-save-active nnfolder-group-alist nnfolder-active-file) - (gnus-sorted-difference articles (nreverse deleted-articles))))) - -(deffoo nnfolder-request-move-article (article group server - accept-form &optional last) - (save-excursion - (let ((buf (get-buffer-create " *nnfolder move*")) - result) - (and - (nnfolder-request-article article group server) - (save-excursion - (set-buffer buf) - (erase-buffer) - (insert-buffer-substring nntp-server-buffer) - (goto-char (point-min)) - (while (re-search-forward - (concat "^" nnfolder-article-marker) - (save-excursion (and (search-forward "\n\n" nil t) (point))) - t) - (gnus-delete-line)) - (setq result (eval accept-form)) - (kill-buffer buf) - result) - (save-excursion - (nnfolder-possibly-change-group group server) - (set-buffer nnfolder-current-buffer) - (goto-char (point-min)) - (when (nnfolder-goto-article article) - (nnfolder-delete-mail)) - (unless (or gnus-nov-is-evil nnfolder-nov-is-evil) - (nnfolder-nov-delete-article group article)) - (when last - (nnfolder-save-buffer) - (nnfolder-adjust-min-active group) - (nnfolder-save-active nnfolder-group-alist nnfolder-active-file)))) - result))) - -(deffoo nnfolder-request-accept-article (group &optional server last) - (save-excursion - (nnfolder-possibly-change-group group server) - (nnmail-check-syntax) - (let ((buf (current-buffer)) - result art-group) - (goto-char (point-min)) - (when (looking-at "X-From-Line: ") - (replace-match "From ") - (while (progn (forward-line) (looking-at "[ \t]")) - (delete-char -1))) - (with-temp-buffer - (let ((nnmail-file-coding-system nnfolder-active-file-coding-system) - (nntp-server-buffer (current-buffer))) - (nnmail-find-file nnfolder-active-file) - (setq nnfolder-group-alist (nnmail-parse-active)))) - (save-excursion - (goto-char (point-min)) - (if (search-forward "\n\n" nil t) - (forward-line -1) - (goto-char (point-max))) - (while (re-search-backward (concat "^" nnfolder-article-marker) nil t) - (delete-region (point) (progn (forward-line 1) (point)))) - (when nnmail-cache-accepted-message-ids - (nnmail-cache-insert (nnmail-fetch-field "message-id") - group - (nnmail-fetch-field "subject") - (nnmail-fetch-field "from"))) - (setq result (if (stringp group) - (list (cons group (nnfolder-active-number group))) - (setq art-group - (nnmail-article-group 'nnfolder-active-number)))) - (if (and (null result) - (yes-or-no-p "Moved to `junk' group; delete article? ")) - (setq result 'junk) - (setq result - (car (nnfolder-save-mail result))))) - (when last - (save-excursion - (nnfolder-possibly-change-folder (or (caar art-group) group)) - (nnfolder-save-buffer) - (when nnmail-cache-accepted-message-ids - (nnmail-cache-close)))) - (nnfolder-save-active nnfolder-group-alist nnfolder-active-file) - (unless result - (nnheader-report 'nnfolder "Couldn't store article")) - result))) - -(deffoo nnfolder-request-replace-article (article group buffer) - (nnfolder-possibly-change-group group) - (save-excursion - (set-buffer buffer) - (goto-char (point-min)) - (if (not (looking-at "X-From-Line: ")) - (insert "From nobody " (current-time-string) "\n") - (replace-match "From ") - (forward-line 1) - (while (looking-at "[ \t]") - (delete-char -1) - (forward-line 1))) - (nnfolder-normalize-buffer) - (set-buffer nnfolder-current-buffer) - (goto-char (point-min)) - (if (not (nnfolder-goto-article article)) - nil - (nnfolder-delete-mail) - (insert-buffer-substring buffer) - (unless (or gnus-nov-is-evil nnfolder-nov-is-evil) - (save-excursion - (set-buffer buffer) - (let ((headers (nnfolder-parse-head article - (point-min) (point-max)))) - (with-current-buffer (nnfolder-open-nov group) - (if (nnheader-find-nov-line article) - (delete-region (point) (progn (forward-line 1) (point)))) - (nnheader-insert-nov headers))))) - (nnfolder-save-buffer) - t))) - -(deffoo nnfolder-request-delete-group (group &optional force server) - (nnfolder-close-group group server t) - ;; Delete all articles in GROUP. - (if (not force) - () ; Don't delete the articles. - ;; Delete the file that holds the group. - (let ((data (nnfolder-group-pathname group)) - (nov (nnfolder-group-nov-pathname group)) - (mrk (nnfolder-group-marks-pathname group))) - (ignore-errors (delete-file data)) - (ignore-errors (delete-file nov)) - (ignore-errors (delete-file mrk)))) - ;; Remove the group from all structures. - (setq nnfolder-group-alist - (delq (assoc group nnfolder-group-alist) nnfolder-group-alist) - nnfolder-current-group nil - nnfolder-current-buffer nil) - ;; Save the active file. - (nnfolder-save-active nnfolder-group-alist nnfolder-active-file) - t) - -(deffoo nnfolder-request-rename-group (group new-name &optional server) - (nnfolder-possibly-change-group group server) - (save-excursion - (set-buffer nnfolder-current-buffer) - (and (file-writable-p buffer-file-name) - (ignore-errors - (let ((new-file (nnfolder-group-pathname new-name))) - (gnus-make-directory (file-name-directory new-file)) - (rename-file buffer-file-name new-file) - (when (file-exists-p (nnfolder-group-nov-pathname group)) - (setq new-file (nnfolder-group-nov-pathname new-name)) - (gnus-make-directory (file-name-directory new-file)) - (rename-file (nnfolder-group-nov-pathname group) new-file)) - (when (file-exists-p (nnfolder-group-marks-pathname group)) - (setq new-file (nnfolder-group-marks-pathname new-name)) - (gnus-make-directory (file-name-directory new-file)) - (rename-file (nnfolder-group-marks-pathname group) new-file))) - t) - ;; That went ok, so we change the internal structures. - (let ((entry (assoc group nnfolder-group-alist))) - (and entry (setcar entry new-name)) - (setq nnfolder-current-buffer nil - nnfolder-current-group nil) - ;; Save the new group alist. - (nnfolder-save-active nnfolder-group-alist nnfolder-active-file) - ;; We kill the buffer instead of renaming it and stuff. - (kill-buffer (current-buffer)) - t)))) - -(deffoo nnfolder-request-regenerate (server) - (nnfolder-possibly-change-group nil server) - (nnfolder-generate-active-file) - t) - - -;;; Internal functions. - -(defun nnfolder-adjust-min-active (group) - ;; Find the lowest active article in this group. - (let* ((active (cadr (assoc group nnfolder-group-alist))) - (marker (concat "\n" nnfolder-article-marker)) - (number "[0-9]+") - (activemin (cdr active))) - (save-excursion - (set-buffer nnfolder-current-buffer) - (goto-char (point-min)) - (while (and (search-forward marker nil t) - (re-search-forward number nil t)) - (let ((newnum (string-to-number (match-string 0)))) - (if (nnmail-within-headers-p) - (setq activemin (min activemin newnum))))) - (setcar active activemin)))) - -(defun nnfolder-article-string (article) - (if (numberp article) - (concat "\n" nnfolder-article-marker (int-to-string article) " ") - (concat "\nMessage-ID: " article))) - -(defun nnfolder-goto-article (article) - "Place point at the start of the headers of ARTICLE. -ARTICLE can be an article number or a Message-ID. -Returns t if successful, nil otherwise." - (let ((art-string (nnfolder-article-string article)) - start found) - ;; It is likely that we are at or before the delimiter line. - ;; We therefore go to the end of the previous line, and start - ;; searching from there. - (beginning-of-line) - (unless (bobp) - (forward-char -1)) - (setq start (point)) - ;; First search forward. - (while (and (setq found (search-forward art-string nil t)) - (not (nnmail-within-headers-p)))) - ;; If unsuccessful, search backward from where we started, - (unless found - (goto-char start) - (while (and (setq found (search-backward art-string nil t)) - (not (nnmail-within-headers-p))))) - (when found - (nnmail-search-unix-mail-delim-backward)))) - -(defun nnfolder-delete-mail (&optional leave-delim) - "Delete the message that point is in. -If optional argument LEAVE-DELIM is t, then mailbox delimiter is not -deleted. Point is left where the deleted region was." - (save-restriction - (narrow-to-region - (save-excursion - ;; In case point is at the beginning of the message already. - (forward-line 1) - (nnmail-search-unix-mail-delim-backward) - (if leave-delim (progn (forward-line 1) (point)) - (point))) - (progn - (forward-line 1) - (if (nnmail-search-unix-mail-delim) - (point) - (point-max)))) - (run-hooks 'nnfolder-delete-mail-hook) - (delete-region (point-min) (point-max)))) - -(defun nnfolder-possibly-change-group (group &optional server dont-check) - ;; Change servers. - (when (and server - (not (nnfolder-server-opened server))) - (nnfolder-open-server server)) - (unless (gnus-buffer-live-p nnfolder-current-buffer) - (setq nnfolder-current-buffer nil - nnfolder-current-group nil)) - ;; Change group. - (let ((file-name-coding-system nnmail-pathname-coding-system)) - (when (and group - (not (equal group nnfolder-current-group)) - (progn - (nnmail-activate 'nnfolder) - (and (assoc group nnfolder-group-alist) - (file-exists-p (nnfolder-group-pathname group))))) - (if dont-check - (setq nnfolder-current-group group - nnfolder-current-buffer nil) - (let (inf file) - ;; If we have to change groups, see if we don't already have - ;; the folder in memory. If we do, verify the modtime and - ;; destroy the folder if needed so we can rescan it. - (setq nnfolder-current-buffer - (nth 1 (assoc group nnfolder-buffer-alist))) - - ;; If the buffer is not live, make sure it isn't in the - ;; alist. If it is live, verify that nobody else has - ;; touched the file since last time. - (when (and nnfolder-current-buffer - (not (gnus-buffer-live-p nnfolder-current-buffer))) - (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist) - nnfolder-current-buffer nil)) - - (setq nnfolder-current-group group) - - (when (or (not nnfolder-current-buffer) - (not (verify-visited-file-modtime - nnfolder-current-buffer))) - (save-excursion - (setq file (nnfolder-group-pathname group)) - ;; See whether we need to create the new file. - (unless (file-exists-p file) - (gnus-make-directory (file-name-directory file)) - (let ((nnmail-file-coding-system - (or nnfolder-file-coding-system-for-write - nnfolder-file-coding-system-for-write))) - (nnmail-write-region (point-min) (point-min) - file t 'nomesg))) - (when (setq nnfolder-current-buffer (nnfolder-read-folder group)) - (set-buffer nnfolder-current-buffer) - (push (list group nnfolder-current-buffer) - nnfolder-buffer-alist))))))))) - -(defun nnfolder-save-mail (group-art-list) - "Called narrowed to an article." - (let* (save-list group-art) - (goto-char (point-min)) - ;; The From line may have been quoted by movemail. - (when (looking-at ">From") - (delete-char 1)) - ;; This might come from somewhere else. - (unless (looking-at "From ") - (insert "From nobody " (current-time-string) "\n") - (goto-char (point-min))) - ;; Quote all "From " lines in the article. - (forward-line 1) - (let (case-fold-search) - (while (re-search-forward "^From " nil t) - (beginning-of-line) - (insert "> "))) - (setq save-list group-art-list) - (nnmail-insert-lines) - (nnmail-insert-xref group-art-list) - (run-hooks 'nnmail-prepare-save-mail-hook) - (run-hooks 'nnfolder-prepare-save-mail-hook) - - ;; Insert the mail into each of the destination groups. - (while (setq group-art (pop group-art-list)) - ;; Kill any previous newsgroup markers. - (goto-char (point-min)) - (if (search-forward "\n\n" nil t) - (forward-line -1) - (goto-char (point-max))) - (while (search-backward (concat "\n" nnfolder-article-marker) nil t) - (delete-region (1+ (point)) (progn (forward-line 2) (point)))) - - ;; Insert the new newsgroup marker. - (nnfolder-insert-newsgroup-line group-art) - - (save-excursion - (let ((beg (point-min)) - (end (point-max)) - (obuf (current-buffer))) - (nnfolder-possibly-change-folder (car group-art)) - (let ((buffer-read-only nil)) - (nnfolder-normalize-buffer) - (insert-buffer-substring obuf beg end)) - (unless (or gnus-nov-is-evil nnfolder-nov-is-evil) - (set-buffer obuf) - (nnfolder-add-nov (car group-art) (cdr group-art) - (nnfolder-parse-head nil beg end)))))) - - ;; Did we save it anywhere? - save-list)) - -(defun nnfolder-normalize-buffer () - "Make sure there are two newlines at the end of the buffer." - (goto-char (point-max)) - (skip-chars-backward "\n") - (delete-region (point) (point-max)) - (unless (bobp) - (insert "\n\n"))) - -(defun nnfolder-insert-newsgroup-line (group-art) - (save-excursion - (goto-char (point-min)) - (unless (search-forward "\n\n" nil t) - (goto-char (point-max)) - (insert "\n")) - (forward-char -1) - (insert (format (concat nnfolder-article-marker "%d %s\n") - (cdr group-art) (message-make-date))))) - -(defun nnfolder-active-number (group) - ;; Find the next article number in GROUP. - (let ((active (cadr (assoc group nnfolder-group-alist)))) - (if active - (setcdr active (1+ (cdr active))) - ;; This group is new, so we create a new entry for it. - ;; This might be a bit naughty... creating groups on the drop of - ;; a hat, but I don't know... - (push (list group (setq active (cons 1 1))) - nnfolder-group-alist)) - (cdr active))) - -(defun nnfolder-possibly-change-folder (group) - (let ((inf (assoc group nnfolder-buffer-alist))) - (if (and inf - (gnus-buffer-live-p (cadr inf))) - (set-buffer (cadr inf)) - (when inf - (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist))) - (when nnfolder-group-alist - (nnfolder-save-active nnfolder-group-alist nnfolder-active-file)) - (push (list group (nnfolder-read-folder group)) - nnfolder-buffer-alist)))) - -;; This method has a problem if you've accidentally let the active -;; list get out of sync with the files. This could happen, say, if -;; you've accidentally gotten new mail with something other than Gnus -;; (but why would _that_ ever happen? :-). In that case, we will be -;; in the middle of processing the file, ready to add new X-Gnus -;; article number markers, and we'll run across a message with no ID -;; yet - the active list _may_not_ be ready for us yet. - -;; To handle this, I'm modifying this routine to maintain the maximum -;; ID seen so far, and when we hit a message with no ID, we will -;; _manually_ scan the rest of the message looking for any more, -;; possibly higher IDs. We'll assume the maximum that we find is the -;; highest active. Note that this shouldn't cost us much extra time -;; at all, but will be a lot less vulnerable to glitches between the -;; mbox and the active file. - -(defun nnfolder-read-folder (group) - (let* ((file (nnfolder-group-pathname group)) - (nov (nnfolder-group-nov-pathname group)) - (buffer (set-buffer - (let ((nnheader-file-coding-system - nnfolder-file-coding-system)) - (nnheader-find-file-noselect file t))))) - (mm-enable-multibyte) ;; Use multibyte buffer for future copying. - (buffer-disable-undo) - (if (equal (cadr (assoc group nnfolder-scantime-alist)) - (nth 5 (file-attributes file))) - ;; This looks up-to-date, so we don't do any scanning. - (if (file-exists-p file) - buffer - (push (list group buffer) nnfolder-buffer-alist) - (set-buffer-modified-p t) - (nnfolder-save-buffer)) - ;; Parse the damn thing. - (save-excursion - (goto-char (point-min)) - ;; Remove any blank lines at the start. - (while (eq (following-char) ?\n) - (delete-char 1)) - (nnmail-activate 'nnfolder) - ;; Read in the file. - (let ((delim "^From ") - (marker (concat "\n" nnfolder-article-marker)) - (number "[0-9]+") - (active (or (cadr (assoc group nnfolder-group-alist)) - (cons 1 0))) - (scantime (assoc group nnfolder-scantime-alist)) - (minid (lsh -1 -1)) - maxid start end newscantime - novbuf articles newnum - buffer-read-only) - (setq maxid (cdr active)) - - (unless (or gnus-nov-is-evil nnfolder-nov-is-evil - (and (file-exists-p nov) - (file-newer-than-file-p nov file))) - (unless (file-exists-p nov) - (gnus-make-directory (file-name-directory nov))) - (with-current-buffer - (setq novbuf (nnfolder-open-nov group)) - (goto-char (point-min)) - (while (not (eobp)) - (push (read novbuf) articles) - (forward-line 1)) - (setq articles (nreverse articles)))) - (goto-char (point-min)) - - ;; Anytime the active number is 1 or 0, it is suspect. In - ;; that case, search the file manually to find the active - ;; number. Or, of course, if we're being paranoid. (This - ;; would also be the place to build other lists from the - ;; header markers, such as expunge lists, etc., if we ever - ;; desired to abandon the active file entirely for mboxes.) - (when (or nnfolder-ignore-active-file - novbuf - (< maxid 2)) - (while (and (search-forward marker nil t) - (looking-at number)) - (setq newnum (string-to-number (match-string 0))) - (when (nnmail-within-headers-p) - (setq maxid (max maxid newnum) - minid (min minid newnum)) - (when novbuf - (if (memq newnum articles) - (setq articles (delq newnum articles)) - (let ((headers (nnfolder-parse-head newnum))) - (with-current-buffer novbuf - (nnheader-find-nov-line newnum) - (nnheader-insert-nov headers))))))) - (when (and novbuf articles) - (with-current-buffer novbuf - (dolist (article articles) - (when (nnheader-find-nov-line article) - (delete-region (point) - (progn (forward-line 1) (point))))))) - (setcar active (max 1 (min minid maxid))) - (setcdr active (max maxid (cdr active))) - (goto-char (point-min))) - - ;; As long as we trust that the user will only insert - ;; unmarked mail at the end, go to the end and search - ;; backwards for the last marker. Find the start of that - ;; message, and begin to search for unmarked messages from - ;; there. - (when (not (or nnfolder-distrust-mbox - (< maxid 2))) - (goto-char (point-max)) - (unless (re-search-backward marker nil t) - (goto-char (point-min))) - ;;(when (nnmail-search-unix-mail-delim) - ;; (goto-char (point-min))) - ) - - ;; Keep track of the active number on our own, and insert it - ;; back into the active list when we're done. Also, prime - ;; the pump to cut down on the number of searches we do. - (unless (nnmail-search-unix-mail-delim) - (goto-char (point-max))) - (setq end (point-marker)) - (while (not (= end (point-max))) - (setq start (marker-position end)) - (goto-char end) - ;; There may be more than one "From " line, so we skip past - ;; them. - (while (looking-at delim) - (forward-line 1)) - (set-marker end (if (nnmail-search-unix-mail-delim) - (point) - (point-max))) - (goto-char start) - (when (not (search-forward marker end t)) - (narrow-to-region start end) - (nnmail-insert-lines) - (nnfolder-insert-newsgroup-line - (cons nil - (setq newnum - (nnfolder-active-number group)))) - (when novbuf - (let ((headers (nnfolder-parse-head newnum (point-min) - (point-max)))) - (with-current-buffer novbuf - (goto-char (point-max)) - (nnheader-insert-nov headers)))) - (widen))) - - (set-marker end nil) - ;; Make absolutely sure that the active list reflects - ;; reality! - (nnfolder-save-active nnfolder-group-alist nnfolder-active-file) - - ;; Set the scantime for this group. - (setq newscantime (visited-file-modtime)) - (if scantime - (setcdr scantime (list newscantime)) - (push (list group newscantime) - nnfolder-scantime-alist)) - ;; Save nov. - (when novbuf - (nnfolder-save-nov)) - (current-buffer)))))) - -;;;###autoload -(defun nnfolder-generate-active-file () - "Look for mbox folders in the nnfolder directory and make them into groups. -This command does not work if you use short group names." - (interactive) - (nnmail-activate 'nnfolder) - (unless (or gnus-nov-is-evil nnfolder-nov-is-evil) - (dolist (file (directory-files (or nnfolder-nov-directory - nnfolder-directory) - t - (concat - (regexp-quote nnfolder-nov-file-suffix) - "$"))) - (when (not (message-mail-file-mbox-p file)) - (ignore-errors - (delete-file file))))) - (let ((files (directory-files nnfolder-directory)) - file) - (while (setq file (pop files)) - (when (and (not (backup-file-name-p file)) - (message-mail-file-mbox-p - (nnheader-concat nnfolder-directory file))) - (let ((oldgroup (assoc file nnfolder-group-alist))) - (if oldgroup - (nnheader-message 5 "Refreshing group %s..." file) - (nnheader-message 5 "Adding group %s..." file)) - (if oldgroup - (setq nnfolder-group-alist - (delq oldgroup (copy-sequence nnfolder-group-alist)))) - (push (list file (cons 1 0)) nnfolder-group-alist) - (nnfolder-possibly-change-folder file) - (nnfolder-possibly-change-group file) - (nnfolder-close-group file)))) - (nnheader-message 5 ""))) - -(defun nnfolder-group-pathname (group) - "Make file name for GROUP." - (setq group - (mm-encode-coding-string group nnmail-pathname-coding-system)) - (let ((dir (file-name-as-directory (expand-file-name nnfolder-directory)))) - ;; If this file exists, we use it directly. - (if (or nnmail-use-long-file-names - (file-exists-p (concat dir group))) - (concat dir group) - ;; If not, we translate dots into slashes. - (concat dir (nnheader-replace-chars-in-string group ?. ?/))))) - -(defun nnfolder-group-nov-pathname (group) - "Make pathname for GROUP NOV." - (let ((nnfolder-directory - (or nnfolder-nov-directory nnfolder-directory))) - (concat (nnfolder-group-pathname group) nnfolder-nov-file-suffix))) - -(defun nnfolder-save-buffer () - "Save the buffer." - (when (buffer-modified-p) - (run-hooks 'nnfolder-save-buffer-hook) - (gnus-make-directory (file-name-directory (buffer-file-name))) - (let ((coding-system-for-write - (or nnfolder-file-coding-system-for-write - nnfolder-file-coding-system))) - (save-buffer))) - (unless (or gnus-nov-is-evil nnfolder-nov-is-evil) - (nnfolder-save-nov))) - -(defun nnfolder-save-active (group-alist active-file) - (let ((nnmail-active-file-coding-system - (or nnfolder-active-file-coding-system-for-write - nnfolder-active-file-coding-system))) - (nnmail-save-active group-alist active-file))) - -(defun nnfolder-open-nov (group) - (or (cdr (assoc group nnfolder-nov-buffer-alist)) - (let ((buffer (get-buffer-create (format " *nnfolder overview %s*" group)))) - (save-excursion - (set-buffer buffer) - (set (make-local-variable 'nnfolder-nov-buffer-file-name) - (nnfolder-group-nov-pathname group)) - (erase-buffer) - (when (file-exists-p nnfolder-nov-buffer-file-name) - (nnheader-insert-file-contents nnfolder-nov-buffer-file-name))) - (push (cons group buffer) nnfolder-nov-buffer-alist) - buffer))) - -(defun nnfolder-save-nov () - (save-excursion - (while nnfolder-nov-buffer-alist - (when (buffer-name (cdar nnfolder-nov-buffer-alist)) - (set-buffer (cdar nnfolder-nov-buffer-alist)) - (when (buffer-modified-p) - (gnus-make-directory (file-name-directory - nnfolder-nov-buffer-file-name)) - (nnmail-write-region 1 (point-max) nnfolder-nov-buffer-file-name - nil 'nomesg)) - (set-buffer-modified-p nil) - (kill-buffer (current-buffer))) - (setq nnfolder-nov-buffer-alist (cdr nnfolder-nov-buffer-alist))))) - -(defun nnfolder-nov-delete-article (group article) - (save-excursion - (set-buffer (nnfolder-open-nov group)) - (when (nnheader-find-nov-line article) - (delete-region (point) (progn (forward-line 1) (point)))) - t)) - -(defun nnfolder-retrieve-headers-with-nov (articles &optional fetch-old) - (if (or gnus-nov-is-evil nnfolder-nov-is-evil) - nil - (let ((nov (nnfolder-group-nov-pathname nnfolder-current-group))) - (when (file-exists-p nov) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (nnheader-insert-file-contents nov) - (if (and fetch-old - (not (numberp fetch-old))) - t ; Don't remove anything. - (nnheader-nov-delete-outside-range - (if fetch-old (max 1 (- (car articles) fetch-old)) - (car articles)) - (car (last articles))) - t)))))) - -(defun nnfolder-parse-head (&optional number b e) - "Parse the head of the current buffer." - (let ((buf (current-buffer)) - chars) - (save-excursion - (unless b - (setq b (if (nnmail-search-unix-mail-delim-backward) - (point) (point-min))) - (forward-line 1) - (setq e (if (nnmail-search-unix-mail-delim) - (point) (point-max)))) - (setq chars (- e b)) - (unless (zerop chars) - (goto-char b) - (if (search-forward "\n\n" e t) (setq e (1- (point))))) - (with-temp-buffer - (insert-buffer-substring buf b e) - (let ((headers (nnheader-parse-naked-head))) - (mail-header-set-chars headers chars) - (mail-header-set-number headers number) - headers))))) - -(defun nnfolder-add-nov (group article headers) - "Add a nov line for the GROUP base." - (save-excursion - (set-buffer (nnfolder-open-nov group)) - (goto-char (point-max)) - (mail-header-set-number headers article) - (nnheader-insert-nov headers))) - -(deffoo nnfolder-request-set-mark (group actions &optional server) - (when (and server - (not (nnfolder-server-opened server))) - (nnfolder-open-server server)) - (unless nnfolder-marks-is-evil - (nnfolder-open-marks group server) - (dolist (action actions) - (let ((range (nth 0 action)) - (what (nth 1 action)) - (marks (nth 2 action))) - (assert (or (eq what 'add) (eq what 'del)) nil - "Unknown request-set-mark action: %s" what) - (dolist (mark marks) - (setq nnfolder-marks (gnus-update-alist-soft - mark - (funcall (if (eq what 'add) 'gnus-range-add - 'gnus-remove-from-range) - (cdr (assoc mark nnfolder-marks)) range) - nnfolder-marks))))) - (nnfolder-save-marks group server)) - nil) - -(deffoo nnfolder-request-update-info (group info &optional server) - ;; Change servers. - (when (and server - (not (nnfolder-server-opened server))) - (nnfolder-open-server server)) - (when (and (not nnfolder-marks-is-evil) (nnfolder-marks-changed-p group)) - (nnheader-message 8 "Updating marks for %s..." group) - (nnfolder-open-marks group server) - ;; Update info using `nnfolder-marks'. - (mapcar (lambda (pred) - (unless (memq (cdr pred) gnus-article-unpropagated-mark-lists) - (gnus-info-set-marks - info - (gnus-update-alist-soft - (cdr pred) - (cdr (assq (cdr pred) nnfolder-marks)) - (gnus-info-marks info)) - t))) - gnus-article-mark-lists) - (let ((seen (cdr (assq 'read nnfolder-marks)))) - (gnus-info-set-read info - (if (and (integerp (car seen)) - (null (cdr seen))) - (list (cons (car seen) (car seen))) - seen))) - (nnheader-message 8 "Updating marks for %s...done" group)) - info) - -(defun nnfolder-group-marks-pathname (group) - "Make pathname for GROUP NOV." - (let ((nnfolder-directory (or nnfolder-marks-directory nnfolder-directory))) - (concat (nnfolder-group-pathname group) nnfolder-marks-file-suffix))) - -(defun nnfolder-marks-changed-p (group) - (let ((file (nnfolder-group-marks-pathname group))) - (if (null (gnus-gethash file nnfolder-marks-modtime)) - t ;; never looked at marks file, assume it has changed - (not (equal (gnus-gethash file nnfolder-marks-modtime) - (nth 5 (file-attributes file))))))) - -(defun nnfolder-save-marks (group server) - (let ((file-name-coding-system nnmail-pathname-coding-system) - (file (nnfolder-group-marks-pathname group))) - (condition-case err - (progn - (with-temp-file file - (erase-buffer) - (gnus-prin1 nnfolder-marks) - (insert "\n")) - (gnus-sethash file - (nth 5 (file-attributes file)) - nnfolder-marks-modtime)) - (error (or (gnus-yes-or-no-p - (format "Could not write to %s (%s). Continue? " file err)) - (error "Cannot write to %s (%s)" file err)))))) - -(defun nnfolder-open-marks (group server) - (let ((file (nnfolder-group-marks-pathname group))) - (if (file-exists-p file) - (condition-case err - (with-temp-buffer - (gnus-sethash file (nth 5 (file-attributes file)) - nnfolder-marks-modtime) - (nnheader-insert-file-contents file) - (setq nnfolder-marks (read (current-buffer))) - (dolist (el gnus-article-unpropagated-mark-lists) - (setq nnfolder-marks (gnus-remassoc el nnfolder-marks)))) - (error (or (gnus-yes-or-no-p - (format "Error reading nnfolder marks file %s (%s). Continuing will use marks from .newsrc.eld. Continue? " file err)) - (error "Cannot read nnfolder marks file %s (%s)" file err)))) - ;; User didn't have a .marks file. Probably first time - ;; user of the .marks stuff. Bootstrap it from .newsrc.eld. - (let ((info (gnus-get-info - (gnus-group-prefixed-name - group - (gnus-server-to-method (format "nnfolder:%s" server)))))) - (nnheader-message 7 "Bootstrapping marks for %s..." group) - (setq nnfolder-marks (gnus-info-marks info)) - (push (cons 'read (gnus-info-read info)) nnfolder-marks) - (dolist (el gnus-article-unpropagated-mark-lists) - (setq nnfolder-marks (gnus-remassoc el nnfolder-marks))) - (nnfolder-save-marks group server) - (nnheader-message 7 "Bootstrapping marks for %s...done" group))))) - -(provide 'nnfolder) - -;;; arch-tag: a040d0f4-4f4e-445f-8972-839575c5f7e6 -;;; nnfolder.el ends here diff --git a/xemacs-packages/gnus/lisp/nngateway.el b/xemacs-packages/gnus/lisp/nngateway.el deleted file mode 100644 index ede53807..00000000 --- a/xemacs-packages/gnus/lisp/nngateway.el +++ /dev/null @@ -1,95 +0,0 @@ -;;; nngateway.el --- posting news via mail gateways - -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news, mail - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) -(require 'nnoo) -(require 'message) - -(nnoo-declare nngateway) - -(defvoo nngateway-address nil - "Address of the mail-to-news gateway.") - -(defvoo nngateway-header-transformation 'nngateway-simple-header-transformation - "Function to be called to rewrite the news headers into mail headers. -It is called narrowed to the headers to be transformed with one -parameter -- the gateway address.") - -;;; Interface functions - -(nnoo-define-basics nngateway) - -(deffoo nngateway-open-server (server &optional defs) - (if (nngateway-server-opened server) - t - (unless (assq 'nngateway-address defs) - (setq defs (append defs (list (list 'nngateway-address server))))) - (nnoo-change-server 'nngateway server defs))) - -(deffoo nngateway-request-post (&optional server) - (when (or (nngateway-server-opened server) - (nngateway-open-server server)) - ;; Rewrite the header. - (let ((buf (current-buffer))) - (with-temp-buffer - (insert-buffer-substring buf) - (message-narrow-to-head) - (funcall nngateway-header-transformation nngateway-address) - (goto-char (point-max)) - (insert mail-header-separator "\n") - (widen) - (let (message-required-mail-headers) - (funcall (or message-send-mail-real-function - message-send-mail-function))) - t)))) - -;;; Internal functions - -(defun nngateway-simple-header-transformation (gateway) - "Transform the headers to use GATEWAY." - (let ((newsgroups (mail-fetch-field "newsgroups"))) - (message-remove-header "to") - (message-remove-header "cc") - (goto-char (point-min)) - (insert "To: " (nnheader-replace-chars-in-string newsgroups ?. ?-) - "@" gateway "\n"))) - -(defun nngateway-mail2news-header-transformation (gateway) - "Transform the headers for sending to a mail2news gateway." - (message-remove-header "to") - (message-remove-header "cc") - (goto-char (point-min)) - (insert "To: " gateway "\n")) - -(nnoo-define-skeleton nngateway) - -(provide 'nngateway) - -;;; arch-tag: f7ecb92e-b10c-43d5-9a9b-1314233341fc -;;; nngateway.el ends here diff --git a/xemacs-packages/gnus/lisp/nnheader.el b/xemacs-packages/gnus/lisp/nnheader.el deleted file mode 100644 index 1da48939..00000000 --- a/xemacs-packages/gnus/lisp/nnheader.el +++ /dev/null @@ -1,1057 +0,0 @@ -;;; nnheader.el --- header access macros for Gnus and its backends - -;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, -;; 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Masanobu UMEDA -;; Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(defvar nnmail-extra-headers) - -;; Requiring `gnus-util' at compile time creates a circular -;; dependency between nnheader.el and gnus-util.el. -;;(eval-when-compile (require 'gnus-util)) - -(require 'mail-utils) -(require 'mm-util) -(require 'gnus-util) -(eval-and-compile - (autoload 'gnus-sorted-intersection "gnus-range") - (autoload 'gnus-intersection "gnus-range") - (autoload 'gnus-sorted-complement "gnus-range") - (autoload 'gnus-sorted-difference "gnus-range")) - -(defcustom gnus-verbose-backends 7 - "Integer that says how verbose the Gnus backends should be. -The higher the number, the more messages the Gnus backends will flash -to say what it's doing. At zero, the Gnus backends will be totally -mute; at five, they will display most important messages; and at ten, -they will keep on jabbering all the time." - :group 'gnus-start - :type 'integer) - -(defcustom gnus-nov-is-evil nil - "If non-nil, Gnus backends will never output headers in the NOV format." - :group 'gnus-server - :type 'boolean) - -(defvar nnheader-max-head-length 8192 - "*Max length of the head of articles. - -Value is an integer, nil, or t. nil means read in chunks of a file -indefinitely until a complete head is found\; t means always read the -entire file immediately, disregarding `nnheader-head-chop-length'. - -Integer values will in effect be rounded up to the nearest multiple of -`nnheader-head-chop-length'.") - -(defvar nnheader-head-chop-length 2048 - "*Length of each read operation when trying to fetch HEAD headers.") - -(defvar nnheader-read-timeout - (if (string-match "windows-nt\\|os/2\\|emx\\|cygwin" - (symbol-name system-type)) - ;; http://thread.gmane.org/v9655t3pjo.fsf@marauder.physik.uni-ulm.de - ;; - ;; IIRC, values lower than 1.0 didn't/don't work on Windows/DOS. - ;; - ;; There should probably be a runtime test to determine the timing - ;; resolution, or a primitive to report it. I don't know off-hand - ;; what's possible. Perhaps better, maybe the Windows/DOS primitive - ;; could round up non-zero timeouts to a minimum of 1.0? - 1.0 - 0.1) - "How long nntp should wait between checking for the end of output. -Shorter values mean quicker response, but are more CPU intensive.") - -(defvar nnheader-file-name-translation-alist - (let ((case-fold-search t)) - (cond - ((string-match "windows-nt\\|os/2\\|emx\\|cygwin" - (symbol-name system-type)) - (append (mapcar (lambda (c) (cons c ?_)) - '(?: ?* ?\" ?< ?> ??)) - (if (string-match "windows-nt\\|cygwin" - (symbol-name system-type)) - nil - '((?+ . ?-))))) - (t nil))) - "*Alist that says how to translate characters in file names. -For instance, if \":\" is invalid as a file character in file names -on your system, you could say something like: - -\(setq nnheader-file-name-translation-alist '((?: . ?_)))") - -(defvar nnheader-directory-separator-character - (string-to-char (substring (file-name-as-directory ".") -1)) - "*A character used to a directory separator.") - -(eval-and-compile - (autoload 'nnmail-message-id "nnmail") - (autoload 'mail-position-on-field "sendmail") - (autoload 'message-remove-header "message") - (autoload 'gnus-point-at-eol "gnus-util") - (autoload 'gnus-buffer-live-p "gnus-util")) - -;;; Header access macros. - -;; These macros may look very much like the ones in GNUS 4.1. They -;; are, in a way, but you should note that the indices they use have -;; been changed from the internal GNUS format to the NOV format. The -;; makes it possible to read headers from XOVER much faster. -;; -;; The format of a header is now: -;; [number subject from date id references chars lines xref extra] -;; -;; (That next-to-last entry is defined as "misc" in the NOV format, -;; but Gnus uses it for xrefs.) - -(defmacro mail-header-number (header) - "Return article number in HEADER." - `(aref ,header 0)) - -(defmacro mail-header-set-number (header number) - "Set article number of HEADER to NUMBER." - `(aset ,header 0 ,number)) - -(defmacro mail-header-subject (header) - "Return subject string in HEADER." - `(aref ,header 1)) - -(defmacro mail-header-set-subject (header subject) - "Set article subject of HEADER to SUBJECT." - `(aset ,header 1 ,subject)) - -(defmacro mail-header-from (header) - "Return author string in HEADER." - `(aref ,header 2)) - -(defmacro mail-header-set-from (header from) - "Set article author of HEADER to FROM." - `(aset ,header 2 ,from)) - -(defmacro mail-header-date (header) - "Return date in HEADER." - `(aref ,header 3)) - -(defmacro mail-header-set-date (header date) - "Set article date of HEADER to DATE." - `(aset ,header 3 ,date)) - -(defalias 'mail-header-message-id 'mail-header-id) -(defmacro mail-header-id (header) - "Return Id in HEADER." - `(aref ,header 4)) - -(defalias 'mail-header-set-message-id 'mail-header-set-id) -(defmacro mail-header-set-id (header id) - "Set article Id of HEADER to ID." - `(aset ,header 4 ,id)) - -(defmacro mail-header-references (header) - "Return references in HEADER." - `(aref ,header 5)) - -(defmacro mail-header-set-references (header ref) - "Set article references of HEADER to REF." - `(aset ,header 5 ,ref)) - -(defmacro mail-header-chars (header) - "Return number of chars of article in HEADER." - `(aref ,header 6)) - -(defmacro mail-header-set-chars (header chars) - "Set number of chars in article of HEADER to CHARS." - `(aset ,header 6 ,chars)) - -(defmacro mail-header-lines (header) - "Return lines in HEADER." - `(aref ,header 7)) - -(defmacro mail-header-set-lines (header lines) - "Set article lines of HEADER to LINES." - `(aset ,header 7 ,lines)) - -(defmacro mail-header-xref (header) - "Return xref string in HEADER." - `(aref ,header 8)) - -(defmacro mail-header-set-xref (header xref) - "Set article XREF of HEADER to xref." - `(aset ,header 8 ,xref)) - -(defmacro mail-header-extra (header) - "Return the extra headers in HEADER." - `(aref ,header 9)) - -(defmacro mail-header-set-extra (header extra) - "Set the extra headers in HEADER to EXTRA." - `(aset ,header 9 ',extra)) - -(defsubst make-mail-header (&optional init) - "Create a new mail header structure initialized with INIT." - (make-vector 10 init)) - -(defsubst make-full-mail-header (&optional number subject from date id - references chars lines xref - extra) - "Create a new mail header structure initialized with the parameters given." - (vector number subject from date id references chars lines xref extra)) - -;; fake message-ids: generation and detection - -(defvar nnheader-fake-message-id 1) - -(defsubst nnheader-generate-fake-message-id () - (concat "fake+none+" (int-to-string (incf nnheader-fake-message-id)))) - -(defsubst nnheader-fake-message-id-p (id) - (save-match-data ; regular message-id's are <.*> - (string-match "\\`fake\\+none\\+[0-9]+\\'" id))) - -;; Parsing headers and NOV lines. - -(defsubst nnheader-remove-cr-followed-by-lf () - (goto-char (point-max)) - (while (search-backward "\r\n" nil t) - (delete-char 1))) - -(defsubst nnheader-header-value () - (skip-chars-forward " \t") - (buffer-substring (point) (gnus-point-at-eol))) - -(defun nnheader-parse-naked-head (&optional number) - ;; This function unfolds continuation lines in this buffer - ;; destructively. When this side effect is unwanted, use - ;; `nnheader-parse-head' instead of this function. - (let ((case-fold-search t) - (buffer-read-only nil) - (cur (current-buffer)) - (p (point-min)) - in-reply-to lines ref) - (nnheader-remove-cr-followed-by-lf) - (ietf-drums-unfold-fws) - (subst-char-in-region (point-min) (point-max) ?\t ? ) - (goto-char p) - (insert "\n") - (prog1 - ;; This implementation of this function, with nine - ;; search-forwards instead of the one re-search-forward and a - ;; case (which basically was the old function) is actually - ;; about twice as fast, even though it looks messier. You - ;; can't have everything, I guess. Speed and elegance don't - ;; always go hand in hand. - (vector - ;; Number. - (or number 0) - ;; Subject. - (progn - (goto-char p) - (if (search-forward "\nsubject:" nil t) - (nnheader-header-value) "(none)")) - ;; From. - (progn - (goto-char p) - (if (search-forward "\nfrom:" nil t) - (nnheader-header-value) "(nobody)")) - ;; Date. - (progn - (goto-char p) - (if (search-forward "\ndate:" nil t) - (nnheader-header-value) "")) - ;; Message-ID. - (progn - (goto-char p) - (if (search-forward "\nmessage-id:" nil t) - (buffer-substring - (1- (or (search-forward "<" (gnus-point-at-eol) t) - (point))) - (or (search-forward ">" (gnus-point-at-eol) t) (point))) - ;; If there was no message-id, we just fake one to make - ;; subsequent routines simpler. - (nnheader-generate-fake-message-id))) - ;; References. - (progn - (goto-char p) - (if (search-forward "\nreferences:" nil t) - (nnheader-header-value) - ;; Get the references from the in-reply-to header if - ;; there were no references and the in-reply-to header - ;; looks promising. - (if (and (search-forward "\nin-reply-to:" nil t) - (setq in-reply-to (nnheader-header-value)) - (string-match "<[^\n>]+>" in-reply-to)) - (let (ref2) - (setq ref (substring in-reply-to (match-beginning 0) - (match-end 0))) - (while (string-match "<[^\n>]+>" - in-reply-to (match-end 0)) - (setq ref2 (substring in-reply-to (match-beginning 0) - (match-end 0))) - (when (> (length ref2) (length ref)) - (setq ref ref2))) - ref) - nil))) - ;; Chars. - 0 - ;; Lines. - (progn - (goto-char p) - (if (search-forward "\nlines: " nil t) - (if (numberp (setq lines (read cur))) - lines 0) - 0)) - ;; Xref. - (progn - (goto-char p) - (and (search-forward "\nxref:" nil t) - (nnheader-header-value))) - ;; Extra. - (when nnmail-extra-headers - (let ((extra nnmail-extra-headers) - out) - (while extra - (goto-char p) - (when (search-forward - (concat "\n" (symbol-name (car extra)) ":") nil t) - (push (cons (car extra) (nnheader-header-value)) - out)) - (pop extra)) - out))) - (goto-char p) - (delete-char 1)))) - -(defun nnheader-parse-head (&optional naked) - (let ((cur (current-buffer)) num beg end) - (when (if naked - (setq num 0 - beg (point-min) - end (point-max)) - (goto-char (point-min)) - ;; Search to the beginning of the next header. Error - ;; messages do not begin with 2 or 3. - (when (re-search-forward "^[23][0-9]+ " nil t) - (end-of-line) - (setq num (read cur) - beg (point) - end (if (search-forward "\n.\n" nil t) - (- (point) 2) - (point))))) - (with-temp-buffer - (insert-buffer-substring cur beg end) - (nnheader-parse-naked-head num))))) - -(defmacro nnheader-nov-skip-field () - '(search-forward "\t" eol 'move)) - -(defmacro nnheader-nov-field () - '(buffer-substring (point) (if (nnheader-nov-skip-field) (1- (point)) eol))) - -(defmacro nnheader-nov-read-integer () - '(prog1 - (if (eq (char-after) ?\t) - 0 - (let ((num (condition-case nil - (read (current-buffer)) - (error nil)))) - (if (numberp num) num 0))) - (or (eobp) (forward-char 1)))) - -(defmacro nnheader-nov-parse-extra () - '(let (out string) - (while (not (memq (char-after) '(?\n nil))) - (setq string (nnheader-nov-field)) - (when (string-match "^\\([^ :]+\\): " string) - (push (cons (intern (match-string 1 string)) - (substring string (match-end 0))) - out))) - out)) - -(defmacro nnheader-nov-read-message-id () - '(let ((id (nnheader-nov-field))) - (if (string-match "^<[^>]+>$" id) - id - (nnheader-generate-fake-message-id)))) - -(defun nnheader-parse-nov () - (let ((eol (gnus-point-at-eol))) - (vector - (nnheader-nov-read-integer) ; number - (nnheader-nov-field) ; subject - (nnheader-nov-field) ; from - (nnheader-nov-field) ; date - (nnheader-nov-read-message-id) ; id - (nnheader-nov-field) ; refs - (nnheader-nov-read-integer) ; chars - (nnheader-nov-read-integer) ; lines - (if (eq (char-after) ?\n) - nil - (if (looking-at "Xref: ") - (goto-char (match-end 0))) - (nnheader-nov-field)) ; Xref - (nnheader-nov-parse-extra)))) ; extra - -(defun nnheader-insert-nov (header) - (princ (mail-header-number header) (current-buffer)) - (let ((p (point))) - (insert - "\t" - (or (mail-header-subject header) "(none)") "\t" - (or (mail-header-from header) "(nobody)") "\t" - (or (mail-header-date header) "") "\t" - (or (mail-header-id header) - (nnmail-message-id)) - "\t" - (or (mail-header-references header) "") "\t") - (princ (or (mail-header-chars header) 0) (current-buffer)) - (insert "\t") - (princ (or (mail-header-lines header) 0) (current-buffer)) - (insert "\t") - (when (mail-header-xref header) - (insert "Xref: " (mail-header-xref header))) - (when (or (mail-header-xref header) - (mail-header-extra header)) - (insert "\t")) - (when (mail-header-extra header) - (let ((extra (mail-header-extra header))) - (while extra - (insert (symbol-name (caar extra)) - ": " (cdar extra) "\t") - (pop extra)))) - (insert "\n") - (backward-char 1) - (while (search-backward "\n" p t) - (delete-char 1)) - (forward-line 1))) - -(defun nnheader-parse-overview-file (file) - "Parse FILE and return a list of headers." - (mm-with-unibyte-buffer - (nnheader-insert-file-contents file) - (goto-char (point-min)) - (let (headers) - (while (not (eobp)) - (push (nnheader-parse-nov) headers) - (forward-line 1)) - (nreverse headers)))) - -(defun nnheader-write-overview-file (file headers) - "Write HEADERS to FILE." - (with-temp-file file - (mapcar 'nnheader-insert-nov headers))) - -(defun nnheader-insert-header (header) - (insert - "Subject: " (or (mail-header-subject header) "(none)") "\n" - "From: " (or (mail-header-from header) "(nobody)") "\n" - "Date: " (or (mail-header-date header) "") "\n" - "Message-ID: " (or (mail-header-id header) (nnmail-message-id)) "\n" - "References: " (or (mail-header-references header) "") "\n" - "Lines: ") - (princ (or (mail-header-lines header) 0) (current-buffer)) - (insert "\n\n")) - -(defun nnheader-insert-article-line (article) - (goto-char (point-min)) - (insert "220 ") - (princ article (current-buffer)) - (insert " Article retrieved.\n") - (search-forward "\n\n" nil 'move) - (delete-region (point) (point-max)) - (forward-char -1) - (insert ".")) - -(defun nnheader-nov-delete-outside-range (beg end) - "Delete all NOV lines that lie outside the BEG to END range." - ;; First we find the first wanted line. - (nnheader-find-nov-line beg) - (delete-region (point-min) (point)) - ;; Then we find the last wanted line. - (when (nnheader-find-nov-line end) - (forward-line 1)) - (delete-region (point) (point-max))) - -(defun nnheader-find-nov-line (article) - "Put point at the NOV line that start with ARTICLE. -If ARTICLE doesn't exist, put point where that line -would have been. The function will return non-nil if -the line could be found." - ;; This function basically does a binary search. - (let ((max (point-max)) - (min (goto-char (point-min))) - (cur (current-buffer)) - (prev (point-min)) - num found) - (while (not found) - (goto-char (+ min (/ (- max min) 2))) - (beginning-of-line) - (if (or (= (point) prev) - (eobp)) - (setq found t) - (setq prev (point)) - (while (and (not (numberp (setq num (read cur)))) - (not (eobp))) - (gnus-delete-line)) - (cond ((> num article) - (setq max (point))) - ((< num article) - (setq min (point))) - (t - (setq found 'yes))))) - ;; We may be at the first line. - (when (and (not num) - (not (eobp))) - (setq num (read cur))) - ;; Now we may have found the article we're looking for, or we - ;; may be somewhere near it. - (when (and (not (eq found 'yes)) - (not (eq num article))) - (setq found (point)) - (while (and (< (point) max) - (or (not (numberp num)) - (< num article))) - (forward-line 1) - (setq found (point)) - (or (eobp) - (= (setq num (read cur)) article))) - (unless (eq num article) - (goto-char found))) - (beginning-of-line) - (eq num article))) - -;; Various cruft the backends and Gnus need to communicate. - -(defvar nntp-server-buffer nil) -(defvar nntp-process-response nil) -(defvar news-reply-yank-from nil) -(defvar news-reply-yank-message-id nil) - -(defvar nnheader-callback-function nil) - -(defun nnheader-init-server-buffer () - "Initialize the Gnus-backend communication buffer." - (save-excursion - (unless (gnus-buffer-live-p nntp-server-buffer) - (setq nntp-server-buffer (get-buffer-create " *nntpd*"))) - (set-buffer nntp-server-buffer) - (mm-enable-multibyte) - (erase-buffer) - (kill-all-local-variables) - (setq case-fold-search t) ;Should ignore case. - (set (make-local-variable 'nntp-process-response) nil) - t)) - -;;; Various functions the backends use. - -(defun nnheader-file-error (file) - "Return a string that says what is wrong with FILE." - (format - (cond - ((not (file-exists-p file)) - "%s does not exist") - ((file-directory-p file) - "%s is a directory") - ((not (file-readable-p file)) - "%s is not readable")) - file)) - -(defun nnheader-insert-head (file) - "Insert the head of the article." - (when (file-exists-p file) - (if (eq nnheader-max-head-length t) - ;; Just read the entire file. - (nnheader-insert-file-contents file) - ;; Read blocks of the size specified by `nnheader-head-chop-length' - ;; until we find a separator. - (let ((beg 0) - (start (point)) - ;; Use `binary' to prevent the contents from being decoded, - ;; or it will change the number of characters that - ;; `insert-file-contents' returns. - (coding-system-for-read 'binary)) - (while (and (eq nnheader-head-chop-length - (nth 1 (mm-insert-file-contents - file nil beg - (incf beg nnheader-head-chop-length)))) - ;; CRLF or CR might be used for the line-break code. - (prog1 (not (re-search-forward "\n\r?\n\\|\r\r" nil t)) - (goto-char (point-max))) - (or (null nnheader-max-head-length) - (< beg nnheader-max-head-length)))) - ;; Finally decode the contents. - (when (mm-coding-system-p nnheader-file-coding-system) - (mm-decode-coding-region start (point-max) - nnheader-file-coding-system)))) - t)) - -(defun nnheader-article-p () - "Say whether the current buffer looks like an article." - (goto-char (point-min)) - (if (not (search-forward "\n\n" nil t)) - nil - (narrow-to-region (point-min) (1- (point))) - (goto-char (point-min)) - (while (looking-at "[a-zA-Z][^ \t]+:.*\n\\([ \t].*\n\\)*\\|From .*\n") - (goto-char (match-end 0))) - (prog1 - (eobp) - (widen)))) - -(defun nnheader-insert-references (references message-id) - "Insert a References header based on REFERENCES and MESSAGE-ID." - (if (and (not references) (not message-id)) - ;; This is invalid, but not all articles have Message-IDs. - () - (mail-position-on-field "References") - (let ((begin (gnus-point-at-bol)) - (fill-column 78) - (fill-prefix "\t")) - (when references - (insert references)) - (when (and references message-id) - (insert " ")) - (when message-id - (insert message-id)) - ;; Fold long References lines to conform to RFC1036 (sort of). - ;; The region must end with a newline to fill the region - ;; without inserting extra newline. - (fill-region-as-paragraph begin (1+ (point)))))) - -(defun nnheader-replace-header (header new-value) - "Remove HEADER and insert the NEW-VALUE." - (save-excursion - (save-restriction - (nnheader-narrow-to-headers) - (prog1 - (message-remove-header header) - (goto-char (point-max)) - (insert header ": " new-value "\n"))))) - -(defun nnheader-narrow-to-headers () - "Narrow to the head of an article." - (widen) - (narrow-to-region - (goto-char (point-min)) - (if (search-forward "\n\n" nil t) - (1- (point)) - (point-max))) - (goto-char (point-min))) - -(defun nnheader-remove-body () - "Remove the body from an article in this current buffer." - (goto-char (point-min)) - (when (re-search-forward "\n\r?\n" nil t) - (delete-region (point) (point-max)))) - -(defun nnheader-set-temp-buffer (name &optional noerase) - "Set-buffer to an empty (possibly new) buffer called NAME with undo disabled." - (set-buffer (get-buffer-create name)) - (buffer-disable-undo) - (unless noerase - (erase-buffer)) - (current-buffer)) - -(eval-when-compile (defvar jka-compr-compression-info-list)) -(defvar nnheader-numerical-files - (if (boundp 'jka-compr-compression-info-list) - (concat "\\([0-9]+\\)\\(" - (mapconcat (lambda (i) (aref i 0)) - jka-compr-compression-info-list "\\|") - "\\)?") - "[0-9]+$") - "Regexp that match numerical files.") - -(defvar nnheader-numerical-short-files (concat "^" nnheader-numerical-files) - "Regexp that matches numerical file names.") - -(defvar nnheader-numerical-full-files (concat "/" nnheader-numerical-files) - "Regexp that matches numerical full file names.") - -(defsubst nnheader-file-to-number (file) - "Take a FILE name and return the article number." - (if (string= nnheader-numerical-short-files "^[0-9]+$") - (string-to-number file) - (string-match nnheader-numerical-short-files file) - (string-to-number (match-string 0 file)))) - -(defvar nnheader-directory-files-is-safe - (or (eq system-type 'windows-nt) - (and (not (featurep 'xemacs)) - (> emacs-major-version 20))) - "If non-nil, Gnus believes `directory-files' is safe. -It has been reported numerous times that `directory-files' fails with -an alarming frequency on NFS mounted file systems. If it is nil, -`nnheader-directory-files-safe' is used.") - -(defun nnheader-directory-files-safe (&rest args) - "Execute `directory-files' twice and returns the longer result." - (let ((first (apply 'directory-files args)) - (second (apply 'directory-files args))) - (if (> (length first) (length second)) - first - second))) - -(defun nnheader-directory-articles (dir) - "Return a list of all article files in directory DIR." - (mapcar 'nnheader-file-to-number - (if nnheader-directory-files-is-safe - (directory-files - dir nil nnheader-numerical-short-files t) - (nnheader-directory-files-safe - dir nil nnheader-numerical-short-files t)))) - -(defun nnheader-article-to-file-alist (dir) - "Return an alist of article/file pairs in DIR." - (mapcar (lambda (file) (cons (nnheader-file-to-number file) file)) - (if nnheader-directory-files-is-safe - (directory-files - dir nil nnheader-numerical-short-files t) - (nnheader-directory-files-safe - dir nil nnheader-numerical-short-files t)))) - -(defun nnheader-fold-continuation-lines () - "Fold continuation lines in the current buffer." - (nnheader-replace-regexp "\\(\r?\n[ \t]+\\)+" " ")) - -(defun nnheader-translate-file-chars (file &optional full) - "Translate FILE into something that can be a file name. -If FULL, translate everything." - (if (null nnheader-file-name-translation-alist) - ;; No translation is necessary. - file - (let* ((i 0) - trans leaf path len) - (if full - ;; Do complete translation. - (setq leaf (copy-sequence file) - path "" - i (if (and (< 1 (length leaf)) (eq ?: (aref leaf 1))) - 2 0)) - ;; We translate -- but only the file name. We leave the directory - ;; alone. - (if (and (featurep 'xemacs) - (memq system-type '(cygwin32 win32 w32 mswindows windows-nt - cygwin))) - ;; This is needed on NT and stuff, because - ;; file-name-nondirectory is not enough to split - ;; file names, containing ':', e.g. - ;; "d:\\Work\\News\\nntp+news.fido7.ru:fido7.ru.gnu.SCORE" - ;; - ;; we are trying to correctly split such names: - ;; "d:file.name" -> "a:" "file.name" - ;; "aaa:bbb.ccc" -> "" "aaa:bbb.ccc" - ;; "d:aaa\\bbb:ccc" -> "d:aaa\\" "bbb:ccc" - ;; etc. - ;; to translate then only the file name part. - (progn - (setq leaf file - path "") - (if (string-match "\\(^\\w:\\|[/\\]\\)\\([^/\\]+\\)$" file) - (setq leaf (substring file (match-beginning 2)) - path (substring file 0 (match-beginning 2))))) - ;; Emacs DTRT, says andrewi. - (setq leaf (file-name-nondirectory file) - path (file-name-directory file)))) - (setq len (length leaf)) - (while (< i len) - (when (setq trans (cdr (assq (aref leaf i) - nnheader-file-name-translation-alist))) - (aset leaf i trans)) - (incf i)) - (concat path leaf)))) - -(defun nnheader-report (backend &rest args) - "Report an error from the BACKEND. -The first string in ARGS can be a format string." - (set (intern (format "%s-status-string" backend)) - (if (< (length args) 2) - (car args) - (apply 'format args))) - nil) - -(defun nnheader-get-report (backend) - "Get the most recent report from BACKEND." - (condition-case () - (nnheader-message 5 "%s" (symbol-value (intern (format "%s-status-string" - backend)))) - (error (nnheader-message 5 "")))) - -(defun nnheader-insert (format &rest args) - "Clear the communication buffer and insert FORMAT and ARGS into the buffer. -If FORMAT isn't a format string, it and all ARGS will be inserted -without formatting." - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (if (string-match "%" format) - (insert (apply 'format format args)) - (apply 'insert format args)) - t)) - -(defsubst nnheader-replace-chars-in-string (string from to) - (mm-subst-char-in-string from to string)) - -(defun nnheader-replace-duplicate-chars-in-string (string from to) - "Replace characters in STRING from FROM to TO." - (let ((string (substring string 0)) ;Copy string. - (len (length string)) - (idx 0) prev i) - ;; Replace all occurrences of FROM with TO. - (while (< idx len) - (setq i (aref string idx)) - (when (and (eq prev from) (= i from)) - (aset string (1- idx) to) - (aset string idx to)) - (setq prev i) - (setq idx (1+ idx))) - string)) - -(defun nnheader-file-to-group (file &optional top) - "Return a group name based on FILE and TOP." - (nnheader-replace-chars-in-string - (if (not top) - file - (condition-case () - (substring (expand-file-name file) - (length - (expand-file-name - (file-name-as-directory top)))) - (error ""))) - nnheader-directory-separator-character ?.)) - -(defun nnheader-message (level &rest args) - "Message if the Gnus backends are talkative." - (if (or (not (numberp gnus-verbose-backends)) - (<= level gnus-verbose-backends)) - (apply 'message args) - (apply 'format args))) - -(defun nnheader-be-verbose (level) - "Return whether the backends should be verbose on LEVEL." - (or (not (numberp gnus-verbose-backends)) - (<= level gnus-verbose-backends))) - -(defvar nnheader-pathname-coding-system 'iso-8859-1 - "*Coding system for file name.") - -(defun nnheader-group-pathname (group dir &optional file) - "Make file name for GROUP." - (concat - (let ((dir (file-name-as-directory (expand-file-name dir)))) - ;; If this directory exists, we use it directly. - (file-name-as-directory - (if (file-directory-p (concat dir group)) - (expand-file-name group dir) - ;; If not, we translate dots into slashes. - (expand-file-name (mm-encode-coding-string - (nnheader-replace-chars-in-string group ?. ?/) - nnheader-pathname-coding-system) - dir)))) - (cond ((null file) "") - ((numberp file) (int-to-string file)) - (t file)))) - -(defun nnheader-concat (dir &rest files) - "Concat DIR as directory to FILES." - (apply 'concat (file-name-as-directory dir) files)) - -(defun nnheader-ms-strip-cr () - "Strip ^M from the end of all lines." - (save-excursion - (nnheader-remove-cr-followed-by-lf))) - -(defun nnheader-file-size (file) - "Return the file size of FILE or 0." - (or (nth 7 (file-attributes file)) 0)) - -(defun nnheader-find-etc-directory (package &optional file first) - "Go through `load-path' and find the \"../etc/PACKAGE\" directory. -This function will look in the parent directory of each `load-path' -entry, and look for the \"etc\" directory there. -If FILE, find the \".../etc/PACKAGE\" file instead. -If FIRST is non-nil, return the directory or the file found at the -first. Otherwise, find the newest one, though it may take a time." - (let ((path load-path) - dir results) - ;; We try to find the dir by looking at the load path, - ;; stripping away the last component and adding "etc/". - (while path - (if (and (car path) - (file-exists-p - (setq dir (concat - (file-name-directory - (directory-file-name (car path))) - "etc/" package - (if file "" "/")))) - (or file (file-directory-p dir))) - (progn - (or (member dir results) - (push dir results)) - (setq path (if first nil (cdr path)))) - (setq path (cdr path)))) - (if (or first (not (cdr results))) - (car results) - (car (sort results 'file-newer-than-file-p))))) - -(eval-when-compile - (defvar ange-ftp-path-format) - (defvar efs-path-regexp)) -(defun nnheader-re-read-dir (path) - "Re-read directory PATH if PATH is on a remote system." - (if (and (fboundp 'efs-re-read-dir) (boundp 'efs-path-regexp)) - (when (string-match efs-path-regexp path) - (efs-re-read-dir path)) - (when (and (fboundp 'ange-ftp-re-read-dir) (boundp 'ange-ftp-path-format)) - (when (string-match (car ange-ftp-path-format) path) - (ange-ftp-re-read-dir path))))) - -(defvar nnheader-file-coding-system 'raw-text - "Coding system used in file backends of Gnus.") - -(defun nnheader-insert-file-contents (filename &optional visit beg end replace) - "Like `insert-file-contents', q.v., but only reads in the file. -A buffer may be modified in several ways after reading into the buffer due -to advanced Emacs features, such as file-name-handlers, format decoding, -find-file-hooks, etc. - This function ensures that none of these modifications will take place." - (let ((coding-system-for-read nnheader-file-coding-system)) - (mm-insert-file-contents filename visit beg end replace))) - -(defun nnheader-insert-nov-file (file first) - (let ((size (nth 7 (file-attributes file))) - (cutoff (* 32 1024))) - (when size - (if (< size cutoff) - ;; If the file is small, we just load it. - (nnheader-insert-file-contents file) - ;; We start on the assumption that FIRST is pretty recent. If - ;; not, we just insert the rest of the file as well. - (let (current) - (nnheader-insert-file-contents file nil (- size cutoff) size) - (goto-char (point-min)) - (delete-region (point) (or (search-forward "\n" nil 'move) (point))) - (setq current (ignore-errors (read (current-buffer)))) - (if (and (numberp current) - (< current first)) - t - (delete-region (point-min) (point-max)) - (nnheader-insert-file-contents file))))))) - -(defun nnheader-find-file-noselect (&rest args) - "Open a file with some variables bound. -See `find-file-noselect' for the arguments." - (let* ((format-alist nil) - (auto-mode-alist (mm-auto-mode-alist)) - (default-major-mode 'fundamental-mode) - (enable-local-variables nil) - (after-insert-file-functions nil) - (enable-local-eval nil) - (coding-system-for-read nnheader-file-coding-system) - (ffh (if (boundp 'find-file-hook) - 'find-file-hook - 'find-file-hooks)) - (val (symbol-value ffh))) - (set ffh nil) - (unwind-protect - (apply 'find-file-noselect args) - (set ffh val)))) - -(defun nnheader-directory-regular-files (dir) - "Return a list of all regular files in DIR." - (let ((files (directory-files dir t)) - out) - (while files - (when (file-regular-p (car files)) - (push (car files) out)) - (pop files)) - (nreverse out))) - -(defun nnheader-directory-files (&rest args) - "Same as `directory-files', but prune \".\" and \"..\"." - (let ((files (apply 'directory-files args)) - out) - (while files - (unless (member (file-name-nondirectory (car files)) '("." "..")) - (push (car files) out)) - (pop files)) - (nreverse out))) - -(defmacro nnheader-skeleton-replace (from &optional to regexp) - `(let ((new (generate-new-buffer " *nnheader replace*")) - (cur (current-buffer)) - (start (point-min))) - (set-buffer cur) - (goto-char (point-min)) - (while (,(if regexp 're-search-forward 'search-forward) - ,from nil t) - (insert-buffer-substring - cur start (prog1 (match-beginning 0) (set-buffer new))) - (goto-char (point-max)) - ,(when to `(insert ,to)) - (set-buffer cur) - (setq start (point))) - (insert-buffer-substring - cur start (prog1 (point-max) (set-buffer new))) - (copy-to-buffer cur (point-min) (point-max)) - (kill-buffer (current-buffer)) - (set-buffer cur))) - -(defun nnheader-replace-string (from to) - "Do a fast replacement of FROM to TO from point to `point-max'." - (nnheader-skeleton-replace from to)) - -(defun nnheader-replace-regexp (from to) - "Do a fast regexp replacement of FROM to TO from point to `point-max'." - (nnheader-skeleton-replace from to t)) - -(defun nnheader-strip-cr () - "Strip all \r's from the current buffer." - (nnheader-skeleton-replace "\r")) - -(defalias 'nnheader-run-at-time 'run-at-time) -(defalias 'nnheader-cancel-timer 'cancel-timer) -(defalias 'nnheader-cancel-function-timers 'cancel-function-timers) -(defalias 'nnheader-string-as-multibyte 'string-as-multibyte) - -(defun nnheader-accept-process-output (process) - (accept-process-output - process - (truncate nnheader-read-timeout) - (truncate (* (- nnheader-read-timeout - (truncate nnheader-read-timeout)) - 1000)))) - -(when (featurep 'xemacs) - (require 'nnheaderxm)) - -(run-hooks 'nnheader-load-hook) - -(provide 'nnheader) - -;;; arch-tag: a9c4b7d9-52ae-4ec9-b196-dfd93124d202 -;;; nnheader.el ends here diff --git a/xemacs-packages/gnus/lisp/nnheaderxm.el b/xemacs-packages/gnus/lisp/nnheaderxm.el deleted file mode 100644 index 9eabc4dd..00000000 --- a/xemacs-packages/gnus/lisp/nnheaderxm.el +++ /dev/null @@ -1,100 +0,0 @@ -;;; nnheaderxm.el --- making Gnus backends work under XEmacs - -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2008 -;; Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(if (condition-case nil - (progn - (unless (or itimer-process itimer-timer) - (itimer-driver-start)) - ;; Check whether there is a bug to which the difference of - ;; the present time and the time when the itimer driver was - ;; woken up is subtracted from the initial itimer value. - (let* ((inhibit-quit t) - (ctime (current-time)) - (itimer-timer-last-wakeup - (prog1 - ctime - (setcar ctime (1- (car ctime))))) - (itimer-list nil) - (itimer (start-itimer "nnheader-run-at-time" 'ignore 5))) - (sleep-for 0.1) ;; Accept the timeout interrupt. - (prog1 - (> (itimer-value itimer) 0) - (delete-itimer itimer)))) - (error nil)) - (defun nnheader-xmas-run-at-time (time repeat function &rest args) - "Emulating function run as `run-at-time'. -TIME should be nil meaning now, or a number of seconds from now. -Return an itimer object which can be used in either `delete-itimer' -or `cancel-timer'." - (apply #'start-itimer "nnheader-run-at-time" - function (if time (max time 1e-9) 1e-9) - repeat nil t args)) - (defun nnheader-xmas-run-at-time (time repeat function &rest args) - "Emulating function run as `run-at-time' in the right way. -TIME should be nil meaning now, or a number of seconds from now. -Return an itimer object which can be used in either `delete-itimer' -or `cancel-timer'." - (let ((itimers (list nil))) - (setcar - itimers - (apply #'start-itimer "nnheader-run-at-time" - (lambda (itimers repeat function &rest args) - (let ((itimer (car itimers))) - (if repeat - (progn - (set-itimer-function - itimer - (lambda (itimer repeat function &rest args) - (set-itimer-restart itimer repeat) - (set-itimer-function itimer function) - (set-itimer-function-arguments itimer args) - (apply function args))) - (set-itimer-function-arguments - itimer - (append (list itimer repeat function) args))) - (set-itimer-function - itimer - (lambda (itimer function &rest args) - (delete-itimer itimer) - (apply function args))) - (set-itimer-function-arguments - itimer - (append (list itimer function) args))))) - 1e-9 (if time (max time 1e-9) 1e-9) - nil t itimers repeat function args))))) - -(defalias 'nnheader-run-at-time 'nnheader-xmas-run-at-time) -(defalias 'nnheader-cancel-timer 'delete-itimer) -(defalias 'nnheader-cancel-function-timers 'ignore) -(defalias 'nnheader-string-as-multibyte 'identity) - -(provide 'nnheaderxm) - -;;; arch-tag: ee2b3387-d3ca-4de6-9b64-304d838706dd -;;; nnheaderxm.el ends here diff --git a/xemacs-packages/gnus/lisp/nnimap.el b/xemacs-packages/gnus/lisp/nnimap.el deleted file mode 100644 index 8b8a0929..00000000 --- a/xemacs-packages/gnus/lisp/nnimap.el +++ /dev/null @@ -1,1716 +0,0 @@ -;;; nnimap.el --- imap backend for Gnus - -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Simon Josefsson -;; Jim Radford -;; Keywords: mail - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; Todo, major things: -;; -;; o Fix Gnus to view correct number of unread/total articles in group buffer -;; o Fix Gnus to handle leading '.' in group names (fixed?) -;; o Finish disconnected mode (moving articles between mailboxes unplugged) -;; o Sieve -;; o MIME (partial article fetches) -;; o Split to other backends, different split rules for different -;; servers/inboxes -;; -;; Todo, minor things: -;; -;; o Don't require half of Gnus -- backends should be standalone -;; o Verify that we don't use IMAP4rev1 specific things (RFC2060 App B) -;; o Dont uid fetch 1,* in nnimap-retrive-groups (slow) -;; o Split up big fetches (1,* header especially) in smaller chunks -;; o What do I do with gnus-newsgroup-*? -;; o Tell Gnus about new groups (how can we tell?) -;; o Respooling (fix Gnus?) (unnecessary?) -;; o Add support for the following: (if applicable) -;; request-list-newsgroups, request-regenerate -;; list-active-group, -;; request-associate-buffer, request-restore-buffer, -;; o Do The Right Thing when UIDVALIDITY changes (what's the right thing?) -;; o Support RFC2221 (Login referrals) -;; o IMAP2BIS compatibility? (RFC2061) -;; o ACAP stuff (perhaps a different project, would be nice to ACAPify -;; .newsrc.eld) -;; o What about Gnus's article editing, can we support it? NO! -;; o Use \Draft to support the draft group?? -;; o Duplicate suppression -;; o Rewrite UID SEARCH UID X as UID FETCH X (UID) for those with slow servers - -;;; Code: - -(require 'imap) -(require 'nnoo) -(require 'nnmail) -(require 'nnheader) -(require 'mm-util) -(require 'gnus) -(require 'gnus-range) -(require 'gnus-start) -(require 'gnus-int) - -(eval-when-compile (require 'cl)) - -(nnoo-declare nnimap) - -(defconst nnimap-version "nnimap 1.0") - -(defgroup nnimap nil - "Reading IMAP mail with Gnus." - :group 'gnus) - -(defvoo nnimap-address nil - "Address of physical IMAP server. If nil, use the virtual server's name.") - -(defvoo nnimap-server-port nil - "Port number on physical IMAP server. -If nil, defaults to 993 for TLS/SSL connections and 143 otherwise.") - -;; Splitting variables - -(defcustom nnimap-split-crosspost t - "If non-nil, do crossposting if several split methods match the mail. -If nil, the first match found will be used." - :group 'nnimap - :type 'boolean) - -(defcustom nnimap-split-inbox nil - "Name of mailbox to split mail from. - -Mail is read from this mailbox and split according to rules in -`nnimap-split-rule'. - -This can be a string or a list of strings." - :group 'nnimap - :type '(choice (string) - (repeat string))) - -(define-widget 'nnimap-strict-function 'function - "This widget only matches values that are functionp. - -Warning: This means that a value that is the symbol of a not yet -loaded function will not match. Use with care." - :match 'nnimap-strict-function-match) - -(defun nnimap-strict-function-match (widget value) - "Ignoring WIDGET, match if VALUE is a function." - (functionp value)) - -(defcustom nnimap-split-rule nil - "Mail will be split according to these rules. - -Mail is read from mailbox(es) specified in `nnimap-split-inbox'. - -If you'd like, for instance, one mail group for mail from the -\"gnus-imap\" mailing list, one group for junk mail and leave -everything else in the incoming mailbox, you could do something like -this: - -\(setq nnimap-split-rule '((\"INBOX.gnus-imap\" \"From:.*gnus-imap\") - (\"INBOX.junk\" \"Subject:.*buy\"))) - -As you can see, `nnimap-split-rule' is a list of lists, where the -first element in each \"rule\" is the name of the IMAP mailbox (or the -symbol `junk' if you want to remove the mail), and the second is a -regexp that nnimap will try to match on the header to find a fit. - -The second element can also be a function. In that case, it will be -called narrowed to the headers with the first element of the rule as -the argument. It should return a non-nil value if it thinks that the -mail belongs in that group. - -This variable can also have a function as its value, the function will -be called with the headers narrowed and should return a group where it -thinks the article should be splitted to. See `nnimap-split-fancy'. - -To allow for different split rules on different virtual servers, and -even different split rules in different inboxes on the same server, -the syntax of this variable have been extended along the lines of: - -\(setq nnimap-split-rule - '((\"my1server\" (\".*\" ((\"ding\" \"ding@gnus.org\") - (\"junk\" \"From:.*Simon\"))) - (\"my2server\" (\"INBOX\" nnimap-split-fancy)) - (\"my[34]server\" (\".*\" ((\"private\" \"To:.*Simon\") - (\"junk\" my-junk-func))))) - -The virtual server name is in fact a regexp, so that the same rules -may apply to several servers. In the example, the servers -\"my3server\" and \"my4server\" both use the same rules. Similarly, -the inbox string is also a regexp. The actual splitting rules are as -before, either a function, or a list with group/regexp or -group/function elements." - :group 'nnimap - :type '(choice :tag "Rule type" - (repeat :menu-tag "Single-server" - :tag "Single-server list" - (list (string :tag "Mailbox") - (choice :tag "Predicate" - (regexp :tag "A regexp") - (nnimap-strict-function :tag "A function")))) - (choice :menu-tag "A function" - :tag "A function" - (function-item nnimap-split-fancy) - (function-item nnmail-split-fancy) - (nnimap-strict-function :tag "User-defined function")) - (repeat :menu-tag "Multi-server (extended)" - :tag "Multi-server list" - (list (regexp :tag "Server regexp") - (list (regexp :tag "Incoming Mailbox regexp") - (repeat :tag "Rules for matching server(s) and mailbox(es)" - (list (string :tag "Destination mailbox") - (choice :tag "Predicate" - (regexp :tag "A Regexp") - (nnimap-strict-function :tag "A Function"))))))))) - -(defcustom nnimap-split-predicate "UNSEEN UNDELETED" - "The predicate used to find articles to split. -If you use another IMAP client to peek on articles but always would -like nnimap to split them once it's started, you could change this to -\"UNDELETED\". Other available predicates are available in -RFC2060 section 6.4.4." - :group 'nnimap - :type 'string) - -(defcustom nnimap-split-fancy nil - "Like the variable `nnmail-split-fancy'." - :group 'nnimap - :type 'sexp) - -(defvar nnimap-split-download-body-default nil - "Internal variable with default value for `nnimap-split-download-body'.") - -(defcustom nnimap-split-download-body 'default - "Whether to download entire articles during splitting. -This is generally not required, and will slow things down considerably. -You may need it if you want to use an advanced splitting function that -analyzes the body before splitting the article. -If this variable is nil, bodies will not be downloaded; if this -variable is the symbol `default' the default behavior is -used (which currently is nil, unless you use a statistical -spam.el test); if this variable is another non-nil value bodies -will be downloaded." - :version "22.1" - :group 'nnimap - :type '(choice (const :tag "Let system decide" deault) - boolean)) - -;; Performance / bug workaround variables - -(defcustom nnimap-close-asynchronous t - "Close mailboxes asynchronously in `nnimap-close-group'. -This means that errors caught by nnimap when closing the mailbox will -not prevent Gnus from updating the group status, which may be harmful. -However, it increases speed." - :version "22.1" - :type 'boolean - :group 'nnimap) - -(defcustom nnimap-dont-close t - "Never close mailboxes. -This increases the speed of closing mailboxes (quiting group) but may -decrease the speed of selecting another mailbox later. Re-selecting -the same mailbox will be faster though." - :version "22.1" - :type 'boolean - :group 'nnimap) - -(defcustom nnimap-retrieve-groups-asynchronous t - "Send asynchronous STATUS commands for each mailbox before checking mail. -If you have mailboxes that rarely receives mail, this speeds up new -mail checking. It works by first sending STATUS commands for each -mailbox, and then only checking groups which has a modified UIDNEXT -more carefully for new mail. - -In summary, the default is O((1-p)*k+p*n) and changing it to nil makes -it O(n). If p is small, then the default is probably faster." - :version "22.1" - :type 'boolean - :group 'nnimap) - -(defvoo nnimap-need-unselect-to-notice-new-mail nil - "Unselect mailboxes before looking for new mail in them. -Some servers seem to need this under some circumstances.") - -;; Authorization / Privacy variables - -(defvoo nnimap-auth-method nil - "Obsolete.") - -(defvoo nnimap-stream nil - "How nnimap will connect to the server. - -The default, nil, will try to use the \"best\" method the server can -handle. - -Change this if - -1) you want to connect with TLS/SSL. The TLS/SSL integration - with IMAP is suboptimal so you'll have to tell it - specifically. - -2) your server is more capable than your environment -- i.e. your - server accept Kerberos login's but you haven't installed the - `imtest' program or your machine isn't configured for Kerberos. - -Possible choices: gssapi, kerberos4, starttls, tls, ssl, network, shell. -See also `imap-streams' and `imap-stream-alist'.") - -(defvoo nnimap-authenticator nil - "How nnimap authenticate itself to the server. - -The default, nil, will try to use the \"best\" method the server can -handle. - -There is only one reason for fiddling with this variable, and that is -if your server is more capable than your environment -- i.e. you -connect to a server that accept Kerberos login's but you haven't -installed the `imtest' program or your machine isn't configured for -Kerberos. - -Possible choices: gssapi, kerberos4, digest-md5, cram-md5, login, anonymous. -See also `imap-authenticators' and `imap-authenticator-alist'") - -(defvoo nnimap-directory (nnheader-concat gnus-directory "overview/") - "Directory to keep NOV cache files for nnimap groups. -See also `nnimap-nov-file-name'.") - -(defvoo nnimap-nov-file-name "nnimap." - "NOV cache base filename. -The group name and `nnimap-nov-file-name-suffix' will be appended. A -typical complete file name would be -~/News/overview/nnimap.pdc.INBOX.ding.nov, or -~/News/overview/nnimap/pdc/INBOX/ding/nov if -`nnmail-use-long-file-names' is nil") - -(defvoo nnimap-nov-file-name-suffix ".novcache" - "Suffix for NOV cache base filename.") - -(defvoo nnimap-nov-is-evil gnus-agent - "If non-nil, never generate or use a local nov database for this backend. -Using nov databases should speed up header fetching considerably. -However, it will invoke a UID SEARCH UID command on the server, and -some servers implement this command inefficiently by opening each and -every message in the group, thus making it quite slow. -Unlike other backends, you do not need to take special care if you -flip this variable.") - -(defvoo nnimap-search-uids-not-since-is-evil nil - "If non-nil, avoid \"UID SEARCH UID ... NOT SINCE\" queries when expiring. -Instead, use \"UID SEARCH SINCE\" to prune the list of expirable -articles within Gnus. This seems to be faster on Courier in some cases.") - -(defvoo nnimap-expunge-on-close 'always ; 'ask, 'never - "Whether to expunge a group when it is closed. -When a IMAP group with articles marked for deletion is closed, this -variable determine if nnimap should actually remove the articles or -not. - -If always, nnimap always perform a expunge when closing the group. -If never, nnimap never expunges articles marked for deletion. -If ask, nnimap will ask you if you wish to expunge marked articles. - -When setting this variable to `never', you can only expunge articles -by using `G x' (gnus-group-nnimap-expunge) from the Group buffer.") - -(defvoo nnimap-list-pattern "*" - "A string LIMIT or list of strings with mailbox wildcards used to limit available groups. -See below for available wildcards. - -The LIMIT string can be a cons cell (REFERENCE . LIMIT), where -REFERENCE will be passed as the first parameter to LIST/LSUB. The -semantics of this are server specific, on the University of Washington -server you can specify a directory. - -Example: - '(\"INBOX\" \"mail/*\" (\"~friend/mail/\" . \"list/*\")) - -There are two wildcards * and %. * matches everything, % matches -everything in the current hierarchy.") - -(defvoo nnimap-news-groups nil - "IMAP support a news-like mode, also known as bulletin board mode, -where replies is sent via IMAP instead of SMTP. - -This variable should contain a regexp matching groups where you wish -replies to be stored to the mailbox directly. - -Example: - '(\"^[^I][^N][^B][^O][^X].*$\") - -This will match all groups not beginning with \"INBOX\". - -Note that there is nothing technically different between mail-like and -news-like mailboxes. If you wish to have a group with todo items or -similar which you wouldn't want to set up a mailing list for, you can -use this to make replies go directly to the group.") - -(defvoo nnimap-expunge-search-string "UID %s NOT SINCE %s" - "IMAP search command to use for articles that are to be expired. -The first %s is replaced by a UID set of articles to search on, -and the second %s is replaced by a date criterium. - -One useful (and perhaps the only useful) value to change this to would -be `UID %s NOT SENTSINCE %s' to make nnimap use the Date: header -instead of the internal date of messages. See section 6.4.4 of RFC -2060 for more information on valid strings. - -However, if `nnimap-search-uids-not-since-is-evil' is true, this -variable has no effect since the search logic is reversed.") - -(defvoo nnimap-importantize-dormant t - "If non-nil, mark \"dormant\" articles as \"ticked\" for other IMAP clients. -Note that within Gnus, dormant articles will still (only) be -marked as ticked. This is to make \"dormant\" articles stand out, -just like \"ticked\" articles, in other IMAP clients.") - -(defvoo nnimap-server-address nil - "Obsolete. Use `nnimap-address'.") - -(defcustom nnimap-authinfo-file "~/.authinfo" - "Authorization information for IMAP servers. In .netrc format." - :type - '(choice file - (repeat :tag "Entries" - :menu-tag "Inline" - (list :format "%v" - :value ("" ("login" . "") ("password" . "")) - (string :tag "Host") - (checklist :inline t - (cons :format "%v" - (const :format "" "login") - (string :format "Login: %v")) - (cons :format "%v" - (const :format "" "password") - (string :format "Password: %v")))))) - :group 'nnimap) - -(defcustom nnimap-prune-cache t - "If non-nil, nnimap check whether articles still exist on server before using data stored in NOV cache." - :type 'boolean - :group 'nnimap) - -(defvar nnimap-request-list-method 'imap-mailbox-list - "Method to use to request a list of all folders from the server. -If this is 'imap-mailbox-lsub, then use a server-side subscription list to -restrict visible folders.") - -(defcustom nnimap-debug nil - "If non-nil, random debug spews are placed in *nnimap-debug* buffer. -Note that username, passwords and other privacy sensitive -information (such as e-mail) may be stored in the *nnimap-debug* -buffer. It is not written to disk, however. Do not enable this -variable unless you are comfortable with that." - :group 'nnimap - :type 'boolean) - -;; Internal variables: - -(defvar nnimap-debug-buffer "*nnimap-debug*") -(defvar nnimap-mailbox-info (gnus-make-hashtable 997)) -(defvar nnimap-current-move-server nil) -(defvar nnimap-current-move-group nil) -(defvar nnimap-current-move-article nil) -(defvar nnimap-length) -(defvar nnimap-progress-chars '(?| ?/ ?- ?\\)) -(defvar nnimap-progress-how-often 20) -(defvar nnimap-counter) -(defvar nnimap-server-buffer-alist nil) ;; Map server name to buffers. -(defvar nnimap-current-server nil) ;; Current server -(defvar nnimap-server-buffer nil) ;; Current servers' buffer - - - -(nnoo-define-basics nnimap) - -;; Utility functions: - -(defsubst nnimap-get-server-buffer (server) - "Return buffer for SERVER, if nil use current server." - (cadr (assoc (or server nnimap-current-server) nnimap-server-buffer-alist))) - -(defun nnimap-possibly-change-server (server) - "Return buffer for SERVER, changing the current server as a side-effect. -If SERVER is nil, uses the current server." - (setq nnimap-current-server (or server nnimap-current-server) - nnimap-server-buffer (nnimap-get-server-buffer nnimap-current-server))) - -(defun nnimap-verify-uidvalidity (group server) - "Verify stored uidvalidity match current one in GROUP on SERVER." - (let* ((gnusgroup (gnus-group-prefixed-name - group (gnus-server-to-method - (format "nnimap:%s" server)))) - (new-uidvalidity (imap-mailbox-get 'uidvalidity)) - (old-uidvalidity (gnus-group-get-parameter gnusgroup 'uidvalidity)) - (dir (file-name-as-directory (expand-file-name nnimap-directory))) - (nameuid (nnheader-translate-file-chars - (concat nnimap-nov-file-name - (if (equal server "") - "unnamed" - server) "." group "." old-uidvalidity - nnimap-nov-file-name-suffix) t)) - (file (if (or nnmail-use-long-file-names - (file-exists-p (expand-file-name nameuid dir))) - (expand-file-name nameuid dir) - (expand-file-name - (mm-encode-coding-string - (nnheader-replace-chars-in-string nameuid ?. ?/) - nnmail-pathname-coding-system) - dir)))) - (if old-uidvalidity - (if (not (equal old-uidvalidity new-uidvalidity)) - ;; uidvalidity clash - (gnus-delete-file file) - (gnus-group-set-parameter gnusgroup 'uidvalidity new-uidvalidity) - t) - (gnus-group-add-parameter gnusgroup (cons 'uidvalidity new-uidvalidity)) - t))) - -(defun nnimap-before-find-minmax-bugworkaround () - "Function called before iterating through mailboxes with -`nnimap-find-minmax-uid'." - (when nnimap-need-unselect-to-notice-new-mail - ;; XXX this is for UoW imapd problem, it doesn't notice new mail in - ;; currently selected mailbox without a re-select/examine. - (or (null (imap-current-mailbox nnimap-server-buffer)) - (imap-mailbox-unselect nnimap-server-buffer)))) - -(defun nnimap-find-minmax-uid (group &optional examine) - "Find lowest and highest active article number in GROUP. -If EXAMINE is non-nil the group is selected read-only." - (with-current-buffer nnimap-server-buffer - (when (or (string= group (imap-current-mailbox)) - (imap-mailbox-select group examine)) - (let (minuid maxuid) - (when (> (imap-mailbox-get 'exists) 0) - (imap-fetch "1,*" "UID" nil 'nouidfetch) - (imap-message-map (lambda (uid Uid) - (setq minuid (if minuid (min minuid uid) uid) - maxuid (if maxuid (max maxuid uid) uid))) - 'UID)) - (list (imap-mailbox-get 'exists) minuid maxuid))))) - -(defun nnimap-possibly-change-group (group &optional server) - "Make GROUP the current group, and SERVER the current server." - (when (nnimap-possibly-change-server server) - (with-current-buffer nnimap-server-buffer - (if (or (null group) (imap-current-mailbox-p group)) - imap-current-mailbox - (if (imap-mailbox-select group) - (if (or (nnimap-verify-uidvalidity - group (or server nnimap-current-server)) - (zerop (imap-mailbox-get 'exists group)) - t ;; for OGnus to see if ignoring uidvalidity - ;; changes has any bad effects. - (yes-or-no-p - (format - "nnimap: Group %s is not uidvalid. Continue? " group))) - imap-current-mailbox - (imap-mailbox-unselect) - (error "nnimap: Group %s is not uid-valid" group)) - (nnheader-report 'nnimap (imap-error-text))))))) - -(defun nnimap-replace-whitespace (string) - "Return STRING with all whitespace replaced with space." - (when string - (while (string-match "[\r\n\t]+" string) - (setq string (replace-match " " t t string))) - string)) - -;; Required backend functions - -(defun nnimap-retrieve-headers-progress () - "Hook to insert NOV line for current article into `nntp-server-buffer'." - (and (numberp nnmail-large-newsgroup) - (zerop (% (incf nnimap-counter) nnimap-progress-how-often)) - (> nnimap-length nnmail-large-newsgroup) - (nnheader-message 6 "nnimap: Retrieving headers... %c" - (nth (/ (% nnimap-counter - (* (length nnimap-progress-chars) - nnimap-progress-how-often)) - nnimap-progress-how-often) - nnimap-progress-chars))) - (with-current-buffer nntp-server-buffer - (let (headers lines chars uid mbx) - (with-current-buffer nnimap-server-buffer - (setq uid imap-current-message - mbx imap-current-mailbox - headers (nnimap-demule - (if (imap-capability 'IMAP4rev1) - ;; xxx don't just use car? alist doesn't contain - ;; anything else now, but it might... - (nth 2 (car (imap-message-get uid 'BODYDETAIL))) - (imap-message-get uid 'RFC822.HEADER))) - lines (imap-body-lines (imap-message-body imap-current-message)) - chars (imap-message-get imap-current-message 'RFC822.SIZE))) - (nnheader-insert-nov - (with-temp-buffer - (buffer-disable-undo) - (insert headers) - (let ((head (nnheader-parse-naked-head))) - (mail-header-set-number head uid) - (mail-header-set-chars head chars) - (mail-header-set-lines head lines) - (mail-header-set-xref - head (format "%s %s:%d" (system-name) mbx uid)) - head)))))) - -(defun nnimap-retrieve-which-headers (articles fetch-old) - "Get a range of articles to fetch based on ARTICLES and FETCH-OLD." - (with-current-buffer nnimap-server-buffer - (if (numberp (car-safe articles)) - (imap-search - (concat "UID " - (imap-range-to-message-set - (gnus-compress-sequence - (append (gnus-uncompress-sequence - (and fetch-old - (cons (if (numberp fetch-old) - (max 1 (- (car articles) fetch-old)) - 1) - (1- (car articles))))) - articles))))) - (mapcar (lambda (msgid) - (imap-search - (format "HEADER Message-Id \"%s\"" msgid))) - articles)))) - -(defun nnimap-group-overview-filename (group server) - "Make file name for GROUP on SERVER." - (let* ((dir (file-name-as-directory (expand-file-name nnimap-directory))) - (uidvalidity (gnus-group-get-parameter - (gnus-group-prefixed-name - group (gnus-server-to-method - (format "nnimap:%s" server))) - 'uidvalidity)) - (name (nnheader-translate-file-chars - (concat nnimap-nov-file-name - (if (equal server "") - "unnamed" - server) "." group nnimap-nov-file-name-suffix) t)) - (nameuid (nnheader-translate-file-chars - (concat nnimap-nov-file-name - (if (equal server "") - "unnamed" - server) "." group "." uidvalidity - nnimap-nov-file-name-suffix) t)) - (oldfile (if (or nnmail-use-long-file-names - (file-exists-p (expand-file-name name dir))) - (expand-file-name name dir) - (expand-file-name - (mm-encode-coding-string - (nnheader-replace-chars-in-string name ?. ?/) - nnmail-pathname-coding-system) - dir))) - (newfile (if (or nnmail-use-long-file-names - (file-exists-p (expand-file-name nameuid dir))) - (expand-file-name nameuid dir) - (expand-file-name - (mm-encode-coding-string - (nnheader-replace-chars-in-string nameuid ?. ?/) - nnmail-pathname-coding-system) - dir)))) - (when (and (file-exists-p oldfile) (not (file-exists-p newfile))) - (message "nnimap: Upgrading novcache filename...") - (sit-for 1) - (gnus-make-directory (file-name-directory newfile)) - (unless (ignore-errors (rename-file oldfile newfile) t) - (if (ignore-errors (copy-file oldfile newfile) t) - (delete-file oldfile) - (error "Can't rename `%s' to `%s'" oldfile newfile)))) - newfile)) - -(defun nnimap-retrieve-headers-from-file (group server) - (with-current-buffer nntp-server-buffer - (let ((nov (nnimap-group-overview-filename group server))) - (when (file-exists-p nov) - (mm-insert-file-contents nov) - (set-buffer-modified-p nil) - (let ((min (ignore-errors (goto-char (point-min)) - (read (current-buffer)))) - (max (ignore-errors (goto-char (point-max)) - (forward-line -1) - (read (current-buffer))))) - (if (and (numberp min) (numberp max)) - (cons min max) - ;; junk, remove it, it's saved later - (erase-buffer) - nil)))))) - -(defun nnimap-retrieve-headers-from-server (articles group server) - (with-current-buffer nnimap-server-buffer - (let ((imap-fetch-data-hook '(nnimap-retrieve-headers-progress)) - (nnimap-length (gnus-range-length articles)) - (nnimap-counter 0)) - (imap-fetch (imap-range-to-message-set articles) - (concat "(UID RFC822.SIZE BODY " - (let ((headers - (append '(Subject From Date Message-Id - References In-Reply-To Xref) - (copy-sequence - nnmail-extra-headers)))) - (if (imap-capability 'IMAP4rev1) - (format "BODY.PEEK[HEADER.FIELDS %s])" headers) - (format "RFC822.HEADER.LINES %s)" headers))))) - (with-current-buffer nntp-server-buffer - (sort-numeric-fields 1 (point-min) (point-max))) - (and (numberp nnmail-large-newsgroup) - (> nnimap-length nnmail-large-newsgroup) - (nnheader-message 6 "nnimap: Retrieving headers...done"))))) - -(defun nnimap-dont-use-nov-p (group server) - (or gnus-nov-is-evil nnimap-nov-is-evil - (unless (and (gnus-make-directory - (file-name-directory - (nnimap-group-overview-filename group server))) - (file-writable-p - (nnimap-group-overview-filename group server))) - (message "nnimap: Nov cache not writable, %s" - (nnimap-group-overview-filename group server))))) - -(deffoo nnimap-retrieve-headers (articles &optional group server fetch-old) - (when (nnimap-possibly-change-group group server) - (with-current-buffer nntp-server-buffer - (erase-buffer) - (if (nnimap-dont-use-nov-p group server) - (nnimap-retrieve-headers-from-server - (gnus-compress-sequence articles) group server) - (let (uids cached low high) - (when (setq uids (nnimap-retrieve-which-headers articles fetch-old) - low (car uids) - high (car (last uids))) - (if (setq cached (nnimap-retrieve-headers-from-file group server)) - (progn - ;; fetch articles with uids before cache block - (when (< low (car cached)) - (goto-char (point-min)) - (nnimap-retrieve-headers-from-server - (cons low (1- (car cached))) group server)) - ;; fetch articles with uids after cache block - (when (> high (cdr cached)) - (goto-char (point-max)) - (nnimap-retrieve-headers-from-server - (cons (1+ (cdr cached)) high) group server)) - (when nnimap-prune-cache - ;; remove nov's for articles which has expired on server - (goto-char (point-min)) - (dolist (uid (gnus-set-difference articles uids)) - (when (re-search-forward (format "^%d\t" uid) nil t) - (gnus-delete-line))))) - ;; nothing cached, fetch whole range from server - (nnimap-retrieve-headers-from-server - (cons low high) group server)) - (when (buffer-modified-p) - (nnmail-write-region - (point-min) (point-max) - (nnimap-group-overview-filename group server) nil 'nomesg)) - (nnheader-nov-delete-outside-range low high)))) - 'nov))) - -(defun nnimap-open-connection (server) - (if (not (imap-open nnimap-address nnimap-server-port nnimap-stream - nnimap-authenticator nnimap-server-buffer)) - (nnheader-report 'nnimap "Can't open connection to server %s" server) - (unless (or (imap-capability 'IMAP4 nnimap-server-buffer) - (imap-capability 'IMAP4rev1 nnimap-server-buffer)) - (imap-close nnimap-server-buffer) - (nnheader-report 'nnimap "Server %s is not IMAP4 compliant" server)) - (let* ((list (progn (gnus-message 7 "Parsing authinfo file `%s'." - nnimap-authinfo-file) - (gnus-parse-netrc nnimap-authinfo-file))) - (port (if nnimap-server-port - (int-to-string nnimap-server-port) - "imap")) - (alist (or (gnus-netrc-machine list server port "imap") - (gnus-netrc-machine list server port "imaps") - (gnus-netrc-machine list - (or nnimap-server-address - nnimap-address) - port "imap") - (gnus-netrc-machine list - (or nnimap-server-address - nnimap-address) - port "imaps"))) - (user (gnus-netrc-get alist "login")) - (passwd (gnus-netrc-get alist "password"))) - (if (imap-authenticate user passwd nnimap-server-buffer) - (prog1 - (push (list server nnimap-server-buffer) - nnimap-server-buffer-alist) - (nnimap-possibly-change-server server)) - (imap-close nnimap-server-buffer) - (kill-buffer nnimap-server-buffer) - (nnheader-report 'nnimap "Could not authenticate to %s" server))))) - -(deffoo nnimap-open-server (server &optional defs) - (nnheader-init-server-buffer) - (if (nnimap-server-opened server) - t - (unless (assq 'nnimap-server-buffer defs) - (push (list 'nnimap-server-buffer (concat " *nnimap* " server)) defs)) - ;; translate `nnimap-server-address' to `nnimap-address' in defs - ;; for people that configured nnimap with a very old version - (unless (assq 'nnimap-address defs) - (if (assq 'nnimap-server-address defs) - (push (list 'nnimap-address - (cadr (assq 'nnimap-server-address defs))) defs) - (push (list 'nnimap-address server) defs))) - (nnoo-change-server 'nnimap server defs) - (or nnimap-server-buffer - (setq nnimap-server-buffer (cadr (assq 'nnimap-server-buffer defs)))) - (with-current-buffer (get-buffer-create nnimap-server-buffer) - (nnoo-change-server 'nnimap server defs)) - (or (and nnimap-server-buffer - (imap-opened nnimap-server-buffer) - (if (with-current-buffer nnimap-server-buffer - (memq imap-state '(auth select examine))) - t - (imap-close nnimap-server-buffer) - (nnimap-open-connection server))) - (nnimap-open-connection server)))) - -(deffoo nnimap-server-opened (&optional server) - "Whether SERVER is opened. -If SERVER is the current virtual server, and the connection to the -physical server is alive, this function return a non-nil value. If -SERVER is nil, it is treated as the current server." - ;; clean up autologouts?? - (and (or server nnimap-current-server) - (nnoo-server-opened 'nnimap (or server nnimap-current-server)) - (imap-opened (nnimap-get-server-buffer server)))) - -(deffoo nnimap-close-server (&optional server) - "Close connection to server and free all resources connected to it. -Return nil if the server couldn't be closed for some reason." - (let ((server (or server nnimap-current-server))) - (when (or (nnimap-server-opened server) - (imap-opened (nnimap-get-server-buffer server))) - (imap-close (nnimap-get-server-buffer server)) - (kill-buffer (nnimap-get-server-buffer server)) - (setq nnimap-server-buffer nil - nnimap-current-server nil - nnimap-server-buffer-alist - (delq server nnimap-server-buffer-alist))) - (nnoo-close-server 'nnimap server))) - -(deffoo nnimap-request-close () - "Close connection to all servers and free all resources that the backend have reserved. -All buffers that have been created by that -backend should be killed. (Not the nntp-server-buffer, though.) This -function is generally only called when Gnus is shutting down." - (mapcar (lambda (server) (nnimap-close-server (car server))) - nnimap-server-buffer-alist) - (setq nnimap-server-buffer-alist nil)) - -(deffoo nnimap-status-message (&optional server) - "This function returns the last error message from server." - (when (nnimap-possibly-change-server server) - (nnoo-status-message 'nnimap server))) - -(defun nnimap-demule (string) - ;; BEWARE: we used to use string-as-multibyte here which is braindead - ;; because it will turn accidental emacs-mule-valid byte sequences - ;; into multibyte chars. --Stef - ;; Reverted, braindead got 7.5 out of 10 on imdb, so it can't be - ;; that bad. --Simon - (funcall (if (and (fboundp 'string-as-multibyte) - (subrp (symbol-function 'string-as-multibyte))) - 'string-as-multibyte - 'identity) - (or string ""))) - -(defun nnimap-make-callback (article gnus-callback buffer) - "Return a callback function." - `(lambda () - (nnimap-callback ,article ,gnus-callback ,buffer))) - -(defun nnimap-callback (article gnus-callback buffer) - (when (eq article (imap-current-message)) - (remove-hook 'imap-fetch-data-hook - (nnimap-make-callback article gnus-callback buffer)) - (with-current-buffer buffer - (insert - (with-current-buffer nnimap-server-buffer - (nnimap-demule - (if (imap-capability 'IMAP4rev1) - ;; xxx don't just use car? alist doesn't contain - ;; anything else now, but it might... - (nth 2 (car (imap-message-get article 'BODYDETAIL))) - (imap-message-get article 'RFC822))))) - (nnheader-ms-strip-cr) - (funcall gnus-callback t)))) - -(defun nnimap-request-article-part (article part prop &optional - group server to-buffer detail) - (when (nnimap-possibly-change-group group server) - (let ((article (if (stringp article) - (car-safe (imap-search - (format "HEADER Message-Id \"%s\"" article) - nnimap-server-buffer)) - article))) - (when article - (gnus-message 10 "nnimap: Fetching (part of) article %d from %s..." - article (or group imap-current-mailbox - gnus-newsgroup-name)) - (if (not nnheader-callback-function) - (with-current-buffer (or to-buffer nntp-server-buffer) - (erase-buffer) - (let ((data (imap-fetch article part prop nil - nnimap-server-buffer))) - (insert (nnimap-demule (if detail - (nth 2 (car data)) - data)))) - (nnheader-ms-strip-cr) - (gnus-message - 10 "nnimap: Fetching (part of) article %d from %s...done" - article (or group imap-current-mailbox gnus-newsgroup-name)) - (if (bobp) - (nnheader-report 'nnimap "No such article %d in %s: %s" - article (or group imap-current-mailbox - gnus-newsgroup-name) - (imap-error-text nnimap-server-buffer)) - (cons group article))) - (add-hook 'imap-fetch-data-hook - (nnimap-make-callback article - nnheader-callback-function - nntp-server-buffer)) - (imap-fetch-asynch article part nil nnimap-server-buffer) - (cons group article)))))) - -(deffoo nnimap-asynchronous-p () - t) - -(deffoo nnimap-request-article (article &optional group server to-buffer) - (if (imap-capability 'IMAP4rev1 nnimap-server-buffer) - (nnimap-request-article-part - article "BODY.PEEK[]" 'BODYDETAIL group server to-buffer 'detail) - (nnimap-request-article-part - article "RFC822.PEEK" 'RFC822 group server to-buffer))) - -(deffoo nnimap-request-head (article &optional group server to-buffer) - (if (imap-capability 'IMAP4rev1 nnimap-server-buffer) - (nnimap-request-article-part - article "BODY.PEEK[HEADER]" 'BODYDETAIL group server to-buffer 'detail) - (nnimap-request-article-part - article "RFC822.HEADER" 'RFC822.HEADER group server to-buffer))) - -(deffoo nnimap-request-body (article &optional group server to-buffer) - (if (imap-capability 'IMAP4rev1 nnimap-server-buffer) - (nnimap-request-article-part - article "BODY.PEEK[TEXT]" 'BODYDETAIL group server to-buffer 'detail) - (nnimap-request-article-part - article "RFC822.TEXT.PEEK" 'RFC822.TEXT group server to-buffer))) - -(deffoo nnimap-request-group (group &optional server fast) - (nnimap-request-update-info-internal - group - (gnus-get-info (gnus-group-prefixed-name - group (gnus-server-to-method (format "nnimap:%s" server)))) - server) - (when (nnimap-possibly-change-group group server) - (nnimap-before-find-minmax-bugworkaround) - (let (info) - (cond (fast group) - ((null (setq info (nnimap-find-minmax-uid group t))) - (nnheader-report 'nnimap "Could not get active info for %s" - group)) - (t - (nnheader-insert "211 %d %d %d %s\n" (or (nth 0 info) 0) - (max 1 (or (nth 1 info) 1)) - (or (nth 2 info) 0) group) - (nnheader-report 'nnimap "Group %s selected" group) - t))))) - -(defun nnimap-update-unseen (group &optional server) - "Update the unseen count in `nnimap-mailbox-info'." - (gnus-sethash - (gnus-group-prefixed-name group server) - (let ((old (gnus-gethash-safe (gnus-group-prefixed-name group server) - nnimap-mailbox-info))) - (list (nth 0 old) (nth 1 old) - (imap-mailbox-status group 'unseen nnimap-server-buffer) - (nth 3 old))) - nnimap-mailbox-info)) - -(defun nnimap-close-group (group &optional server) - (with-current-buffer nnimap-server-buffer - (when (and (imap-opened) - (nnimap-possibly-change-group group server)) - (nnimap-update-unseen group server) - (case nnimap-expunge-on-close - (always (progn - (imap-mailbox-expunge nnimap-close-asynchronous) - (unless nnimap-dont-close - (imap-mailbox-close nnimap-close-asynchronous)))) - (ask (if (and (imap-search "DELETED") - (gnus-y-or-n-p (format "Expunge articles in group `%s'? " - imap-current-mailbox))) - (progn - (imap-mailbox-expunge nnimap-close-asynchronous) - (unless nnimap-dont-close - (imap-mailbox-close nnimap-close-asynchronous))) - (imap-mailbox-unselect))) - (t (imap-mailbox-unselect))) - (not imap-current-mailbox)))) - -(defun nnimap-pattern-to-list-arguments (pattern) - (mapcar (lambda (p) - (cons (car-safe p) (or (cdr-safe p) p))) - (if (and (listp pattern) - (listp (cdr pattern))) - pattern - (list pattern)))) - -(deffoo nnimap-request-list (&optional server) - (when (nnimap-possibly-change-server server) - (with-current-buffer nntp-server-buffer - (erase-buffer)) - (gnus-message 5 "nnimap: Generating active list%s..." - (if (> (length server) 0) (concat " for " server) "")) - (nnimap-before-find-minmax-bugworkaround) - (with-current-buffer nnimap-server-buffer - (dolist (pattern (nnimap-pattern-to-list-arguments nnimap-list-pattern)) - (dolist (mbx (funcall nnimap-request-list-method - (cdr pattern) (car pattern))) - (or (member "\\NoSelect" (imap-mailbox-get 'list-flags mbx)) - (let ((info (nnimap-find-minmax-uid mbx 'examine))) - (when info - (with-current-buffer nntp-server-buffer - (insert (format "\"%s\" %d %d y\n" - mbx (or (nth 2 info) 0) - (max 1 (or (nth 1 info) 1))))))))))) - (gnus-message 5 "nnimap: Generating active list%s...done" - (if (> (length server) 0) (concat " for " server) "")) - t)) - -(deffoo nnimap-request-post (&optional server) - (let ((success t)) - (dolist (mbx (message-unquote-tokens - (message-tokenize-header - (message-fetch-field "Newsgroups") ", ")) success) - (let ((to-newsgroup (gnus-group-prefixed-name mbx gnus-command-method))) - (or (gnus-active to-newsgroup) - (gnus-activate-group to-newsgroup) - (if (gnus-y-or-n-p (format "No such group: %s. Create it? " - to-newsgroup)) - (or (and (gnus-request-create-group - to-newsgroup gnus-command-method) - (gnus-activate-group to-newsgroup nil nil - gnus-command-method)) - (error "Couldn't create group %s" to-newsgroup))) - (error "No such group: %s" to-newsgroup)) - (unless (nnimap-request-accept-article mbx (nth 1 gnus-command-method)) - (setq success nil)))))) - -;; Optional backend functions - -(defun nnimap-string-lessp-numerical (s1 s2) - "Return t if first arg string is less than second in numerical order." - (cond ((string= s1 s2) - nil) - ((> (length s1) (length s2)) - nil) - ((< (length s1) (length s2)) - t) - ((< (string-to-number (substring s1 0 1)) - (string-to-number (substring s2 0 1))) - t) - ((> (string-to-number (substring s1 0 1)) - (string-to-number (substring s2 0 1))) - nil) - (t - (nnimap-string-lessp-numerical (substring s1 1) (substring s2 1))))) - -(deffoo nnimap-retrieve-groups (groups &optional server) - (when (nnimap-possibly-change-server server) - (gnus-message 5 "nnimap: Checking mailboxes...") - (with-current-buffer nntp-server-buffer - (erase-buffer) - (nnimap-before-find-minmax-bugworkaround) - (let (asyncgroups slowgroups) - (if (null nnimap-retrieve-groups-asynchronous) - (setq slowgroups groups) - (dolist (group groups) - (gnus-message 9 "nnimap: Quickly checking mailbox %s" group) - (add-to-list (if (gnus-gethash-safe - (gnus-group-prefixed-name group server) - nnimap-mailbox-info) - 'asyncgroups - 'slowgroups) - (list group (imap-mailbox-status-asynch - group '(uidvalidity uidnext unseen) - nnimap-server-buffer)))) - (dolist (asyncgroup asyncgroups) - (let ((group (nth 0 asyncgroup)) - (tag (nth 1 asyncgroup)) - new old) - (when (imap-ok-p (imap-wait-for-tag tag nnimap-server-buffer)) - (if (or (not (string= - (nth 0 (gnus-gethash (gnus-group-prefixed-name - group server) - nnimap-mailbox-info)) - (imap-mailbox-get 'uidvalidity group - nnimap-server-buffer))) - (not (string= - (nth 1 (gnus-gethash (gnus-group-prefixed-name - group server) - nnimap-mailbox-info)) - (imap-mailbox-get 'uidnext group - nnimap-server-buffer)))) - (push (list group) slowgroups) - (insert (nth 3 (gnus-gethash (gnus-group-prefixed-name - group server) - nnimap-mailbox-info)))))))) - (dolist (group slowgroups) - (if nnimap-retrieve-groups-asynchronous - (setq group (car group))) - (gnus-message 7 "nnimap: Mailbox %s modified" group) - (imap-mailbox-put 'uidnext nil group nnimap-server-buffer) - (or (member "\\NoSelect" (imap-mailbox-get 'list-flags group - nnimap-server-buffer)) - (let* ((info (nnimap-find-minmax-uid group 'examine)) - (str (format "\"%s\" %d %d y\n" group - (or (nth 2 info) 0) - (max 1 (or (nth 1 info) 1))))) - (when (> (or (imap-mailbox-get 'recent group - nnimap-server-buffer) 0) - 0) - (push (list (cons group 0)) nnmail-split-history)) - (insert str) - (when nnimap-retrieve-groups-asynchronous - (gnus-sethash - (gnus-group-prefixed-name group server) - (list (or (imap-mailbox-get - 'uidvalidity group nnimap-server-buffer) - (imap-mailbox-status - group 'uidvalidity nnimap-server-buffer)) - (or (imap-mailbox-get - 'uidnext group nnimap-server-buffer) - (imap-mailbox-status - group 'uidnext nnimap-server-buffer)) - (or (imap-mailbox-get - 'unseen group nnimap-server-buffer) - (imap-mailbox-status - group 'unseen nnimap-server-buffer)) - str) - nnimap-mailbox-info))))))) - (gnus-message 5 "nnimap: Checking mailboxes...done") - 'active)) - -(deffoo nnimap-request-update-info-internal (group info &optional server) - (when (nnimap-possibly-change-group group server) - (when info ;; xxx what does this mean? should we create a info? - (with-current-buffer nnimap-server-buffer - (gnus-message 5 "nnimap: Updating info for %s..." - (gnus-info-group info)) - - (when (nnimap-mark-permanent-p 'read) - (let (seen unseen) - ;; read info could contain articles marked unread by other - ;; imap clients! we correct this - (setq unseen (gnus-compress-sequence - (imap-search "UNSEEN UNDELETED")) - seen (gnus-range-difference (gnus-info-read info) unseen) - seen (gnus-range-add seen - (gnus-compress-sequence - (imap-search "SEEN"))) - seen (if (and (integerp (car seen)) - (null (cdr seen))) - (list (cons (car seen) (car seen))) - seen)) - (gnus-info-set-read info seen))) - - (mapcar (lambda (pred) - (when (or (eq (cdr pred) 'recent) - (and (nnimap-mark-permanent-p (cdr pred)) - (member (nnimap-mark-to-flag (cdr pred)) - (imap-mailbox-get 'flags)))) - (gnus-info-set-marks - info - (gnus-update-alist-soft - (cdr pred) - (gnus-compress-sequence - (imap-search (nnimap-mark-to-predicate (cdr pred)))) - (gnus-info-marks info)) - t))) - gnus-article-mark-lists) - - (when nnimap-importantize-dormant - ;; nnimap mark dormant article as ticked too (for other clients) - ;; so we remove that mark for gnus since we support dormant - (gnus-info-set-marks - info - (gnus-update-alist-soft - 'tick - (gnus-remove-from-range - (cdr-safe (assoc 'tick (gnus-info-marks info))) - (cdr-safe (assoc 'dormant (gnus-info-marks info)))) - (gnus-info-marks info)) - t)) - - (gnus-message 5 "nnimap: Updating info for %s...done" - (gnus-info-group info)) - - info)))) - -(deffoo nnimap-request-type (group &optional article) - (if (and nnimap-news-groups (string-match nnimap-news-groups group)) - 'news - 'mail)) - -(deffoo nnimap-request-set-mark (group actions &optional server) - (when (nnimap-possibly-change-group group server) - (with-current-buffer nnimap-server-buffer - (let (action) - (gnus-message 7 "nnimap: Setting marks in %s..." group) - (while (setq action (pop actions)) - (let ((range (nth 0 action)) - (what (nth 1 action)) - (cmdmarks (nth 2 action)) - marks) - ;; bookmark can't be stored (not list/range - (setq cmdmarks (delq 'bookmark cmdmarks)) - ;; killed can't be stored (not list/range - (setq cmdmarks (delq 'killed cmdmarks)) - ;; unsent are for nndraft groups only - (setq cmdmarks (delq 'unsent cmdmarks)) - ;; cache flags are pointless on the server - (setq cmdmarks (delq 'cache cmdmarks)) - ;; seen flags are local to each gnus - (setq cmdmarks (delq 'seen cmdmarks)) - ;; recent marks can't be set - (setq cmdmarks (delq 'recent cmdmarks)) - (when nnimap-importantize-dormant - ;; flag dormant articles as ticked - (if (memq 'dormant cmdmarks) - (setq cmdmarks (cons 'tick cmdmarks)))) - ;; remove stuff we are forbidden to store - (mapcar (lambda (mark) - (if (imap-message-flag-permanent-p - (nnimap-mark-to-flag mark)) - (setq marks (cons mark marks)))) - cmdmarks) - (when (and range marks) - (cond ((eq what 'del) - (imap-message-flags-del - (imap-range-to-message-set range) - (nnimap-mark-to-flag marks nil t))) - ((eq what 'add) - (imap-message-flags-add - (imap-range-to-message-set range) - (nnimap-mark-to-flag marks nil t))) - ((eq what 'set) - (imap-message-flags-set - (imap-range-to-message-set range) - (nnimap-mark-to-flag marks nil t))))))) - (gnus-message 7 "nnimap: Setting marks in %s...done" group)))) - nil) - -(defun nnimap-split-fancy () - "Like the function `nnmail-split-fancy', but uses `nnimap-split-fancy'." - (let ((nnmail-split-fancy nnimap-split-fancy)) - (nnmail-split-fancy))) - -(defun nnimap-split-to-groups (rules) - ;; tries to match all rules in nnimap-split-rule against content of - ;; nntp-server-buffer, returns a list of groups that matched. - (with-current-buffer nntp-server-buffer - ;; Fold continuation lines. - (goto-char (point-min)) - (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) - (replace-match " " t t)) - (if (functionp rules) - (funcall rules) - (let (to-groups regrepp) - (catch 'split-done - (dolist (rule rules to-groups) - (let ((group (car rule)) - (regexp (cadr rule))) - (goto-char (point-min)) - (when (and (if (stringp regexp) - (progn - (if (not (stringp group)) - (setq group (eval group)) - (setq regrepp - (string-match "\\\\[0-9&]" group))) - (re-search-forward regexp nil t)) - (funcall regexp group)) - ;; Don't enter the article into the same group twice. - (not (assoc group to-groups))) - (push (if regrepp - (nnmail-expand-newtext group) - group) - to-groups) - (or nnimap-split-crosspost - (throw 'split-done to-groups)))))))))) - -(defun nnimap-assoc-match (key alist) - (let (element) - (while (and alist (not element)) - (if (string-match (car (car alist)) key) - (setq element (car alist))) - (setq alist (cdr alist))) - element)) - -(defun nnimap-split-find-rule (server inbox) - (if (and (listp nnimap-split-rule) (listp (car nnimap-split-rule)) - (list (cdar nnimap-split-rule)) (listp (cadar nnimap-split-rule))) - ;; extended format - (cadr (nnimap-assoc-match inbox (cdr (nnimap-assoc-match - server nnimap-split-rule)))) - nnimap-split-rule)) - -(defun nnimap-split-find-inbox (server) - (if (listp nnimap-split-inbox) - nnimap-split-inbox - (list nnimap-split-inbox))) - -(defun nnimap-split-articles (&optional group server) - (when (nnimap-possibly-change-server server) - (with-current-buffer nnimap-server-buffer - (let (rule inbox removeorig (inboxes (nnimap-split-find-inbox server))) - ;; iterate over inboxes - (while (and (setq inbox (pop inboxes)) - (nnimap-possibly-change-group inbox)) ;; SELECT - ;; find split rule for this server / inbox - (when (setq rule (nnimap-split-find-rule server inbox)) - ;; iterate over articles - (dolist (article (imap-search nnimap-split-predicate)) - (when (if (if (eq nnimap-split-download-body 'default) - nnimap-split-download-body-default - nnimap-split-download-body) - (and (nnimap-request-article article) - (with-current-buffer nntp-server-buffer (mail-narrow-to-head))) - (nnimap-request-head article)) - ;; copy article to right group(s) - (setq removeorig nil) - (dolist (to-group (nnimap-split-to-groups rule)) - (cond ((eq to-group 'junk) - (message "IMAP split removed %s:%s:%d" server inbox - article) - (setq removeorig t)) - ((imap-message-copy (number-to-string article) - to-group nil 'nocopyuid) - (message "IMAP split moved %s:%s:%d to %s" server - inbox article to-group) - (setq removeorig t) - (when nnmail-cache-accepted-message-ids - (with-current-buffer nntp-server-buffer - (let (msgid) - (and (setq msgid - (nnmail-fetch-field "message-id")) - (nnmail-cache-insert msgid - to-group - (nnmail-fetch-field "subject")))))) - ;; Add the group-art list to the history list. - (push (list (cons to-group 0)) nnmail-split-history)) - (t - (message "IMAP split failed to move %s:%s:%d to %s" - server inbox article to-group)))) - (if (if (eq nnimap-split-download-body 'default) - nnimap-split-download-body-default - nnimap-split-download-body) - (widen)) - ;; remove article if it was successfully copied somewhere - (and removeorig - (imap-message-flags-add (format "%d" article) - "\\Seen \\Deleted"))))) - (when (imap-mailbox-select inbox) ;; just in case - ;; todo: UID EXPUNGE (if available) to remove splitted articles - (imap-mailbox-expunge) - (imap-mailbox-close))) - (when nnmail-cache-accepted-message-ids - (nnmail-cache-close)) - t)))) - -(deffoo nnimap-request-scan (&optional group server) - (nnimap-split-articles group server)) - -(deffoo nnimap-request-newgroups (date &optional server) - (when (nnimap-possibly-change-server server) - (with-current-buffer nntp-server-buffer - (gnus-message 5 "nnimap: Listing subscribed mailboxes%s%s..." - (if (> (length server) 0) " on " "") server) - (erase-buffer) - (nnimap-before-find-minmax-bugworkaround) - (dolist (pattern (nnimap-pattern-to-list-arguments - nnimap-list-pattern)) - (dolist (mbx (imap-mailbox-lsub (cdr pattern) (car pattern) nil - nnimap-server-buffer)) - (or (catch 'found - (dolist (mailbox (imap-mailbox-get 'list-flags mbx - nnimap-server-buffer)) - (if (string= (downcase mailbox) "\\noselect") - (throw 'found t))) - nil) - (let ((info (nnimap-find-minmax-uid mbx 'examine))) - (when info - (insert (format "\"%s\" %d %d y\n" - mbx (or (nth 2 info) 0) - (max 1 (or (nth 1 info) 1))))))))) - (gnus-message 5 "nnimap: Listing subscribed mailboxes%s%s...done" - (if (> (length server) 0) " on " "") server)) - t)) - -(deffoo nnimap-request-create-group (group &optional server args) - (when (nnimap-possibly-change-server server) - (or (imap-mailbox-status group 'uidvalidity nnimap-server-buffer) - (imap-mailbox-create group nnimap-server-buffer) - (nnheader-report 'nnimap "%S" - (imap-error-text nnimap-server-buffer))))) - -(defun nnimap-time-substract (time1 time2) - "Return TIME for TIME1 - TIME2." - (let* ((ms (- (car time1) (car time2))) - (ls (- (nth 1 time1) (nth 1 time2)))) - (if (< ls 0) - (list (- ms 1) (+ (expt 2 16) ls)) - (list ms ls)))) - -(eval-when-compile (require 'parse-time)) -(defun nnimap-date-days-ago (daysago) - "Return date, in format \"3-Aug-1998\", for DAYSAGO days ago." - (require 'parse-time) - (let* ((time (nnimap-time-substract (current-time) (days-to-time daysago))) - (date (format-time-string - (format "%%d-%s-%%Y" - (capitalize (car (rassoc (nth 4 (decode-time time)) - parse-time-months)))) - time))) - (if (eq ?0 (string-to-char date)) - (substring date 1) - date))) - -(defun nnimap-request-expire-articles-progress () - (gnus-message 5 "nnimap: Marking article %d for deletion..." - imap-current-message)) - -(defun nnimap-expiry-target (arts group server) - (unless (eq nnmail-expiry-target 'delete) - (with-temp-buffer - (dolist (art arts) - (nnimap-request-article art group server (current-buffer)) - ;; hints for optimization in `nnimap-request-accept-article' - (let ((nnimap-current-move-article art) - (nnimap-current-move-group group) - (nnimap-current-move-server server)) - (nnmail-expiry-target-group nnmail-expiry-target group)))) - ;; It is not clear if `nnmail-expiry-target' somehow cause the - ;; current group to be changed or not, so we make sure here. - (nnimap-possibly-change-group group server))) - -;; Notice that we don't actually delete anything, we just mark them deleted. -(deffoo nnimap-request-expire-articles (articles group &optional server force) - (let ((artseq (gnus-compress-sequence articles))) - (when (and artseq (nnimap-possibly-change-group group server)) - (with-current-buffer nnimap-server-buffer - (let ((days (or (and nnmail-expiry-wait-function - (funcall nnmail-expiry-wait-function group)) - nnmail-expiry-wait))) - (cond ((or force (eq days 'immediate)) - (let ((oldarts (imap-search - (concat "UID " - (imap-range-to-message-set artseq))))) - (when oldarts - (nnimap-expiry-target oldarts group server) - (when (imap-message-flags-add - (imap-range-to-message-set - (gnus-compress-sequence oldarts)) "\\Deleted") - (setq articles (gnus-set-difference - articles oldarts)))))) - ((and nnimap-search-uids-not-since-is-evil (numberp days)) - (let* ((all-new-articles - (gnus-compress-sequence - (imap-search (format "SINCE %s" - (nnimap-date-days-ago days))))) - (oldartseq - (gnus-range-difference artseq all-new-articles)) - (oldarts (gnus-uncompress-range oldartseq))) - (when oldarts - (nnimap-expiry-target oldarts group server) - (when (imap-message-flags-add - (imap-range-to-message-set oldartseq) - "\\Deleted") - (setq articles (gnus-set-difference - articles oldarts)))))) - ((numberp days) - (let ((oldarts (imap-search - (format nnimap-expunge-search-string - (imap-range-to-message-set artseq) - (nnimap-date-days-ago days)))) - (imap-fetch-data-hook - '(nnimap-request-expire-articles-progress))) - (when oldarts - (nnimap-expiry-target oldarts group server) - (when (imap-message-flags-add - (imap-range-to-message-set - (gnus-compress-sequence oldarts)) "\\Deleted") - (setq articles (gnus-set-difference - articles oldarts))))))))))) - ;; return articles not deleted - articles) - -(deffoo nnimap-request-move-article (article group server - accept-form &optional last) - (when (nnimap-possibly-change-server server) - (save-excursion - (let ((buf (get-buffer-create " *nnimap move*")) - (nnimap-current-move-article article) - (nnimap-current-move-group group) - (nnimap-current-move-server nnimap-current-server) - result) - (and (nnimap-request-article article group server) - (save-excursion - (set-buffer buf) - (buffer-disable-undo (current-buffer)) - (insert-buffer-substring nntp-server-buffer) - (setq result (eval accept-form)) - (kill-buffer buf) - result) - (nnimap-possibly-change-group group server) - (imap-message-flags-add - (imap-range-to-message-set (list article)) - "\\Deleted" 'silent nnimap-server-buffer)) - result)))) - -(deffoo nnimap-request-accept-article (group &optional server last) - (when (nnimap-possibly-change-server server) - (let (uid) - (if (setq uid - (if (string= nnimap-current-server nnimap-current-move-server) - ;; moving article within same server, speed it up... - (and (nnimap-possibly-change-group - nnimap-current-move-group) - (imap-message-copy (number-to-string - nnimap-current-move-article) - group 'dontcreate nil - nnimap-server-buffer)) - (with-current-buffer (current-buffer) - (goto-char (point-min)) - ;; remove any 'From blabla' lines, some IMAP servers - ;; reject the entire message otherwise. - (when (looking-at "^From[^:]") - (delete-region (point) (progn (forward-line) (point)))) - ;; turn into rfc822 format (\r\n eol's) - (while (search-forward "\n" nil t) - (replace-match "\r\n")) - (when nnmail-cache-accepted-message-ids - (nnmail-cache-insert (nnmail-fetch-field "message-id") - group - (nnmail-fetch-field "subject")))) - (when (and last nnmail-cache-accepted-message-ids) - (nnmail-cache-close)) - ;; this 'or' is for Cyrus server bug - (or (null (imap-current-mailbox nnimap-server-buffer)) - (imap-mailbox-unselect nnimap-server-buffer)) - (imap-message-append group (current-buffer) nil nil - nnimap-server-buffer))) - (cons group (nth 1 uid)) - (nnheader-report 'nnimap (imap-error-text nnimap-server-buffer)))))) - -(deffoo nnimap-request-delete-group (group force &optional server) - (when (nnimap-possibly-change-server server) - (with-current-buffer nnimap-server-buffer - (if force - (or (null (imap-mailbox-status group 'uidvalidity)) - (imap-mailbox-delete group)) - ;; UNSUBSCRIBE? - t)))) - -(deffoo nnimap-request-rename-group (group new-name &optional server) - (when (nnimap-possibly-change-server server) - (imap-mailbox-rename group new-name nnimap-server-buffer))) - -(defun nnimap-expunge (mailbox server) - (when (nnimap-possibly-change-group mailbox server) - (imap-mailbox-expunge nil nnimap-server-buffer))) - -(defun nnimap-acl-get (mailbox server) - (when (nnimap-possibly-change-server server) - (and (imap-capability 'ACL nnimap-server-buffer) - (imap-mailbox-acl-get mailbox nnimap-server-buffer)))) - -(defun nnimap-acl-edit (mailbox method old-acls new-acls) - (when (nnimap-possibly-change-server (cadr method)) - (unless (imap-capability 'ACL nnimap-server-buffer) - (error "Your server does not support ACL editing")) - (with-current-buffer nnimap-server-buffer - ;; delete all removed identifiers - (mapcar (lambda (old-acl) - (unless (assoc (car old-acl) new-acls) - (or (imap-mailbox-acl-delete (car old-acl) mailbox) - (error "Can't delete ACL for %s" (car old-acl))))) - old-acls) - ;; set all changed acl's - (mapcar (lambda (new-acl) - (let ((new-rights (cdr new-acl)) - (old-rights (cdr (assoc (car new-acl) old-acls)))) - (unless (and old-rights new-rights - (string= old-rights new-rights)) - (or (imap-mailbox-acl-set (car new-acl) new-rights mailbox) - (error "Can't set ACL for %s to %s" (car new-acl) - new-rights))))) - new-acls) - t))) - - -;;; Internal functions - -;; -;; This is confusing. -;; -;; mark => read, tick, draft, reply etc -;; flag => "\\Seen", "\\Flagged", "\\Draft", "gnus-expire" etc -;; predicate => "SEEN", "FLAGGED", "DRAFT", "KEYWORD gnus-expire" etc -;; -;; Mark should not really contain 'read since it's not a "mark" in the Gnus -;; world, but we cheat. Mark == gnus-article-mark-lists + '(read . read). -;; - -(defconst nnimap-mark-to-predicate-alist - (mapcar - (lambda (pair) ; cdr is the mark - (or (assoc (cdr pair) - '((read . "SEEN") - (tick . "FLAGGED") - (draft . "DRAFT") - (recent . "RECENT") - (reply . "ANSWERED"))) - (cons (cdr pair) - (format "KEYWORD gnus-%s" (symbol-name (cdr pair)))))) - (cons '(read . read) gnus-article-mark-lists))) - -(defun nnimap-mark-to-predicate (pred) - "Convert a Gnus mark (a symbol such as read, tick, expire) to a IMAP predicate. -This is a string such as \"SEEN\", \"FLAGGED\", \"KEYWORD gnus-expire\", -to be used within a IMAP SEARCH query." - (cdr (assq pred nnimap-mark-to-predicate-alist))) - -(defconst nnimap-mark-to-flag-alist - (mapcar - (lambda (pair) - (or (assoc (cdr pair) - '((read . "\\Seen") - (tick . "\\Flagged") - (draft . "\\Draft") - (recent . "\\Recent") - (reply . "\\Answered"))) - (cons (cdr pair) - (format "gnus-%s" (symbol-name (cdr pair)))))) - (cons '(read . read) gnus-article-mark-lists))) - -(defun nnimap-mark-to-flag-1 (preds) - (if (and (not (null preds)) (listp preds)) - (cons (nnimap-mark-to-flag (car preds)) - (nnimap-mark-to-flag (cdr preds))) - (cdr (assoc preds nnimap-mark-to-flag-alist)))) - -(defun nnimap-mark-to-flag (preds &optional always-list make-string) - "Convert a Gnus mark (a symbol such as read, tick, expire) to a IMAP flag. -This is a string such as \"\\Seen\", \"\\Flagged\", \"gnus-expire\", to -be used in a STORE FLAGS command." - (let ((result (nnimap-mark-to-flag-1 preds))) - (setq result (if (and (or make-string always-list) - (not (listp result))) - (list result) - result)) - (if make-string - (mapconcat (lambda (flag) - (if (listp flag) - (mapconcat 'identity flag " ") - flag)) - result " ") - result))) - -(defun nnimap-mark-permanent-p (mark &optional group) - "Return t if MARK can be permanently (between IMAP sessions) saved on articles, in GROUP." - (imap-message-flag-permanent-p (nnimap-mark-to-flag mark))) - -(when nnimap-debug - (require 'trace) - (buffer-disable-undo (get-buffer-create nnimap-debug-buffer)) - (mapcar (lambda (f) (trace-function-background f nnimap-debug-buffer)) - '( - nnimap-possibly-change-server - nnimap-verify-uidvalidity - nnimap-find-minmax-uid - nnimap-before-find-minmax-bugworkaround - nnimap-possibly-change-group - ;;nnimap-replace-whitespace - nnimap-retrieve-headers-progress - nnimap-retrieve-which-headers - nnimap-group-overview-filename - nnimap-retrieve-headers-from-file - nnimap-retrieve-headers-from-server - nnimap-retrieve-headers - nnimap-open-connection - nnimap-open-server - nnimap-server-opened - nnimap-close-server - nnimap-request-close - nnimap-status-message - ;;nnimap-demule - nnimap-request-article-part - nnimap-request-article - nnimap-request-head - nnimap-request-body - nnimap-request-group - nnimap-close-group - nnimap-pattern-to-list-arguments - nnimap-request-list - nnimap-request-post - nnimap-retrieve-groups - nnimap-request-update-info-internal - nnimap-request-type - nnimap-request-set-mark - nnimap-split-to-groups - nnimap-split-find-rule - nnimap-split-find-inbox - nnimap-split-articles - nnimap-request-scan - nnimap-request-newgroups - nnimap-request-create-group - nnimap-time-substract - nnimap-date-days-ago - nnimap-request-expire-articles-progress - nnimap-request-expire-articles - nnimap-request-move-article - nnimap-request-accept-article - nnimap-request-delete-group - nnimap-request-rename-group - gnus-group-nnimap-expunge - gnus-group-nnimap-edit-acl - gnus-group-nnimap-edit-acl-done - nnimap-group-mode-hook - nnimap-mark-to-predicate - nnimap-mark-to-flag-1 - nnimap-mark-to-flag - nnimap-mark-permanent-p - ))) - -(provide 'nnimap) - -;; arch-tag: 2b001f20-3ff9-4094-a0ad-46807c1ba70b -;;; nnimap.el ends here diff --git a/xemacs-packages/gnus/lisp/nnir.el b/xemacs-packages/gnus/lisp/nnir.el deleted file mode 100644 index af966ce3..00000000 --- a/xemacs-packages/gnus/lisp/nnir.el +++ /dev/null @@ -1,1559 +0,0 @@ -;;; nnir.el --- search mail with various search engines -*- coding: iso-8859-1 -*- -;; Copyright (C) 1998 Kai Großjohann - -;; Author: Kai Großjohann -;; Keywords: news, mail, searching, ir, glimpse, wais, hyrex - -;; This file is not part of GNU Emacs. - -;; This is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; The most recent version of this can always be fetched from the Gnus -;; CVS repository. See http://www.gnus.org/ for more information. - -;; This code is still in the development stage but I'd like other -;; people to have a look at it. Please do not hesitate to contact me -;; with your ideas. - -;; What does it do? Well, it allows you to index your mail using some -;; search engine (freeWAIS-sf, Glimpse and others -- see later), -;; then type `G G' in the Group buffer and issue a query to the search -;; engine. You will then get a buffer which shows all articles -;; matching the query, sorted by Retrieval Status Value (score). - -;; When looking at the retrieval result (in the Summary buffer) you -;; can type `G T' (aka M-x gnus-summary-nnir-goto-thread RET) on an -;; article. You will be teleported into the group this article came -;; from, showing the thread this article is part of. (See below for -;; restrictions.) - -;; The Lisp installation is simple: just put this file on your -;; load-path, byte-compile it, and load it from ~/.gnus or something. -;; This will install a new command `G G' in your Group buffer for -;; searching your mail. Note that you also need to configure a number -;; of variables, as described below. - -;; Restrictions: -;; -;; * If you don't use HyREX as your search engine, this expects that -;; you use nnml or another one-file-per-message backend, because the -;; others doesn't support nnfolder. -;; * It can only search the mail backend's which are supported by one -;; search engine, because of different query languages. -;; * There are restrictions to the Glimpse setup. -;; * There are restrictions to the Wais setup. -;; * There are restrictions to the imap setup. -;; * gnus-summary-nnir-goto-thread: Fetches whole group first, before -;; limiting to the right articles. This is much too slow, of -;; course. May issue a query for number of articles to fetch; you -;; must accept the default of all articles at this point or things -;; may break. - -;; The Lisp setup involves setting a few variables and setting up the -;; search engine. You can define the variables in the server definition -;; like this : -;; (setq gnus-secondary-select-methods '( -;; (nnimap "" (nnimap-address "localhost") -;; (nnir-search-engine hyrex) -;; (nnir-hyrex-additional-switches ("-d" "ddl-nnimap.xml")) -;; ))) -;; Or you can define the global ones. The variables set in the mailer- -;; definition will be used first. -;; The variable to set is `nnir-search-engine'. Choose one of the engines -;; listed in `nnir-engines'. (Actually `nnir-engines' is an alist, -;; type `C-h v nnir-engines RET' for more information; this includes -;; examples for setting `nnir-search-engine', too.) -;; -;; The variable nnir-mail-backend isn't used anymore. -;; - -;; You must also set up a search engine. I'll tell you about the two -;; search engines currently supported: - -;; 1. freeWAIS-sf -;; -;; As always with freeWAIS-sf, you need a so-called `format file'. I -;; use the following file: -;; -;; ,----- -;; | # Kai's format file for freeWAIS-sf for indexing mails. -;; | # Each mail is in a file, much like the MH format. -;; | -;; | # Document separator should never match -- each file is a document. -;; | record-sep: /^@this regex should never match@$/ -;; | -;; | # Searchable fields specification. -;; | -;; | region: /^[sS]ubject:/ /^[sS]ubject: */ -;; | subject "Subject header" stemming TEXT BOTH -;; | end: /^[^ \t]/ -;; | -;; | region: /^([tT][oO]|[cC][cC]):/ /^([tT][oO]|[cC][cC]): */ -;; | to "To and Cc headers" SOUNDEX BOTH -;; | end: /^[^ \t]/ -;; | -;; | region: /^[fF][rR][oO][mM]:/ /^[fF][rR][oO][mM]: */ -;; | from "From header" SOUNDEX BOTH -;; | end: /^[^ \t]/ -;; | -;; | region: /^$/ -;; | stemming TEXT GLOBAL -;; | end: /^@this regex should never match@$/ -;; `----- -;; -;; 1998-07-22: waisindex would dump core on me for large articles with -;; the above settings. I used /^$/ as the end regex for the global -;; field. That seemed to work okay. - -;; There is a Perl module called `WAIS.pm' which is available from -;; CPAN as well as ls6-ftp.cs.uni-dortmund.de:/pub/wais/Perl. This -;; module comes with a nifty tool called `makedb', which I use for -;; indexing. Here's my `makedb.conf': -;; -;; ,----- -;; | # Config file for makedb -;; | -;; | # Global options -;; | waisindex = /usr/local/bin/waisindex -;; | wais_opt = -stem -t fields -;; | # `-stem' option necessary when `stemming' is specified for the -;; | # global field in the *.fmt file -;; | -;; | # Own variables -;; | homedir = /home/kai -;; | -;; | # The mail database. -;; | database = mail -;; | files = `find $homedir/Mail -name \*[0-9] -print` -;; | dbdir = $homedir/.wais -;; | limit = 100 -;; `----- -;; -;; The Lisp setup involves the `nnir-wais-*' variables. The most -;; difficult to understand variable is probably -;; `nnir-wais-remove-prefix'. Here's what it does: the output of -;; `waissearch' basically contains the file name and the (full) -;; directory name. As Gnus works with group names rather than -;; directory names, the directory name is transformed into a group -;; name as follows: first, a prefix is removed from the (full) -;; directory name, then all `/' are replaced with `.'. The variable -;; `nnir-wais-remove-prefix' should contain a regex matching exactly -;; this prefix. It defaults to `$HOME/Mail/' (note the trailing -;; slash). - -;; 2. Glimpse -;; -;; The code expects you to have one Glimpse index which contains all -;; your mail files. The Lisp setup involves setting the -;; `nnir-glimpse-*' variables. The most difficult to understand -;; variable is probably `nnir-glimpse-remove-prefix', it corresponds -;; to `nnir-wais-remove-prefix', see above. The `nnir-glimpse-home' -;; variable should be set to the value of the `-H' option which allows -;; one to search this Glimpse index. I have indexed my whole home -;; directory with Glimpse, so I assume a default of `$HOME'. - -;; 3. Namazu -;; -;; The Namazu backend requires you to have one directory containing all -;; index files, this is controlled by the `nnir-namazu-index-directory' -;; variable. To function the `nnir-namazu-remove-prefix' variable must -;; also be correct, see the documentation for `nnir-wais-remove-prefix' -;; above. -;; -;; It is particularly important not to pass any any switches to namazu -;; that will change the output format. Good switches to use include -;; `--sort', `--ascending', `--early' and `--late'. Refer to the Namazu -;; documentation for further information on valid switches. -;; -;; To index my mail with the `mknmz' program I use the following -;; configuration file: -;; -;; ,---- -;; | package conf; # Don't remove this line! -;; | -;; | # Paths which will not be indexed. Don't use `^' or `$' anchors. -;; | $EXCLUDE_PATH = "spam|sent"; -;; | -;; | # Header fields which should be searchable. case-insensitive -;; | $REMAIN_HEADER = "from|date|message-id|subject"; -;; | -;; | # Searchable fields. case-insensitive -;; | $SEARCH_FIELD = "from|date|message-id|subject"; -;; | -;; | # The max length of a word. -;; | $WORD_LENG_MAX = 128; -;; | -;; | # The max length of a field. -;; | $MAX_FIELD_LENGTH = 256; -;; `---- -;; -;; My mail is stored in the directories ~/Mail/mail/, ~/Mail/lists/ and -;; ~/Mail/archive/, so to index them I go to the directory set in -;; `nnir-namazu-index-directory' and issue the following command. -;; -;; mknmz --mailnews ~/Mail/archive/ ~/Mail/mail/ ~/Mail/lists/ -;; -;; For maximum searching efficiency I have a cron job set to run this -;; command every four hours. - -;; 4. HyREX -;; -;; The HyREX backend requires you to have one directory from where all -;; your relative paths are to, if you use them. This directory must be -;; set in the `nnir-hyrex-index-directory' variable, which defaults to -;; your home directory. You must also pass the base, class and -;; directory options or simply your dll to the `nnir-hyrex-programm' by -;; setting the `nnir-hyrex-additional-switches' variable accordently. -;; To function the `nnir-hyrex-remove-prefix' variable must also be -;; correct, see the documentation for `nnir-wais-remove-prefix' above. - -;; Developer information: - -;; I have tried to make the code expandable. Basically, it is divided -;; into two layers. The upper layer is somewhat like the `nnvirtual' -;; or `nnkiboze' backends: given a specification of what articles to -;; show from another backend, it creates a group containing exactly -;; those articles. The lower layer issues a query to a search engine -;; and produces such a specification of what articles to show from the -;; other backend. - -;; The interface between the two layers consists of the single -;; function `nnir-run-query', which just selects the appropriate -;; function for the search engine one is using. The input to -;; `nnir-run-query' is a string, representing the query as input by -;; the user. The output of `nnir-run-query' is supposed to be a -;; vector, each element of which should in turn be a three-element -;; vector. The first element should be full group name of the article, -;; the second element should be the article number, and the third -;; element should be the Retrieval Status Value (RSV) as returned from -;; the search engine. An RSV is the score assigned to the document by -;; the search engine. For Boolean search engines like Glimpse, the -;; RSV is always 1000 (or 1 or 100, or whatever you like). - -;; The sorting order of the articles in the summary buffer created by -;; nnir is based on the order of the articles in the above mentioned -;; vector, so that's where you can do the sorting you'd like. Maybe -;; it would be nice to have a way of displaying the search result -;; sorted differently? - -;; So what do you need to do when you want to add another search -;; engine? You write a function that executes the query. Temporary -;; data from the search engine can be put in `nnir-tmp-buffer'. This -;; function should return the list of articles as a vector, as -;; described above. Then, you need to register this backend in -;; `nnir-engines'. Then, users can choose the backend by setting -;; `nnir-search-engine'. - -;; Todo, or future ideas: - -;; * Make it so that Glimpse can also be called without `-F'. -;; -;; * It should be possible to restrict search to certain groups. -;; -;; * There is currently no error checking. -;; -;; * The summary buffer display is currently really ugly, with all the -;; added information in the subjects. How could I make this -;; prettier? -;; -;; * A function which can be called from an nnir summary buffer which -;; teleports you into the group the current article came from and -;; shows you the whole thread this article is part of. -;; Implementation suggestions? -;; (1998-07-24: There is now a preliminary implementation, but -;; it is much too slow and quite fragile.) -;; -;; * Support other mail backends. In particular, probably quite a few -;; people use nnfolder. How would one go about searching nnfolders -;; and producing the right data needed? The group name and the RSV -;; are simple, but what about the article number? -;; - The article number is encoded in the `X-Gnus-Article-Number' -;; header of each mail. -;; - The HyREX engine supports nnfolder. -;; -;; * Support compressed mail files. Probably, just stripping off the -;; `.gz' or `.Z' file name extension is sufficient. -;; -;; * Support a find/grep combination. -;; -;; * At least for imap, the query is performed twice. -;; - -;; Have you got other ideas? - -;;; Setup Code: - -(require 'cl) -(require 'nnoo) -(require 'gnus-group) -(require 'gnus-sum) -(eval-and-compile - (require 'gnus-util)) -(eval-when-compile - (require 'nnimap) - (autoload 'read-kbd-macro "edmacro" nil t)) - -(nnoo-declare nnir) -(nnoo-define-basics nnir) - -(gnus-declare-backend "nnir" 'mail) - -(defvar nnir-imap-search-field "TEXT" - "The IMAP search item when doing an nnir search") - -(defvar nnir-imap-search-arguments - '(("Whole message" . "TEXT") - ("Subject" . "SUBJECT") - ("To" . "TO") - ("From" . "FROM") - (nil . "HEADER \"%s\"")) - "Mapping from user readable strings to IMAP search items for use in nnir") - -(defvar nnir-imap-search-argument-history () - "The history for querying search options in nnir") - -;;; Developer Extension Variable: - -(defvar nnir-engines - `((glimpse nnir-run-glimpse - ((group . "Group spec: "))) - (wais nnir-run-waissearch - ()) - (excite nnir-run-excite-search - ()) - (imap nnir-run-imap - ((criteria - "Search in: " ; Prompt - ,nnir-imap-search-arguments ; alist for completing - nil ; no filtering - nil ; allow any user input - nil ; initial value - nnir-imap-search-argument-history ; the history to use - ,nnir-imap-search-field ; default - ))) - (swish++ nnir-run-swish++ - ((group . "Group spec: "))) - (swish-e nnir-run-swish-e - ((group . "Group spec: "))) - (namazu nnir-run-namazu - ()) - (hyrex nnir-run-hyrex - ((group . "Group spec: ")))) - "Alist of supported search engines. -Each element in the alist is a three-element list (ENGINE FUNCTION ARGS). -ENGINE is a symbol designating the searching engine. FUNCTION is also -a symbol, giving the function that does the search. The third element -ARGS is a list of cons pairs (PARAM . PROMPT). When issuing a query, -the FUNCTION will issue a query for each of the PARAMs, using PROMPT. - -The value of `nnir-search-engine' must be one of the ENGINE symbols. -For example, use the following line for searching using freeWAIS-sf: - (setq nnir-search-engine 'wais) -Use the following line if you read your mail via IMAP and your IMAP -server supports searching: - (setq nnir-search-engine 'imap) -Note that you have to set additional variables for most backends. For -example, the `wais' backend needs the variables `nnir-wais-program', -`nnir-wais-database' and `nnir-wais-remove-prefix'. - -Add an entry here when adding a new search engine.") - -;;; User Customizable Variables: - -(defgroup nnir nil - "Search nnmh and nnml groups in Gnus with Glimpse, freeWAIS-sf, or EWS." - :group 'gnus) - -;; Mail backend. - -;; TODO: -;; If `nil', use server parameters to find out which server to search. CCC -;; -(defcustom nnir-mail-backend '(nnml "") - "*Specifies which backend should be searched. -More precisely, this is used to determine from which backend to fetch the -messages found. - -This must be equal to an existing server, so maybe it is best to use -something like the following: - (setq nnir-mail-backend (nth 0 gnus-secondary-select-methods)) -The above line works fine if the mail backend you want to search is -the first element of gnus-secondary-select-methods (`nth' starts counting -at zero)." - :type '(sexp) - :group 'nnir) - -;; Search engine to use. - -(defcustom nnir-search-engine 'wais - "*The search engine to use. Must be a symbol. -See `nnir-engines' for a list of supported engines, and for example -settings of `nnir-search-engine'." - :type '(sexp) - :group 'nnir) - -;; Glimpse engine. - -(defcustom nnir-glimpse-program "glimpse" - "*Name of Glimpse executable." - :type '(string) - :group 'nnir) - -(defcustom nnir-glimpse-home (getenv "HOME") - "*Value of `-H' glimpse option. -`~' and environment variables must be expanded, see the functions -`expand-file-name' and `substitute-in-file-name'." - :type '(directory) - :group 'nnir) - -(defcustom nnir-glimpse-remove-prefix (concat (getenv "HOME") "/Mail/") - "*The prefix to remove from each file name returned by Glimpse -in order to get a group name (albeit with / instead of .). This is a -regular expression. - -For example, suppose that Glimpse returns file names such as -\"/home/john/Mail/mail/misc/42\". For this example, use the following -setting: (setq nnir-glimpse-remove-prefix \"/home/john/Mail/\") -Note the trailing slash. Removing this prefix gives \"mail/misc/42\". -`nnir' knows to remove the \"/42\" and to replace \"/\" with \".\" to -arrive at the correct group name, \"mail.misc\"." - :type '(regexp) - :group 'nnir) - -(defcustom nnir-glimpse-additional-switches '("-i") - "*A list of strings, to be given as additional arguments to glimpse. -The switches `-H', `-W', `-l' and `-y' are always used -- calling -glimpse without them does not make sense in our situation. -Suggested elements to put here are `-i' and `-w'. - -Note that this should be a list. Ie, do NOT use the following: - (setq nnir-glimpse-additional-switches \"-i -w\") ; wrong! -Instead, use this: - (setq nnir-glimpse-additional-switches '(\"-i\" \"-w\"))" - :type '(repeat (string)) - :group 'nnir) - -;; freeWAIS-sf. - -(defcustom nnir-wais-program "waissearch" - "*Name of waissearch executable." - :type '(string) - :group 'nnir) - -(defcustom nnir-wais-database (expand-file-name "~/.wais/mail") - "*Name of Wais database containing the mail. - -Note that this should be a file name without extension. For example, -if you have a file /home/john/.wais/mail.fmt, use this: - (setq nnir-wais-database \"/home/john/.wais/mail\") -The string given here is passed to `waissearch -d' as-is." - :type '(file) - :group 'nnir) - -(defcustom nnir-wais-remove-prefix (concat (getenv "HOME") "/Mail/") - "*The prefix to remove from each directory name returned by waissearch -in order to get a group name (albeit with / instead of .). This is a -regular expression. - -This variable is similar to `nnir-glimpse-remove-prefix', only for Wais, -not Glimpse." - :type '(regexp) - :group 'nnir) - -;; EWS (Excite for Web Servers) engine. - -(defcustom nnir-excite-aquery-program "aquery.pl" - "*Name of the EWS query program. Should be `aquery.pl' or a path to same." - :type '(string) - :group 'nnir) - -(defcustom nnir-excite-collection "Mail" - "*Name of the EWS collection to search." - :type '(string) - :group 'nnir) - -(defcustom nnir-excite-remove-prefix (concat (getenv "HOME") "/Mail/") - "*The prefix to remove from each file name returned by EWS -in order to get a group name (albeit with / instead of .). This is a -regular expression. - -This variable is very similar to `nnir-glimpse-remove-prefix', except -that it is for EWS, not Glimpse." - :type '(regexp) - :group 'nnir) - -;; Swish++. Next three variables Copyright (C) 2000, 2001 Christoph -;; Conrad . -;; Swish++ home page: http://homepage.mac.com/pauljlucas/software/swish/ - -(defcustom nnir-swish++-configuration-file - (expand-file-name "~/Mail/swish++.conf") - "*Configuration file for swish++." - :type '(file) - :group 'nnir) - -(defcustom nnir-swish++-program "search" - "*Name of swish++ search executable." - :type '(string) - :group 'nnir) - -(defcustom nnir-swish++-additional-switches '() - "*A list of strings, to be given as additional arguments to swish++. - -Note that this should be a list. Ie, do NOT use the following: - (setq nnir-swish++-additional-switches \"-i -w\") ; wrong -Instead, use this: - (setq nnir-swish++-additional-switches '(\"-i\" \"-w\"))" - :type '(repeat (string)) - :group 'nnir) - -(defcustom nnir-swish++-remove-prefix (concat (getenv "HOME") "/Mail/") - "*The prefix to remove from each file name returned by swish++ -in order to get a group name (albeit with / instead of .). This is a -regular expression. - -This variable is very similar to `nnir-glimpse-remove-prefix', except -that it is for swish++, not Glimpse." - :type '(regexp) - :group 'nnir) - -;; Swish-E. Next three variables Copyright (C) 2000 Christoph Conrad -;; . -;; URL: http://sunsite.berkeley.edu/SWISH-E/ -;; New version: http://www.boe.es/swish-e - -(defcustom nnir-swish-e-index-file - (expand-file-name "~/Mail/index.swish-e") - "*Index file for swish-e. -This could be a server parameter." - :type '(file) - :group 'nnir) - -(defcustom nnir-swish-e-program "swish-e" - "*Name of swish-e search executable. -This cannot be a server parameter." - :type '(string) - :group 'nnir) - -(defcustom nnir-swish-e-additional-switches '() - "*A list of strings, to be given as additional arguments to swish-e. - -Note that this should be a list. Ie, do NOT use the following: - (setq nnir-swish-e-additional-switches \"-i -w\") ; wrong -Instead, use this: - (setq nnir-swish-e-additional-switches '(\"-i\" \"-w\")) - -This could be a server parameter." - :type '(repeat (string)) - :group 'nnir) - -(defcustom nnir-swish-e-remove-prefix (concat (getenv "HOME") "/Mail/") - "*The prefix to remove from each file name returned by swish-e -in order to get a group name (albeit with / instead of .). This is a -regular expression. - -This variable is very similar to `nnir-glimpse-remove-prefix', except -that it is for swish-e, not Glimpse. - -This could be a server parameter." - :type '(regexp) - :group 'nnir) - -;; HyREX engine, see - -(defcustom nnir-hyrex-program "nnir-search" - "*Name of the nnir-search executable." - :type '(string) - :group 'nnir) - -(defcustom nnir-hyrex-additional-switches '() - "*A list of strings, to be given as additional arguments for nnir-search. -Note that this should be a list. Ie, do NOT use the following: - (setq nnir-hyrex-additional-switches \"-ddl ddl.xml -c nnir\") ; wrong ! -Instead, use this: - (setq nnir-hyrex-additional-switches '(\"-ddl\" \"ddl.xml\" \"-c\" \"nnir\"))" - :type '(repeat (string)) - :group 'nnir) - -(defcustom nnir-hyrex-index-directory (getenv "HOME") - "*Index directory for HyREX." - :type '(directory) - :group 'nnir) - -(defcustom nnir-hyrex-remove-prefix (concat (getenv "HOME") "/Mail/") - "*The prefix to remove from each file name returned by HyREX -in order to get a group name (albeit with / instead of .). - -For example, suppose that HyREX returns file names such as -\"/home/john/Mail/mail/misc/42\". For this example, use the following -setting: (setq nnir-hyrex-remove-prefix \"/home/john/Mail/\") -Note the trailing slash. Removing this prefix gives \"mail/misc/42\". -`nnir' knows to remove the \"/42\" and to replace \"/\" with \".\" to -arrive at the correct group name, \"mail.misc\"." - :type '(directory) - :group 'nnir) - -;; Namazu engine, see - -(defcustom nnir-namazu-program "namazu" - "*Name of Namazu search executable." - :type '(string) - :group 'nnir) - -(defcustom nnir-namazu-index-directory (expand-file-name "~/Mail/namazu/") - "*Index directory for Namazu." - :type '(directory) - :group 'nnir) - -(defcustom nnir-namazu-additional-switches '() - "*A list of strings, to be given as additional arguments to namazu. -The switches `-q', `-a', and `-s' are always used, very few other switches -make any sense in this context. - -Note that this should be a list. Ie, do NOT use the following: - (setq nnir-namazu-additional-switches \"-i -w\") ; wrong -Instead, use this: - (setq nnir-namazu-additional-switches '(\"-i\" \"-w\"))" - :type '(repeat (string)) - :group 'nnir) - -(defcustom nnir-namazu-remove-prefix (concat (getenv "HOME") "/Mail/") - "*The prefix to remove from each file name returned by Namazu -in order to get a group name (albeit with / instead of .). - -This variable is very similar to `nnir-glimpse-remove-prefix', except -that it is for Namazu, not Glimpse." - :type '(directory) - :group 'nnir) - -;;; Internal Variables: - -(defvar nnir-current-query nil - "Internal: stores current query (= group name).") - -(defvar nnir-current-server nil - "Internal: stores current server (does it ever change?).") - -(defvar nnir-current-group-marked nil - "Internal: stores current list of process-marked groups.") - -(defvar nnir-artlist nil - "Internal: stores search result.") - -(defvar nnir-tmp-buffer " *nnir*" - "Internal: temporary buffer.") - -;;; Code: - -;; Gnus glue. - -(defun gnus-group-make-nnir-group (extra-parms query) - "Create an nnir group. Asks for query." - (interactive "P\nsQuery: ") - (setq nnir-current-query nil - nnir-current-server nil - nnir-current-group-marked nil - nnir-artlist nil) - (let ((parms nil)) - (if extra-parms - (setq parms (nnir-read-parms query)) - (setq parms (list (cons 'query query)))) - (gnus-group-read-ephemeral-group - (concat "nnir:" (prin1-to-string parms)) '(nnir "") t - (cons (current-buffer) - gnus-current-window-configuration) - nil))) - -;; Emacs 19 compatibility? -(or (fboundp 'kbd) (defalias 'kbd 'read-kbd-macro)) - -(defun nnir-group-mode-hook () - (define-key gnus-group-mode-map - (if (fboundp 'read-kbd-macro) - (kbd "G G") - "GG") ; XEmacs 19 compat - 'gnus-group-make-nnir-group)) -(add-hook 'gnus-group-mode-hook 'nnir-group-mode-hook) - - - -;; Summary mode commands. - -(defun gnus-summary-nnir-goto-thread () - "Only applies to nnir groups. Go to group this article came from -and show thread that contains this article." - (interactive) - (unless (eq 'nnir (car (gnus-find-method-for-group gnus-newsgroup-name))) - (error "Can't execute this command unless in nnir group.")) - (let* ((cur (gnus-summary-article-number)) - (group (nnir-artlist-artitem-group nnir-artlist cur)) - (backend-number (nnir-artlist-artitem-number nnir-artlist cur)) - server backend-group) - (setq server (nnir-group-server group)) - (setq backend-group (gnus-group-real-name group)) - (gnus-group-read-ephemeral-group - backend-group - (gnus-server-to-method server) - t ; activate - (cons (current-buffer) - 'summary) ; window config - nil - (list backend-number)) - (gnus-summary-limit (list backend-number)) - (gnus-summary-refer-thread))) - -(if (fboundp 'eval-after-load) - (eval-after-load "gnus-sum" - '(define-key gnus-summary-goto-map - "T" 'gnus-summary-nnir-goto-thread)) - (add-hook 'gnus-summary-mode-hook - (function (lambda () - (define-key gnus-summary-goto-map - "T" 'gnus-summary-nnir-goto-thread))))) - - - -;; Gnus backend interface functions. - -(deffoo nnir-open-server (server &optional definitions) - ;; Just set the server variables appropriately. - (nnoo-change-server 'nnir server definitions)) - -(deffoo nnir-request-group (group &optional server fast) - "GROUP is the query string." - (nnir-possibly-change-server server) - ;; Check for cache and return that if appropriate. - (if (and (equal group nnir-current-query) - (equal gnus-group-marked nnir-current-group-marked) - (or (null server) - (equal server nnir-current-server))) - nnir-artlist - ;; Cache miss. - (setq nnir-artlist (nnir-run-query group))) - (save-excursion - (set-buffer nntp-server-buffer) - (if (zerop (length nnir-artlist)) - (progn - (setq nnir-current-query nil - nnir-current-server nil - nnir-current-group-marked nil - nnir-artlist nil) - (nnheader-report 'nnir "Search produced empty results.")) - ;; Remember data for cache. - (setq nnir-current-query group) - (when server (setq nnir-current-server server)) - (setq nnir-current-group-marked gnus-group-marked) - (nnheader-insert "211 %d %d %d %s\n" - (nnir-artlist-length nnir-artlist) ; total # - 1 ; first # - (nnir-artlist-length nnir-artlist) ; last # - group)))) ; group name - -(deffoo nnir-retrieve-headers (articles &optional group server fetch-old) - (save-excursion - (let ((artlist (copy-sequence articles)) - (idx 1) - (art nil) - (artitem nil) - (artgroup nil) (artno nil) - (artrsv nil) - (artfullgroup nil) - (novitem nil) - (novdata nil) - (foo nil) - server) - (while (not (null artlist)) - (setq art (car artlist)) - (or (numberp art) - (nnheader-report - 'nnir - "nnir-retrieve-headers doesn't grok message ids: %s" - art)) - (setq artitem (nnir-artlist-article nnir-artlist art)) - (setq artrsv (nnir-artitem-rsv artitem)) - (setq artfullgroup (nnir-artitem-group artitem)) - (setq artno (nnir-artitem-number artitem)) - (setq artgroup (gnus-group-real-name artfullgroup)) - (setq server (nnir-group-server artfullgroup)) - ;; retrieve NOV or HEAD data for this article, transform into - ;; NOV data and prepend to `novdata' - (set-buffer nntp-server-buffer) - (nnir-possibly-change-server server) - (case (setq foo (gnus-retrieve-headers (list artno) artfullgroup nil)) - (nov - (goto-char (point-min)) - (setq novitem (nnheader-parse-nov)) - (unless novitem - (pop-to-buffer nntp-server-buffer) - (error - "nnheader-parse-nov returned nil for article %s in group %s" - artno artfullgroup))) - (headers - (goto-char (point-min)) - (setq novitem (nnheader-parse-head)) - (unless novitem - (pop-to-buffer nntp-server-buffer) - (error - "nnheader-parse-head returned nil for article %s in group %s" - artno artfullgroup))) - (t (nnheader-report 'nnir "Don't support header type %s." foo))) - ;; replace article number in original group with article number - ;; in nnir group - (mail-header-set-number novitem idx) - (mail-header-set-from novitem - (mail-header-from novitem)) - (mail-header-set-subject - novitem - (format "[%d: %s/%d] %s" - artrsv artgroup artno - (mail-header-subject novitem))) - ;;-(mail-header-set-extra novitem nil) - (push novitem novdata) - (setq artlist (cdr artlist)) - (setq idx (1+ idx))) - (setq novdata (nreverse novdata)) - (set-buffer nntp-server-buffer) (erase-buffer) - (mapcar 'nnheader-insert-nov novdata) - 'nov))) - -(deffoo nnir-request-article (article - &optional group server to-buffer) - (save-excursion - (let* ((artitem (nnir-artlist-article nnir-artlist - article)) - (artfullgroup (nnir-artitem-group artitem)) - (artno (nnir-artitem-number artitem)) - ;; Bug? - ;; Why must we bind nntp-server-buffer here? It won't - ;; work if `buf' is used, say. (Of course, the set-buffer - ;; line below must then be updated, too.) - (nntp-server-buffer (or to-buffer nntp-server-buffer))) - (set-buffer nntp-server-buffer) - (erase-buffer) - (message "Requesting article %d from group %s" - artno artfullgroup) - (gnus-request-article artno artfullgroup nntp-server-buffer) - (cons artfullgroup artno)))) - - -(nnoo-define-skeleton nnir) - -;;; Search Engine Interfaces: - -;; Glimpse interface. -(defun nnir-run-glimpse (query server &optional group) - "Run given query against glimpse. Returns a vector of (group name, file name) -pairs (also vectors, actually)." - (save-excursion - (let ((artlist nil) - (groupspec (cdr (assq 'group query))) - (qstring (cdr (assq 'query query))) - (prefix (nnir-read-server-parm 'nnir-glimps-remove-prefix server)) - artno dirnam) - (when (and group groupspec) - (error (concat "It does not make sense to use a group spec" - " with process-marked groups."))) - (when group - (setq groupspec (gnus-group-real-name group))) - (set-buffer (get-buffer-create nnir-tmp-buffer)) - (erase-buffer) - (if groupspec - (message "Doing glimpse query %s on %s..." query groupspec) - (message "Doing glimpse query %s..." query)) - (let* ((cp-list - `( ,nnir-glimpse-program - nil ; input from /dev/null - t ; output - nil ; don't redisplay - "-H" ,(nnir-read-server-parm 'nnir-glimpse-home server) ; search home dir - "-W" ; match pattern in file - "-l" "-y" ; misc options - ,@(nnir-read-server-parm 'nnir-glimpse-additional-switches server) - "-F" ,prefix ; restrict output to mail - ,qstring ; the query, in glimpse format - )) - (exitstatus - (progn - (message "%s args: %s" nnir-glimpse-program - (mapconcat 'identity (cddddr cp-list) " ")) - (apply 'call-process cp-list)))) - (unless (or (null exitstatus) - (zerop exitstatus)) - (nnheader-report 'nnir "Couldn't run glimpse: %s" exitstatus) - ;; Glimpse failure reason is in this buffer, show it if - ;; the user wants it. - (when (> gnus-verbose 6) - (display-buffer nnir-tmp-buffer)))) - (when groupspec - (keep-lines groupspec)) - (if groupspec - (message "Doing glimpse query %s on %s...done" query groupspec) - (message "Doing glimpse query %s...done" query)) - (sit-for 0) - ;; remove superfluous stuff from glimpse output - (goto-char (point-min)) - (delete-non-matching-lines "/[0-9]+$") - ;;(delete-matching-lines "\\.overview~?$") - (goto-char (point-min)) - (while (re-search-forward (concat "^" prefix "\\(.+\\)" "/\\([0-9]\\)+$") nil t) - ;; replace / with . in group names - (setq dirnam (substitute ?. ?/ (match-string 1)) - artno (match-string 2)) - (push (vector (nnir-group-full-name dirnam server) - (string-to-int artno)) artlist)) - - (sort* artlist - (function (lambda (x y) - (if (string-lessp (nnir-artitem-group x) - (nnir-artitem-group y)) - t - (< (nnir-artitem-number x) - (nnir-artitem-number y)))))) - ))) - -;; freeWAIS-sf interface. -(defun nnir-run-waissearch (query server &optional group) - "Run given query agains waissearch. Returns vector of (group name, file name) -pairs (also vectors, actually)." - (when group - (error "The freeWAIS-sf backend cannot search specific groups.")) - (save-excursion - (let ((qstring (cdr (assq 'query query))) - (prefix (nnir-read-server-parm 'nnir-wais-remove-prefix server)) - (artlist nil) - (score nil) (artno nil) (dirnam nil) (group nil)) - (set-buffer (get-buffer-create nnir-tmp-buffer)) - (erase-buffer) - (message "Doing WAIS query %s..." query) - (call-process nnir-wais-program - nil ; input from /dev/null - t ; output to current buffer - nil ; don't redisplay - "-d" (nnir-read-server-parm 'nnir-wais-database server) ; database to search - qstring) - (message "Massaging waissearch output...") - ;; remove superfluous lines - (keep-lines "Score:") - ;; extract data from result lines - (goto-char (point-min)) - (while (re-search-forward - "Score: +\\([0-9]+\\).*'\\([0-9]+\\) +\\([^']+\\)/'" nil t) - (setq score (match-string 1) - artno (match-string 2) - dirnam (match-string 3)) - (unless (string-match prefix dirnam) - (nnheader-report 'nnir "Dir name %s doesn't contain prefix %s" - dirnam prefix)) - (setq group (substitute ?. ?/ (replace-match "" t t dirnam))) - (push (vector (nnir-group-full-name group server) - (string-to-int artno) - (string-to-int score)) - artlist)) - (message "Massaging waissearch output...done") - (apply 'vector - (sort* artlist - (function (lambda (x y) - (> (nnir-artitem-rsv x) - (nnir-artitem-rsv y))))))))) - -;; EWS (Excite for Web Servers) interface -(defun nnir-run-excite-search (query server &optional group) - "Run a given query against EWS. Returns vector of (group name, file name) -pairs (also vectors, actually)." - (when group - (error "Searching specific groups not implemented for EWS.")) - (save-excursion - (let ((qstring (cdr (assq 'query query))) - (prefix (nnir-read-server-parm 'nnir-excite-remove-prefix server)) - artlist group article-num article) - (setq nnir-current-query query) - (set-buffer (get-buffer-create nnir-tmp-buffer)) - (erase-buffer) - (message "Doing EWS query %s..." qstring) - (call-process nnir-excite-aquery-program - nil ; input from /dev/null - t ; output to current buffer - nil ; don't redisplay - (nnir-read-server-parm 'nnir-excite-collection server) - (if (string= (substring qstring 0 1) "(") - qstring - (format "(concept %s)" qstring))) - (message "Gathering query output...") - - (goto-char (point-min)) - (while (re-search-forward - "^[0-9]+\\s-[0-9]+\\s-[0-9]+\\s-\\(\\S-*\\)" nil t) - (setq article (match-string 1)) - (unless (string-match - (concat "^" (regexp-quote prefix) - "\\(.*\\)/\\([0-9]+\\)") article) - (nnheader-report 'nnir "Dir name %s doesn't contain prefix %s" - article prefix)) - (setq group (substitute ?. ?/ (match-string 1 article))) - (setq group (nnir-group-full-name group server)) - (setq article-num (match-string 2 article)) - (setq artlist (vconcat artlist (vector (vector group - (string-to-int article-num) - 1000))))) - (message "Gathering query output...done") - artlist))) - -;; IMAP interface. The following function is Copyright (C) 1998 Simon -;; Josefsson . -;; todo: -;; nnir invokes this two (2) times???! -;; we should not use nnimap at all but open our own server connection -;; we should not LIST * but use nnimap-list-pattern from defs -;; send queries as literals -;; handle errors - -(defun nnir-run-imap (query srv &optional group-option) - (require 'imap) - (require 'nnimap) - (save-excursion - (let ((qstring (cdr (assq 'query query))) - (server (cadr (gnus-server-to-method srv))) - (group (or group-option (gnus-group-group-name))) - (defs (caddr (gnus-server-to-method srv))) - (criteria (or (cdr (assq 'criteria query)) - nnir-imap-search-field)) - artlist buf) - (message "Opening server %s" server) - (condition-case () - (when (nnimap-open-server server defs) ;; xxx - (setq buf nnimap-server-buffer) ;; xxx - (message "Searching %s..." group) - (let ((arts 0) - (mbx (gnus-group-real-name group))) - (when (imap-mailbox-select mbx nil buf) - (mapcar - (lambda (artnum) - (push (vector group artnum 1) artlist) - (setq arts (1+ arts))) - (imap-search (concat criteria " \"" qstring "\"") buf)) - (message "Searching %s... %d matches" mbx arts))) - (message "Searching %s...done" group)) - (quit nil)) - (reverse artlist)))) - -;; Swish++ interface. The following function is Copyright (C) 2000, -;; 2001 Christoph Conrad . -;; -cc- Todo -;; Search by -;; - group -;; Sort by -;; - rank (default) -;; - article number -;; - file size -;; - group -(defun nnir-run-swish++ (query server &optional group) - "Run given query against swish++. -Returns a vector of (group name, file name) pairs (also vectors, -actually). - -Tested with swish++ 4.7 on GNU/Linux and with with swish++ 5.0b2 on -Windows NT 4.0." - - (when group - (error "The swish++ backend cannot search specific groups.")) - - (save-excursion - (let ( (qstring (cdr (assq 'query query))) - (groupspec (cdr (assq 'group query))) - (prefix (nnir-read-server-parm 'nnir-swish++-remove-prefix server)) - (artlist nil) - (score nil) (artno nil) (dirnam nil) (group nil) ) - - (when (equal "" qstring) - (error "swish++: You didn't enter anything.")) - - (set-buffer (get-buffer-create nnir-tmp-buffer)) - (erase-buffer) - - (if groupspec - (message "Doing swish++ query %s on %s..." qstring groupspec) - (message "Doing swish++ query %s..." qstring)) - - (let* ((cp-list `( ,nnir-swish++-program - nil ; input from /dev/null - t ; output - nil ; don't redisplay - "--config-file" ,(nnir-read-server-parm 'nnir-swish++-configuration-file server) - ,@(nnir-read-server-parm 'nnir-swish++-additional-switches server) - ,qstring ; the query, in swish++ format - )) - (exitstatus - (progn - (message "%s args: %s" nnir-swish++-program - (mapconcat 'identity (cddddr cp-list) " ")) ;; ??? - (apply 'call-process cp-list)))) - (unless (or (null exitstatus) - (zerop exitstatus)) - (nnheader-report 'nnir "Couldn't run swish++: %s" exitstatus) - ;; swish++ failure reason is in this buffer, show it if - ;; the user wants it. - (when (> gnus-verbose 6) - (display-buffer nnir-tmp-buffer)))) - - ;; The results are output in the format of: - ;; V 4.7 Linux - ;; rank relative-path-name file-size file-title - ;; V 5.0b2: - ;; rank relative-path-name file-size topic?? - ;; where rank is an integer from 1 to 100. - (goto-char (point-min)) - (while (re-search-forward - "\\(^[0-9]+\\) \\([^ ]+\\) [0-9]+ \\(.*\\)$" nil t) - (setq score (match-string 1) - artno (file-name-nondirectory (match-string 2)) - dirnam (file-name-directory (match-string 2))) - - ;; don't match directories - (when (string-match "^[0-9]+$" artno) - (when (not (null dirnam)) - - ;; maybe limit results to matching groups. - (when (or (not groupspec) - (string-match groupspec dirnam)) - - ;; remove nnir-swish++-remove-prefix from beginning of dirname - (when (string-match (concat "^" prefix) - dirnam) - (setq dirnam (replace-match "" t t dirnam))) - - (setq dirnam (substring dirnam 0 -1)) - ;; eliminate all ".", "/", "\" from beginning. Always matches. - (string-match "^[./\\]*\\(.*\\)$" dirnam) - ;; "/" -> "." - (setq group (substitute ?. ?/ (match-string 1 dirnam))) - ;; "\\" -> "." - (setq group (substitute ?. ?\\ group)) - - (push (vector (nnir-group-full-name group server) - (string-to-int artno) - (string-to-int score)) - artlist))))) - - (message "Massaging swish++ output...done") - - ;; Sort by score - (apply 'vector - (sort* artlist - (function (lambda (x y) - (> (nnir-artitem-rsv x) - (nnir-artitem-rsv y))))))))) - -;; Swish-E interface. The following function is Copyright (C) 2000, -;; 2001 by Christoph Conrad . -(defun nnir-run-swish-e (query server &optional group) - "Run given query against swish-e. -Returns a vector of (group name, file name) pairs (also vectors, -actually). - -Tested with swish-e-2.0.1 on Windows NT 4.0." - - ;; swish-e crashes with empty parameter to "-w" on commandline... - (when group - (error "The swish-e backend cannot search specific groups.")) - - (save-excursion - (let ((qstring (cdr (assq 'query query))) - (prefix - (or (nnir-read-server-parm 'nnir-swish-e-remove-prefix server) - (error "Missing parameter `nnir-swish-e-remove-prefix'"))) - (artlist nil) - (score nil) (artno nil) (dirnam nil) (group nil) ) - - (when (equal "" qstring) - (error "swish-e: You didn't enter anything.")) - - (set-buffer (get-buffer-create nnir-tmp-buffer)) - (erase-buffer) - - (message "Doing swish-e query %s..." query) - (let* ((index-file - (or (nnir-read-server-parm - 'nnir-swish-e-index-file server) - (error "Missing parameter `nnir-swish-e-index-file'"))) - (additional-switches - (nnir-read-server-parm - 'nnir-swish++-additional-switches server)) - (cp-list `(,nnir-swish-e-program - nil ; input from /dev/null - t ; output - nil ; don't redisplay - "-f" ,index-file - ,@additional-switches - "-w" - ,qstring ; the query, in swish-e format - )) - (exitstatus - (progn - (message "%s args: %s" nnir-swish-e-program - (mapconcat 'identity (cddddr cp-list) " ")) - (apply 'call-process cp-list)))) - (unless (or (null exitstatus) - (zerop exitstatus)) - (nnheader-report 'nnir "Couldn't run swish-e: %s" exitstatus) - ;; swish-e failure reason is in this buffer, show it if - ;; the user wants it. - (when (> gnus-verbose 6) - (display-buffer nnir-tmp-buffer)))) - - ;; The results are output in the format of: - ;; rank path-name file-title file-size - (goto-char (point-min)) - (while (re-search-forward - "\\(^[0-9]+\\) \\([^ ]+\\) \"\\([^\"]+\\)\" [0-9]+$" nil t) - (setq score (match-string 1) - artno (match-string 3) - dirnam (file-name-directory (match-string 2))) - - ;; don't match directories - (when (string-match "^[0-9]+$" artno) - (when (not (null dirnam)) - - ;; remove nnir-swish-e-remove-prefix from beginning of dirname - (when (string-match (concat "^" prefix) dirnam) - (setq dirnam (replace-match "" t t dirnam))) - - (setq dirnam (substring dirnam 0 -1)) - ;; eliminate all ".", "/", "\" from beginning. Always matches. - (string-match "^[./\\]*\\(.*\\)$" dirnam) - ;; "/" -> "." - (setq group (substitute ?. ?/ (match-string 1 dirnam))) - ;; Windows "\\" -> "." - (setq group (substitute ?. ?\\ group)) - - (push (vector (nnir-group-full-name group server) - (string-to-int artno) - (string-to-int score)) - artlist)))) - - (message "Massaging swish-e output...done") - - ;; Sort by score - (apply 'vector - (sort* artlist - (function (lambda (x y) - (> (nnir-artitem-rsv x) - (nnir-artitem-rsv y))))))))) - -;; HyREX interface -(defun nnir-run-hyrex (query server &optional group) - (save-excursion - (let ((artlist nil) - (groupspec (cdr (assq 'group query))) - (qstring (cdr (assq 'query query))) - (prefix (nnir-read-server-parm 'nnir-hyrex-remove-prefix server)) - score artno dirnam) - (when (and group groupspec) - (error (concat "It does not make sense to use a group spec" - " with process-marked groups."))) - (when group - (setq groupspec (gnus-group-real-name group))) - (when (and group (not (equal group (nnir-group-full-name groupspec server)))) - (message "%s vs. %s" group (nnir-group-full-name groupspec server)) - (error "Server with groupspec doesn't match group !")) - (set-buffer (get-buffer-create nnir-tmp-buffer)) - (erase-buffer) - (if groupspec - (message "Doing hyrex-search query %s on %s..." query groupspec) - (message "Doing hyrex-search query %s..." query)) - (let* ((cp-list - `( ,nnir-hyrex-program - nil ; input from /dev/null - t ; output - nil ; don't redisplay - "-i",(nnir-read-server-parm 'nnir-hyrex-index-directory server) ; index directory - ,@(nnir-read-server-parm 'nnir-hyrex-additional-switches server) - ,qstring ; the query, in hyrex-search format - )) - (exitstatus - (progn - (message "%s args: %s" nnir-hyrex-program - (mapconcat 'identity (cddddr cp-list) " ")) - (apply 'call-process cp-list)))) - (unless (or (null exitstatus) - (zerop exitstatus)) - (nnheader-report 'nnir "Couldn't run hyrex-search: %s" exitstatus) - ;; nnir-search failure reason is in this buffer, show it if - ;; the user wants it. - (when (> gnus-verbose 6) - (display-buffer nnir-tmp-buffer)))) ;; FIXME: Dont clear buffer ! - (if groupspec - (message "Doing hyrex-search query \"%s\" on %s...done" qstring groupspec) - (message "Doing hyrex-search query \"%s\"...done" qstring)) - (sit-for 0) - ;; nnir-search returns: - ;; for nnml/nnfolder: "filename mailid weigth" - ;; for nnimap: "group mailid weigth" - (goto-char (point-min)) - (delete-non-matching-lines "^\\S + [0-9]+ [0-9]+$") - ;; HyREX couldn't search directly in groups -- so filter out here. - (when groupspec - (keep-lines groupspec)) - ;; extract data from result lines - (goto-char (point-min)) - (while (re-search-forward - "\\(\\S +\\) \\([0-9]+\\) \\([0-9]+\\)" nil t) - (setq dirnam (match-string 1) - artno (match-string 2) - score (match-string 3)) - (when (string-match prefix dirnam) - (setq dirnam (replace-match "" t t dirnam))) - (push (vector (nnir-group-full-name (substitute ?. ?/ dirnam) server) - (string-to-int artno) - (string-to-int score)) - artlist)) - (message "Massaging hyrex-search output...done.") - (apply 'vector - (sort* artlist - (function (lambda (x y) - (if (string-lessp (nnir-artitem-group x) - (nnir-artitem-group y)) - t - (< (nnir-artitem-number x) - (nnir-artitem-number y))))))) - ))) - -;; Namazu interface -(defun nnir-run-namazu (query server &optional group) - "Run given query against Namazu. Returns a vector of (group name, file name) -pairs (also vectors, actually). - -Tested with Namazu 2.0.6 on a GNU/Linux system." - (when group - (error "The Namazu backend cannot search specific groups")) - (save-excursion - (let ( - (artlist nil) - (qstring (cdr (assq 'query query))) - (prefix (nnir-read-server-parm 'nnir-namazu-remove-prefix server)) - (score nil) - (group nil) - (article nil) - (process-environment (copy-sequence process-environment)) - ) - (setenv "LC_MESSAGES" "C") - (set-buffer (get-buffer-create nnir-tmp-buffer)) - (erase-buffer) - (let* ((cp-list - `( ,nnir-namazu-program - nil ; input from /dev/null - t ; output - nil ; don't redisplay - "-q" ; don't be verbose - "-a" ; show all matches - "-s" ; use short format - ,@(nnir-read-server-parm 'nnir-namazu-additional-switches server) - ,qstring ; the query, in namazu format - ,(nnir-read-server-parm 'nnir-namazu-index-directory server) ; index directory - )) - (exitstatus - (progn - (message "%s args: %s" nnir-namazu-program - (mapconcat 'identity (cddddr cp-list) " ")) - (apply 'call-process cp-list)))) - (unless (or (null exitstatus) - (zerop exitstatus)) - (nnheader-report 'nnir "Couldn't run namazu: %s" exitstatus) - ;; Namazu failure reason is in this buffer, show it if - ;; the user wants it. - (when (> gnus-verbose 6) - (display-buffer nnir-tmp-buffer)))) - - ;; Namazu output looks something like this: - ;; 2. Re: Gnus agent expire broken (score: 55) - ;; /home/henrik/Mail/mail/sent/1310 (4,138 bytes) - - (goto-char (point-min)) - (while (re-search-forward - "^\\([0-9]+\\.\\).*\\((score: \\([0-9]+\\)\\))\n\\([^ ]+\\)" - nil t) - (setq score (match-string 3) - group (file-name-directory (match-string 4)) - article (file-name-nondirectory (match-string 4))) - - ;; make sure article and group is sane - (when (and (string-match "^[0-9]+$" article) - (not (null group))) - (when (string-match (concat "^" prefix) group) - (setq group (replace-match "" t t group))) - - ;; remove trailing slash from groupname - (setq group (substring group 0 -1)) - - ;; stuff results into artlist vector - (push (vector (nnir-group-full-name (substitute ?. ?/ group) server) - (string-to-int article) - (string-to-int score)) artlist))) - - ;; sort artlist by score - (apply 'vector - (sort* artlist - (function (lambda (x y) - (> (nnir-artitem-rsv x) - (nnir-artitem-rsv y))))))))) - -;;; Util Code: - -(defun nnir-read-parms (query) - "Reads additional search parameters according to `nnir-engines'." - (let ((parmspec (caddr (assoc nnir-search-engine nnir-engines)))) - (cons (cons 'query query) - (mapcar 'nnir-read-parm parmspec)))) - -(defun nnir-read-parm (parmspec) - "Reads a single search parameter. -`parmspec' is a cons cell, the car is a symbol, the cdr is a prompt." - (let ((sym (car parmspec)) - (prompt (cdr parmspec))) - (if (listp prompt) - (let* ((result (apply 'completing-read prompt)) - (mapping (or (assoc result nnir-imap-search-arguments) - (assoc nil nnir-imap-search-arguments)))) - (cons sym (format (cdr mapping) result))) - (cons sym (read-string prompt))))) - -(defun nnir-run-query (query) - "Invoke appropriate search engine function (see `nnir-engines'). -If some groups were process-marked, run the query for each of the groups -and concat the results." - (let ((q (car (read-from-string query)))) - (if gnus-group-marked - (apply 'vconcat - (mapcar (lambda (x) - (let ((server (nnir-group-server x)) - search-func) - (setq search-func (cadr - (assoc - (nnir-read-server-parm 'nnir-search-engine server) nnir-engines))) - (if search-func - (funcall search-func q server x) - nil))) - gnus-group-marked) - ) - (apply 'vconcat - (mapcar (lambda (x) - (if (and (equal (cadr x) 'ok) (not (equal (cadar x) "-ephemeral"))) - (let ((server (format "%s:%s" (caar x) (cadar x))) - search-func) - (setq search-func (cadr - (assoc - (nnir-read-server-parm 'nnir-search-engine server) nnir-engines))) - (if search-func - (funcall search-func q server nil) - nil)) - nil)) - gnus-opened-servers) - )) - )) - -(defun nnir-read-server-parm (key server) - "Returns the parameter value of for the given server, where server is of -form 'backend:name'." - (let ((method (gnus-server-to-method server))) - (cond ((and method (assq key (cddr method))) - (nth 1 (assq key (cddr method)))) - ((and nnir-mail-backend - (gnus-method-equal method nnir-mail-backend)) - (symbol-value key)) - ((null nnir-mail-backend) - (symbol-value key)) - (t nil)))) -;; (if method -;; (if (assq key (cddr method)) -;; (nth 1 (assq key (cddr method))) -;; (symbol-value key)) -;; (symbol-value key)) -;; )) - -(defmacro nnir-group-server (group) - "Returns the server for a foreign newsgroup in the format as gnus-server-to-method needs it. Compare to gnus-group-real-prefix and gnus-group-real-name." - `(let ((gname ,group)) - (if (string-match "^\\([^:]+\\):" gname) - (setq gname (match-string 1 gname)) - nil) - (if (string-match "^\\([^+]+\\)\\+\\(.+\\)$" gname) - (format "%s:%s" (match-string 1 gname) (match-string 2 gname)) - (concat gname ":")) - )) - -(defun nnir-group-full-name (shortname server) - "For the given group name, return a full Gnus group name. -The Gnus backend/server information is added." - (gnus-group-prefixed-name shortname (gnus-server-to-method server))) - -(defun nnir-possibly-change-server (server) - (unless (and server (nnir-server-opened server)) - (nnir-open-server server))) - - -;; Data type article list. - -(defun nnir-artlist-length (artlist) - "Returns number of articles in artlist." - (length artlist)) - -(defun nnir-artlist-article (artlist n) - "Returns from ARTLIST the Nth artitem (counting starting at 1)." - (elt artlist (1- n))) - -(defun nnir-artitem-group (artitem) - "Returns the group from the ARTITEM." - (elt artitem 0)) - -(defun nnir-artlist-artitem-group (artlist n) - "Returns from ARTLIST the group of the Nth artitem (counting from 1)." - (nnir-artitem-group (nnir-artlist-article artlist n))) - -(defun nnir-artitem-number (artitem) - "Returns the number from the ARTITEM." - (elt artitem 1)) - -(defun nnir-artlist-artitem-number (artlist n) - "Returns from ARTLIST the number of the Nth artitem (counting from 1)." - (nnir-artitem-number (nnir-artlist-article artlist n))) - -(defun nnir-artitem-rsv (artitem) - "Returns the Retrieval Status Value (RSV, score) from the ARTITEM." - (elt artitem 2)) - -(defun nnir-artlist-artitem-rsv (artlist n) - "Returns from ARTLIST the Retrieval Status Value of the Nth artitem -(counting from 1)." - (nnir-artitem-rsv (nnir-artlist-article artlist n))) - -;; unused? -(defun nnir-artlist-groups (artlist) - "Returns a list of all groups in the given ARTLIST." - (let ((res nil) - (with-dups nil)) - ;; from each artitem, extract group component - (setq with-dups (mapcar 'nnir-artitem-group artlist)) - ;; remove duplicates from above - (mapcar (function (lambda (x) (add-to-list 'res x))) - with-dups) - res)) - - -;; The end. -(provide 'nnir) - -;;; arch-tag: 9b3fecf8-4397-4bbb-bf3c-6ac3cbbc6664 diff --git a/xemacs-packages/gnus/lisp/nnkiboze.el b/xemacs-packages/gnus/lisp/nnkiboze.el deleted file mode 100644 index 90e487f7..00000000 --- a/xemacs-packages/gnus/lisp/nnkiboze.el +++ /dev/null @@ -1,397 +0,0 @@ -;;; nnkiboze.el --- select virtual news access for Gnus - -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; The other access methods (nntp, nnspool, etc) are general news -;; access methods. This module relies on Gnus and can't be used -;; separately. - -;;; Code: - -(require 'nntp) -(require 'nnheader) -(require 'gnus) -(require 'gnus-score) -(require 'nnoo) -(require 'mm-util) -(eval-when-compile (require 'cl)) - -(nnoo-declare nnkiboze) -(defvoo nnkiboze-directory (nnheader-concat gnus-directory "kiboze/") - "nnkiboze will put its files in this directory.") - -(defvoo nnkiboze-level 9 - "The maximum level to be searched for articles.") - -(defvoo nnkiboze-remove-read-articles t - "If non-nil, nnkiboze will remove read articles from the kiboze group.") - -(defvoo nnkiboze-ephemeral nil - "If non-nil, don't store any data anywhere.") - -(defvoo nnkiboze-scores nil - "Score rules for generating the nnkiboze group.") - -(defvoo nnkiboze-regexp nil - "Regexp for matching component groups.") - -(defvoo nnkiboze-file-coding-system mm-text-coding-system - "Coding system for nnkiboze files.") - - - -(defconst nnkiboze-version "nnkiboze 1.0") - -(defvoo nnkiboze-current-group nil) -(defvoo nnkiboze-status-string "") - -(defvoo nnkiboze-headers nil) - - - -;;; Interface functions. - -(nnoo-define-basics nnkiboze) - -(deffoo nnkiboze-retrieve-headers (articles &optional group server fetch-old) - (nnkiboze-possibly-change-group group) - (unless gnus-nov-is-evil - (if (stringp (car articles)) - 'headers - (let ((nov (nnkiboze-nov-file-name))) - (when (file-exists-p nov) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (let ((nnheader-file-coding-system nnkiboze-file-coding-system)) - (nnheader-insert-file-contents nov)) - (nnheader-nov-delete-outside-range - (car articles) (car (last articles))) - 'nov)))))) - -(deffoo nnkiboze-request-article (article &optional newsgroup server buffer) - (nnkiboze-possibly-change-group newsgroup) - (if (not (numberp article)) - ;; This is a real kludge. It might not work at times, but it - ;; does no harm I think. The only alternative is to offer no - ;; article fetching by message-id at all. - (nntp-request-article article newsgroup gnus-nntp-server buffer) - (let* ((header (gnus-summary-article-header article)) - (xref (mail-header-xref header)) - num group) - (unless xref - (error "nnkiboze: No xref")) - (unless (string-match " \\([^ ]+\\):\\([0-9]+\\)" xref) - (error "nnkiboze: Malformed xref")) - (setq num (string-to-number (match-string 2 xref)) - group (match-string 1 xref)) - (or (with-current-buffer buffer - (or (and gnus-use-cache (gnus-cache-request-article num group)) - (gnus-agent-request-article num group))) - (gnus-request-article num group buffer))))) - -(deffoo nnkiboze-request-scan (&optional group server) - (nnkiboze-possibly-change-group group) - (nnkiboze-generate-group (concat "nnkiboze:" group))) - -(deffoo nnkiboze-request-group (group &optional server dont-check) - "Make GROUP the current newsgroup." - (nnkiboze-possibly-change-group group) - (if dont-check - t - (let ((nov-file (nnkiboze-nov-file-name)) - beg end total) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (unless (file-exists-p nov-file) - (nnkiboze-request-scan group)) - (if (not (file-exists-p nov-file)) - (nnheader-report 'nnkiboze "Can't select group %s" group) - (let ((nnheader-file-coding-system nnkiboze-file-coding-system)) - (nnheader-insert-file-contents nov-file)) - (if (zerop (buffer-size)) - (nnheader-insert "211 0 0 0 %s\n" group) - (goto-char (point-min)) - (when (looking-at "[0-9]+") - (setq beg (read (current-buffer)))) - (goto-char (point-max)) - (when (re-search-backward "^[0-9]" nil t) - (setq end (read (current-buffer)))) - (setq total (count-lines (point-min) (point-max))) - (nnheader-insert "211 %d %d %d %s\n" total beg end group))))))) - -(deffoo nnkiboze-close-group (group &optional server) - (nnkiboze-possibly-change-group group) - ;; Remove NOV lines of articles that are marked as read. - (when (and (file-exists-p (nnkiboze-nov-file-name)) - nnkiboze-remove-read-articles) - (let ((coding-system-for-write nnkiboze-file-coding-system)) - (with-temp-file (nnkiboze-nov-file-name) - (let ((cur (current-buffer)) - (nnheader-file-coding-system nnkiboze-file-coding-system)) - (nnheader-insert-file-contents (nnkiboze-nov-file-name)) - (goto-char (point-min)) - (while (not (eobp)) - (if (not (gnus-article-read-p (read cur))) - (forward-line 1) - (gnus-delete-line)))))) - (setq nnkiboze-current-group nil))) - -(deffoo nnkiboze-open-server (server &optional defs) - (unless (assq 'nnkiboze-regexp defs) - (push `(nnkiboze-regexp ,server) - defs)) - (nnoo-change-server 'nnkiboze server defs)) - -(deffoo nnkiboze-request-delete-group (group &optional force server) - (nnkiboze-possibly-change-group group) - (when force - (let ((files (nconc - (nnkiboze-score-file group) - (list (nnkiboze-nov-file-name) - (nnkiboze-nov-file-name ".newsrc"))))) - (while files - (and (file-exists-p (car files)) - (file-writable-p (car files)) - (delete-file (car files))) - (setq files (cdr files))))) - (setq nnkiboze-current-group nil) - t) - -(nnoo-define-skeleton nnkiboze) - - -;;; Internal functions. - -(defun nnkiboze-possibly-change-group (group) - (setq nnkiboze-current-group group)) - -(defun nnkiboze-prefixed-name (group) - (gnus-group-prefixed-name group '(nnkiboze ""))) - -;;;###autoload -(defun nnkiboze-generate-groups () - "\"Usage: emacs -batch -l nnkiboze -f nnkiboze-generate-groups\". -Finds out what articles are to be part of the nnkiboze groups." - (interactive) - (let ((nnmail-spool-file nil) - (mail-sources nil) - (gnus-use-dribble-file nil) - (gnus-read-active-file t) - (gnus-expert-user t)) - (gnus)) - (let* ((gnus-newsrc-alist (gnus-copy-sequence gnus-newsrc-alist)) - (newsrc (cdr gnus-newsrc-alist)) - gnus-newsrc-hashtb info) - (gnus-make-hashtable-from-newsrc-alist) - ;; We have copied all the newsrc alist info over to local copies - ;; so that we can mess all we want with these lists. - (while (setq info (pop newsrc)) - (when (string-match "nnkiboze" (gnus-info-group info)) - ;; For each kiboze group, we call this function to generate - ;; it. - (nnkiboze-generate-group (gnus-info-group info) t)))) - (save-excursion - (set-buffer gnus-group-buffer) - (gnus-group-list-groups))) - -(defun nnkiboze-score-file (group) - (list (expand-file-name - (concat (file-name-as-directory gnus-kill-files-directory) - (nnheader-translate-file-chars - (concat (nnkiboze-prefixed-name nnkiboze-current-group) - "." gnus-score-file-suffix)))))) - -(defun nnkiboze-generate-group (group &optional inhibit-list-groups) - (let* ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))) - (newsrc-file (concat nnkiboze-directory - (nnheader-translate-file-chars - (concat group ".newsrc")))) - (nov-file (concat nnkiboze-directory - (nnheader-translate-file-chars - (concat group ".nov")))) - method nnkiboze-newsrc gname newsrc active - ginfo lowest glevel orig-info nov-buffer - ;; Bind various things to nil to make group entry faster. - (gnus-expert-user t) - (gnus-large-newsgroup nil) - (gnus-score-find-score-files-function 'nnkiboze-score-file) - ;; Use only nnkiboze-score-file! - (gnus-score-use-all-scores nil) - (gnus-use-scoring t) - (gnus-verbose (min gnus-verbose 3)) - gnus-select-group-hook gnus-summary-prepare-hook - gnus-thread-sort-functions gnus-show-threads - gnus-visual gnus-suppress-duplicates num-unread) - (unless info - (error "No such group: %s" group)) - ;; Load the kiboze newsrc file for this group. - (mm-with-unibyte - (when (file-exists-p newsrc-file) - (load newsrc-file)) - (let ((coding-system-for-write nnkiboze-file-coding-system)) - (gnus-make-directory (file-name-directory nov-file)) - (with-temp-file nov-file - (when (file-exists-p nov-file) - (insert-file-contents nov-file)) - (setq nov-buffer (current-buffer)) - ;; Go through the active hashtb and add new all groups that match the - ;; kiboze regexp. - (mapatoms - (lambda (group) - (and (string-match nnkiboze-regexp - (setq gname (symbol-name group))) ; Match - (not (assoc gname nnkiboze-newsrc)) ; It isn't registered - (numberp (car (symbol-value group))) ; It is active - (or (> nnkiboze-level 7) - (and (setq glevel - (nth 1 (nth 2 (gnus-gethash - gname gnus-newsrc-hashtb)))) - (>= nnkiboze-level glevel))) - (not (string-match "^nnkiboze:" gname)) ; Exclude kibozes - (push (cons gname (1- (car (symbol-value group)))) - nnkiboze-newsrc))) - gnus-active-hashtb) - ;; `newsrc' is set to the list of groups that possibly are - ;; component groups to this kiboze group. This list has elements - ;; on the form `(GROUP . NUMBER)', where NUMBER is the highest - ;; number that has been kibozed in GROUP in this kiboze group. - (setq newsrc nnkiboze-newsrc) - (while newsrc - (if (not (setq active (gnus-gethash - (caar newsrc) gnus-active-hashtb))) - ;; This group isn't active after all, so we remove it from - ;; the list of component groups. - (setq nnkiboze-newsrc (delq (car newsrc) nnkiboze-newsrc)) - (setq lowest (cdar newsrc)) - ;; Ok, we have a valid component group, so we jump to it. - (switch-to-buffer gnus-group-buffer) - (gnus-group-jump-to-group (caar newsrc)) - (gnus-message 3 "nnkiboze: Checking %s..." (caar newsrc)) - (setq ginfo (gnus-get-info (gnus-group-group-name)) - orig-info (gnus-copy-sequence ginfo) - num-unread (car (gnus-gethash (caar newsrc) - gnus-newsrc-hashtb))) - (unwind-protect - (progn - ;; We set all list of article marks to nil. Since we operate - ;; on copies of the real lists, we can destroy anything we - ;; want here. - (when (nth 3 ginfo) - (setcar (nthcdr 3 ginfo) nil)) - ;; We set the list of read articles to be what we expect for - ;; this kiboze group -- either nil or `(1 . LOWEST)'. - (when ginfo - (setcar (nthcdr 2 ginfo) - (and (not (= lowest 1)) (cons 1 lowest)))) - (when (and (or (not ginfo) - (> (length (gnus-list-of-unread-articles - (car ginfo))) - 0)) - (progn - (ignore-errors - (gnus-group-select-group nil)) - (eq major-mode 'gnus-summary-mode))) - ;; We are now in the group where we want to be. - (setq method (gnus-find-method-for-group - gnus-newsgroup-name)) - (when (eq method gnus-select-method) - (setq method nil)) - ;; We go through the list of scored articles. - (while gnus-newsgroup-scored - (when (> (caar gnus-newsgroup-scored) lowest) - ;; If it has a good score, then we enter this article - ;; into the kiboze group. - (nnkiboze-enter-nov - nov-buffer - (gnus-summary-article-header - (caar gnus-newsgroup-scored)) - gnus-newsgroup-name)) - (setq gnus-newsgroup-scored (cdr gnus-newsgroup-scored))) - ;; That's it. We exit this group. - (when (eq major-mode 'gnus-summary-mode) - (kill-buffer (current-buffer))))) - ;; Restore the proper info. - (when ginfo - (setcdr ginfo (cdr orig-info))) - (setcar (gnus-gethash (caar newsrc) gnus-newsrc-hashtb) - num-unread))) - (setcdr (car newsrc) (cdr active)) - (gnus-message 3 "nnkiboze: Checking %s...done" (caar newsrc)) - (setq newsrc (cdr newsrc))))) - ;; We save the kiboze newsrc for this group. - (gnus-make-directory (file-name-directory newsrc-file)) - (with-temp-file newsrc-file - (insert "(setq nnkiboze-newsrc '") - (gnus-prin1 nnkiboze-newsrc) - (insert ")\n"))) - (unless inhibit-list-groups - (save-excursion - (set-buffer gnus-group-buffer) - (gnus-group-list-groups))) - t)) - -(defun nnkiboze-enter-nov (buffer header group) - (save-excursion - (set-buffer buffer) - (goto-char (point-max)) - (let ((prefix (gnus-group-real-prefix group)) - (oheader (copy-sequence header)) - article) - (if (zerop (forward-line -1)) - (progn - (setq article (1+ (read (current-buffer)))) - (forward-line 1)) - (setq article 1)) - (mail-header-set-number oheader article) - (with-temp-buffer - (insert (or (mail-header-xref oheader) "")) - (goto-char (point-min)) - (if (re-search-forward " [^ ]+:[0-9]+" nil t) - (goto-char (match-beginning 0)) - (or (eobp) (forward-char 1))) - ;; The first Xref has to be the group this article - ;; really came for - this is the article nnkiboze - ;; will request when it is asked for the article. - (insert " " group ":" - (int-to-string (mail-header-number header)) " ") - (while (re-search-forward " [^ ]+:[0-9]+" nil t) - (goto-char (1+ (match-beginning 0))) - (insert prefix)) - (mail-header-set-xref oheader (buffer-string))) - (nnheader-insert-nov oheader)))) - -(defun nnkiboze-nov-file-name (&optional suffix) - (concat (file-name-as-directory nnkiboze-directory) - (nnheader-translate-file-chars - (concat (nnkiboze-prefixed-name nnkiboze-current-group) - (or suffix ".nov"))))) - -(provide 'nnkiboze) - -;;; arch-tag: 66068271-bdc9-4801-bcde-779702e73a05 -;;; nnkiboze.el ends here diff --git a/xemacs-packages/gnus/lisp/nnlistserv.el b/xemacs-packages/gnus/lisp/nnlistserv.el deleted file mode 100644 index 41941370..00000000 --- a/xemacs-packages/gnus/lisp/nnlistserv.el +++ /dev/null @@ -1,154 +0,0 @@ -;;; nnlistserv.el --- retrieving articles via web mailing list archives - -;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news, mail - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'nnoo) -(require 'mm-url) -(require 'nnweb) - -(nnoo-declare nnlistserv - nnweb) - -(defvoo nnlistserv-directory (nnheader-concat gnus-directory "nnlistserv/") - "Where nnlistserv will save its files." - nnweb-directory) - -(defvoo nnlistserv-name 'kk - "What search engine type is being used." - nnweb-type) - -(defvoo nnlistserv-type-definition - '((kk - (article . nnlistserv-kk-wash-article) - (map . nnlistserv-kk-create-mapping) - (search . nnlistserv-kk-search) - (address . "http://www.itk.ntnu.no/ansatte/Andresen_Trond/kk-f/%s/") - (pages "fra160396" "fra160796" "fra061196" "fra160197" - "fra090997" "fra040797" "fra130397" "nye") - (index . "date.html") - (identifier . nnlistserv-kk-identity))) - "Type-definition alist." - nnweb-type-definition) - -(defvoo nnlistserv-search nil - "Search string to feed to DejaNews." - nnweb-search) - -(defvoo nnlistserv-ephemeral-p nil - "Whether this nnlistserv server is ephemeral." - nnweb-ephemeral-p) - -;;; Internal variables - -;;; Interface functions - -(nnoo-define-basics nnlistserv) - -(nnoo-import nnlistserv - (nnweb)) - -;;; Internal functions - -;;; -;;; KK functions. -;;; - -(defun nnlistserv-kk-create-mapping () - "Perform the search and create a number-to-url alist." - (save-excursion - (set-buffer nnweb-buffer) - (let ((case-fold-search t) - (active (or (cadr (assoc nnweb-group nnweb-group-alist)) - (cons 1 0))) - (pages (nnweb-definition 'pages)) - map url page subject from ) - (while (setq page (pop pages)) - (erase-buffer) - (when (funcall (nnweb-definition 'search) page) - ;; Go through all the article hits on this page. - (goto-char (point-min)) - (mm-url-decode-entities) - (goto-char (point-min)) - (while (re-search-forward "^
  • *\\([^\\>]+\\) *<[^>]+>\\([^>]+\\)<" nil t) - (setq url (match-string 1) - subject (match-string 2) - from (match-string 3)) - (setq url (concat (format (nnweb-definition 'address) page) url)) - (unless (nnweb-get-hashtb url) - (push - (list - (incf (cdr active)) - (make-full-mail-header - (cdr active) subject from "" - (concat "<" (nnweb-identifier url) "@kk>") - nil 0 0 url)) - map) - (nnweb-set-hashtb (cadar map) (car map)) - (nnheader-message 5 "%s %s %s" (cdr active) (point) pages))))) - ;; Return the articles in the right order. - (setq nnweb-articles - (sort (nconc nnweb-articles map) 'car-less-than-car))))) - -(defun nnlistserv-kk-wash-article () - (let ((case-fold-search t) - (headers '(sent name email subject id)) - sent name email subject id) - (mm-url-decode-entities) - (while headers - (goto-char (point-min)) - (re-search-forward (format "\n" - "\n" - " \n" - " mySubscriptions\n" - " " (format-time-string "%a, %d %b %Y %T %z") - "\n" - " " user-mail-address "\n" - " " (user-full-name) "\n" - " \n" - " \n") - (dolist (sub nnrss-group-alist) - (insert " \n")) - (insert " \n" - "\n")) - (pop-to-buffer "*OPML Export*") - (when (fboundp 'sgml-mode) - (sgml-mode))) - -(defun nnrss-generate-download-script () - "Generate a download script in the current buffer. -It is useful when `(setq nnrss-use-local t)'." - (interactive) - (insert "#!/bin/sh\n") - (insert "WGET=wget\n") - (insert "RSSDIR='" (expand-file-name nnrss-directory) "'\n") - (dolist (elem nnrss-server-data) - (let ((url (or (nth 2 elem) - (second (assoc (car elem) nnrss-group-alist))))) - (insert "$WGET -q -O \"$RSSDIR\"/'" - (nnrss-translate-file-chars (concat (car elem) ".xml")) - "' '" url "'\n")))) - -(defun nnrss-translate-file-chars (name) - (let ((nnheader-file-name-translation-alist - (append nnheader-file-name-translation-alist '((?' . ?_))))) - (nnheader-translate-file-chars name))) - -(defvar nnrss-moreover-url - "http://w.moreover.com/categories/category_list_rss.html" - "The url of moreover.com categories.") - -(defun nnrss-snarf-moreover-categories () - "Snarf RSS links from moreover.com." - (interactive) - (let (category name url changed) - (with-temp-buffer - (nnrss-insert nnrss-moreover-url) - (goto-char (point-min)) - (while (re-search-forward - "\\| elements that are links to RSS from the parsed data." - (delq nil (mapcar - (lambda (el) - (if (nnrss-rsslink-p el) el)) - (nnrss-find-el 'link data)))) - -(defun nnrss-extract-hrefs (data) - "Recursively extract hrefs from a page's source. -DATA should be the output of `xml-parse-region' or -`w3-parse-buffer'." - (mapcar (lambda (ahref) - (cdr (assoc 'href (cadr ahref)))) - (nnrss-find-el 'a data))) - -(defmacro nnrss-match-macro (base-uri item onsite-list offsite-list) - `(cond ((or (string-match (concat "^" ,base-uri) ,item) - (not (string-match "://" ,item))) - (setq ,onsite-list (append ,onsite-list (list ,item)))) - (t (setq ,offsite-list (append ,offsite-list (list ,item)))))) - -(defun nnrss-order-hrefs (base-uri hrefs) - "Given a list of hrefs, sort them using the following priorities: - 1. links ending in .rss - 2. links ending in .rdf - 3. links ending in .xml - 4. links containing the above - 5. offsite links - -BASE-URI is used to determine the location of the links and -whether they are `offsite' or `onsite'." - (let (rss-onsite-end rdf-onsite-end xml-onsite-end - rss-onsite-in rdf-onsite-in xml-onsite-in - rss-offsite-end rdf-offsite-end xml-offsite-end - rss-offsite-in rdf-offsite-in xml-offsite-in) - (dolist (href hrefs) - (cond ((null href)) - ((string-match "\\.rss$" href) - (nnrss-match-macro - base-uri href rss-onsite-end rss-offsite-end)) - ((string-match "\\.rdf$" href) - (nnrss-match-macro - base-uri href rdf-onsite-end rdf-offsite-end)) - ((string-match "\\.xml$" href) - (nnrss-match-macro - base-uri href xml-onsite-end xml-offsite-end)) - ((string-match "rss" href) - (nnrss-match-macro - base-uri href rss-onsite-in rss-offsite-in)) - ((string-match "rdf" href) - (nnrss-match-macro - base-uri href rdf-onsite-in rdf-offsite-in)) - ((string-match "xml" href) - (nnrss-match-macro - base-uri href xml-onsite-in xml-offsite-in)))) - (append - rss-onsite-end rdf-onsite-end xml-onsite-end - rss-onsite-in rdf-onsite-in xml-onsite-in - rss-offsite-end rdf-offsite-end xml-offsite-end - rss-offsite-in rdf-offsite-in xml-offsite-in))) - -(defun nnrss-discover-feed (url) - "Given a page, find an RSS feed using Mark Pilgrim's -`ultra-liberal rss locator' (http://diveintomark.org/2002/08/15.html)." - - (let ((parsed-page (nnrss-fetch url))) - -;; 1. if this url is the rss, use it. - (if (nnrss-rss-p parsed-page) - (let ((rss-ns (nnrss-get-namespace-prefix parsed-page "http://purl.org/rss/1.0/"))) - (nnrss-rss-title-description rss-ns parsed-page url)) - -;; 2. look for the (length urllist) 1)) - (cdar urllist) - (let ((completion-ignore-case t) - (selection - (mapcar (lambda (listinfo) - (cons (cdr (assoc "sitename" listinfo)) - (string-to-number - (cdr (assoc "feedid" listinfo))))) - feedinfo))) - (cdr (assoc - (completing-read - "Multiple feeds found. Select one: " - selection nil t) urllist))))))))) - -(defun nnrss-rss-p (data) - "Test if DATA is an RSS feed. -Simply ensures that the first element is rss or rdf." - (or (eq (caar data) 'rss) - (eq (caar data) 'rdf:RDF))) - -(defun nnrss-rss-title-description (rss-namespace data url) - "Return the title of an RSS feed." - (if (nnrss-rss-p data) - (let ((description (intern (concat rss-namespace "description"))) - (title (intern (concat rss-namespace "title"))) - (channel (nnrss-find-el (intern (concat rss-namespace "channel")) - data))) - (list - (cons 'description (caddr (nth 0 (nnrss-find-el description channel)))) - (cons 'title (caddr (nth 0 (nnrss-find-el title channel)))) - (cons 'href url))))) - -(defun nnrss-get-namespace-prefix (el uri) - "Given EL (containing a parsed element) and URI (containing a string -that gives the URI for which you want to retrieve the namespace -prefix), return the prefix." - (let* ((prefix (car (rassoc uri (cadar el)))) - (nslist (if prefix - (split-string (symbol-name prefix) ":"))) - (ns (cond ((eq (length nslist) 1) ; no prefix given - "") - ((eq (length nslist) 2) ; extract prefix - (cadr nslist))))) - (if (and ns (not (string= ns ""))) - (concat ns ":") - ns))) - -(provide 'nnrss) - - -;;; nnrss.el ends here - -;;; arch-tag: 12910c07-0cdf-44fb-8d2c-416ded64c267 diff --git a/xemacs-packages/gnus/lisp/nnslashdot.el b/xemacs-packages/gnus/lisp/nnslashdot.el deleted file mode 100644 index d2c752e5..00000000 --- a/xemacs-packages/gnus/lisp/nnslashdot.el +++ /dev/null @@ -1,509 +0,0 @@ -;;; nnslashdot.el --- interfacing with Slashdot - -;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'nnoo) -(require 'message) -(require 'gnus-util) -(require 'gnus) -(require 'nnmail) -(require 'mm-util) -(require 'mm-url) - -(nnoo-declare nnslashdot) - -(defvoo nnslashdot-directory (nnheader-concat gnus-directory "slashdot/") - "Where nnslashdot will save its files.") - -(defvoo nnslashdot-active-url "http://slashdot.org/search.pl?section=&min=%d" - "Where nnslashdot will fetch the active file from.") - -(defvoo nnslashdot-comments-url "http://slashdot.org/comments.pl?sid=%s&threshold=%d&commentsort=%d&mode=flat&startat=%d" - "Where nnslashdot will fetch comments from.") - -(defvoo nnslashdot-article-url - "http://slashdot.org/article.pl?sid=%s&mode=nocomment" - "Where nnslashdot will fetch the article from.") - -(defvoo nnslashdot-backslash-url "http://slashdot.org/slashdot.xml" - "Where nnslashdot will fetch the stories from.") - -(defvoo nnslashdot-use-front-page nil - "Use the front page in addition to the backslash page.") - -(defvoo nnslashdot-threshold -1 - "The article threshold.") - -(defvoo nnslashdot-threaded t - "Whether the nnslashdot groups should be threaded or not.") - -(defvoo nnslashdot-group-number 0 - "The number of non-fresh groups to keep updated.") - -(defvoo nnslashdot-login-name "" - "The login name to use when posting.") - -(defvoo nnslashdot-password "" - "The password to use when posting.") - -;;; Internal variables - -(defvar nnslashdot-groups nil) -(defvar nnslashdot-buffer nil) -(defvar nnslashdot-headers nil) - -;;; Interface functions - -(nnoo-define-basics nnslashdot) - -(deffoo nnslashdot-retrieve-headers (articles &optional group server fetch-old) - (nnslashdot-possibly-change-server group server) - (condition-case why - (unless gnus-nov-is-evil - (nnslashdot-retrieve-headers-1 articles group)) - (search-failed (nnslashdot-lose why)))) - -(deffoo nnslashdot-retrieve-headers-1 (articles group) - (let* ((last (car (last articles))) - (start (if nnslashdot-threaded 1 (pop articles))) - (entry (assoc group nnslashdot-groups)) - (sid (nth 2 entry)) - (first-comments t) - headers article subject score from date lines parent point cid - s startats changed) - (save-excursion - (set-buffer nnslashdot-buffer) - (let ((case-fold-search t)) - (erase-buffer) - (when (= start 1) - (mm-url-insert (format nnslashdot-article-url sid) t) - (goto-char (point-min)) - (if (eobp) - (error "Couldn't open connection to slashdot")) - (re-search-forward "Posted by[ \t\r\n]+") - (when (looking-at "\\(]+>\\)?[ \t\r\n]*\\([^<\r\n]+\\)") - (setq from (mm-url-decode-entities-string (match-string 2)))) - (search-forward "on ") - (setq date (nnslashdot-date-to-date - (buffer-substring (point) (1- (search-forward "<"))))) - (setq lines (/ (- (point) - (progn (forward-line 1) (point))) - 60)) - (push - (cons - 1 - (make-full-mail-header - 1 group from date - (concat "<" sid "%1@slashdot>") - "" 0 lines nil nil)) - headers) - (setq start (if nnslashdot-threaded 2 (pop articles)))) - (while (and start (<= start last)) - (setq point (goto-char (point-max))) - (mm-url-insert - (format nnslashdot-comments-url sid - nnslashdot-threshold 0 (- start 2)) - t) - (when (and nnslashdot-threaded first-comments) - (setq first-comments nil) - (goto-char (point-max)) - (while (re-search-backward "startat=\\([0-9]+\\)" nil t) - (setq s (string-to-number (match-string 1))) - (unless (memq s startats) - (push s startats))) - (setq startats (sort startats '<))) - (setq article (if (and article (< start article)) article start)) - (goto-char point) - (while (re-search-forward - "\\([^<]+\\)\\(?:.*\n\\)\\{2,10\\}.*score:\\([^)]+\\))" - nil t) - (setq cid (match-string 1) - subject (match-string 2) - score (match-string 3)) - (unless (assq article (nth 4 entry)) - (setcar (nthcdr 4 entry) (cons (cons article cid) (nth 4 entry))) - (setq changed t)) - (when (string-match "^Re: *" subject) - (setq subject (concat "Re: " (substring subject (match-end 0))))) - (setq subject (mm-url-decode-entities-string subject) - from "") - (when (re-search-forward "by[ \t\n]+<[^>]+>\\([^<(]+\\)" nil t) - (setq from - (concat - (mm-url-decode-entities-string (match-string 1)) - " "))) - (search-forward "on ") - (setq date - (nnslashdot-date-to-date - (buffer-substring - (point) (progn (skip-chars-forward "^()<>\n\r") (point))))) - (setq lines (/ (abs (- (search-forward ""))) - 70)) - (if (not - (re-search-forward ".*cid=\\([0-9]+\\)\">Parent" nil t)) - (setq parent nil) - (setq parent (match-string 1)) - (when (string= parent "0") - (setq parent nil))) - (push - (cons - article - (make-full-mail-header - article - (concat subject " (" score ")") - from date - (concat "<" sid "%" cid "@slashdot>") - (if parent - (concat "<" sid "%" parent "@slashdot>") - "") - 0 lines nil nil)) - headers) - (while (and articles (<= (car articles) article)) - (pop articles)) - (setq article (1+ article))) - (if nnslashdot-threaded - (progn - (setq start (pop startats)) - (if start (setq start (+ start 2)))) - (setq start (pop articles)))))) - (if changed (nnslashdot-write-groups)) - (setq nnslashdot-headers (sort headers 'car-less-than-car)) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (mm-with-unibyte-current-buffer - (dolist (header nnslashdot-headers) - (nnheader-insert-nov (cdr header))))) - 'nov)) - -(deffoo nnslashdot-request-group (group &optional server dont-check) - (nnslashdot-possibly-change-server nil server) - (let ((elem (assoc group nnslashdot-groups))) - (cond - ((not elem) - (nnheader-report 'nnslashdot "Group does not exist")) - (t - (nnheader-report 'nnslashdot "Opened group %s" group) - (nnheader-insert - "211 %d %d %d %s\n" (cadr elem) 1 (cadr elem) - (prin1-to-string group)))))) - -(deffoo nnslashdot-close-group (group &optional server) - (nnslashdot-possibly-change-server group server) - (when (gnus-buffer-live-p nnslashdot-buffer) - (save-excursion - (set-buffer nnslashdot-buffer) - (kill-buffer nnslashdot-buffer))) - t) - -(deffoo nnslashdot-request-article (article &optional group server buffer) - (nnslashdot-possibly-change-server group server) - (let (contents cid) - (condition-case why - (save-excursion - (set-buffer nnslashdot-buffer) - (let ((case-fold-search t)) - (goto-char (point-min)) - (when (and (stringp article) - (string-match "%\\([0-9]+\\)@" article)) - (setq cid (match-string 1 article)) - (let ((map (nth 4 (assoc group nnslashdot-groups)))) - (while map - (if (equal (cdar map) cid) - (setq article (caar map) - map nil) - (setq map (cdr map)))))) - (when (numberp article) - (if (= article 1) - (progn - (search-forward "Posted by") - (search-forward "
    ") - (setq contents - (buffer-substring - (point) - (progn - (search-forward "commentwrap") - (match-beginning 0))))) - (setq cid (cdr (assq article - (nth 4 (assoc group nnslashdot-groups))))) - (search-forward (format "" cid)) - (setq contents - (buffer-substring - (search-forward "
    ") - (progn - (search-forward "
    \r?\\)+" nil t) - (replace-match "

    " t t)) - (goto-char (point-min)) - (insert "Content-Type: text/html\nMIME-Version: 1.0\n") - (insert "Newsgroups: " (caddr (assoc group nnslashdot-groups)) - "\n") - (let ((header (cdr (assq article nnslashdot-headers)))) - (nnheader-insert-header header)) - (nnheader-report 'nnslashdot "Fetched article %s" article)) - (cons group article))))) - -(deffoo nnslashdot-close-server (&optional server) - (when (and (nnslashdot-server-opened server) - (gnus-buffer-live-p nnslashdot-buffer)) - (save-excursion - (set-buffer nnslashdot-buffer) - (kill-buffer nnslashdot-buffer))) - (nnoo-close-server 'nnslashdot server)) - -(deffoo nnslashdot-request-list (&optional server) - (nnslashdot-possibly-change-server nil server) - (let ((number 0) - (first nnslashdot-use-front-page) - sid elem description articles gname) - (condition-case why - ;; First we do the Ultramode to get info on all the latest groups. - (progn - (mm-with-unibyte-buffer - (mm-url-insert nnslashdot-backslash-url t) - (goto-char (point-min)) - (if (eobp) - (error "Couldn't open connection to slashdot")) - (while (search-forward "" nil t) - (narrow-to-region (point) (search-forward "")) - (goto-char (point-min)) - (re-search-forward "\\([^<]+\\)") - (setq description - (mm-url-decode-entities-string (match-string 1))) - (re-search-forward "\\([^<]+\\)") - (setq sid (match-string 1)) - (string-match "sid=\\([0-9/]+\\)\\(.shtml\\|$\\)" sid) - (setq sid (match-string 1 sid)) - (re-search-forward "\\([^<]+\\)") - (setq articles (string-to-number (match-string 1))) - (setq gname (concat description " (" sid ")")) - (if (setq elem (assoc gname nnslashdot-groups)) - (setcar (cdr elem) articles) - (push (list gname articles sid (current-time) nil) - nnslashdot-groups)) - (goto-char (point-max)) - (widen))) - ;; Then do the older groups. - (while (or first - (> (- nnslashdot-group-number number) 0)) - (setq first nil) - (mm-with-unibyte-buffer - (let ((case-fold-search t)) - (mm-url-insert (format nnslashdot-active-url number) t) - (goto-char (point-min)) - (while (re-search-forward - "article.pl\\?sid=\\([^&]+\\).*>\\([^<]+\\)" - nil t) - (setq sid (match-string 1) - description - (mm-url-decode-entities-string (match-string 2))) - (forward-line 1) - (when (re-search-forward "with \\([0-9]+\\) comment" nil t) - (setq articles (1+ (string-to-number (match-string 1))))) - (setq gname (concat description " (" sid ")")) - (if (setq elem (assoc gname nnslashdot-groups)) - (setcar (cdr elem) articles) - (push (list gname articles sid (current-time) nil) - nnslashdot-groups))))) - (incf number 30))) - (search-failed (nnslashdot-lose why))) - (nnslashdot-write-groups) - (nnslashdot-generate-active) - t)) - -(deffoo nnslashdot-request-newgroups (date &optional server) - (nnslashdot-possibly-change-server nil server) - (nnslashdot-generate-active) - t) - -(deffoo nnslashdot-request-post (&optional server) - (nnslashdot-possibly-change-server nil server) - (let ((sid (message-fetch-field "newsgroups")) - (subject (message-fetch-field "subject")) - (references (car (last (split-string - (message-fetch-field "references"))))) - body quoted pid) - (string-match "%\\([0-9]+\\)@slashdot" references) - (setq pid (match-string 1 references)) - (message-goto-body) - (narrow-to-region (point) (progn (message-goto-signature) (point))) - (goto-char (point-min)) - (while (not (eobp)) - (if (looking-at "> ") - (progn - (delete-region (point) (+ (point) 2)) - (unless quoted - (insert "

    \n")) - (setq quoted t)) - (when quoted - (insert "
    \n") - (setq quoted nil))) - (forward-line 1)) - (goto-char (point-min)) - (while (re-search-forward "^ *\n" nil t) - (replace-match "

    \n")) - (widen) - (when (message-goto-signature) - (forward-line -1) - (insert "

    \n") - (while (not (eobp)) - (end-of-line) - (insert "
    ") - (forward-line 1))) - (message-goto-body) - (setq body (buffer-substring (point) (point-max))) - (erase-buffer) - (mm-url-fetch-form - "http://slashdot.org/comments.pl" - `(("sid" . ,sid) - ("pid" . ,pid) - ("rlogin" . "userlogin") - ("unickname" . ,nnslashdot-login-name) - ("upasswd" . ,nnslashdot-password) - ("postersubj" . ,subject) - ("op" . "Submit") - ("postercomment" . ,body) - ("posttype" . "html"))))) - -(deffoo nnslashdot-request-delete-group (group &optional force server) - (nnslashdot-possibly-change-server group server) - (setq nnslashdot-groups (delq (assoc group nnslashdot-groups) - nnslashdot-groups)) - (nnslashdot-write-groups)) - -(deffoo nnslashdot-request-close () - (setq nnslashdot-headers nil - nnslashdot-groups nil)) - -(deffoo nnslashdot-request-expire-articles - (articles group &optional server force) - (nnslashdot-possibly-change-server group server) - (let ((item (assoc group nnslashdot-groups))) - (when item - (if (fourth item) - (when (and (>= (length articles) (cadr item)) ;; All are expirable. - (nnmail-expired-article-p - group - (fourth item) - force)) - (setq nnslashdot-groups (delq item nnslashdot-groups)) - (nnslashdot-write-groups) - (setq articles nil)) ;; all expired. - (setcdr (cddr item) (list (current-time))) - (nnslashdot-write-groups)))) - articles) - -(nnoo-define-skeleton nnslashdot) - -;;; Internal functions - -(defun nnslashdot-possibly-change-server (&optional group server) - (nnslashdot-init server) - (when (and server - (not (nnslashdot-server-opened server))) - (nnslashdot-open-server server)) - (unless nnslashdot-groups - (nnslashdot-read-groups))) - -(defun nnslashdot-make-tuple (tuple n) - (prog1 - tuple - (while (> n 1) - (unless (cdr tuple) - (setcdr tuple (list nil))) - (setq tuple (cdr tuple) - n (1- n))))) - -(defun nnslashdot-read-groups () - (let ((file (expand-file-name "groups" nnslashdot-directory))) - (when (file-exists-p file) - (mm-with-unibyte-buffer - (insert-file-contents file) - (goto-char (point-min)) - (setq nnslashdot-groups (read (current-buffer)))) - (if (and nnslashdot-groups (< (length (car nnslashdot-groups)) 5)) - (let ((groups nnslashdot-groups)) - (while groups - (nnslashdot-make-tuple (car groups) 5) - (setq groups (cdr groups)))))))) - -(defun nnslashdot-write-groups () - (with-temp-file (expand-file-name "groups" nnslashdot-directory) - (gnus-prin1 nnslashdot-groups))) - -(defun nnslashdot-init (server) - "Initialize buffers and such." - (unless (file-exists-p nnslashdot-directory) - (gnus-make-directory nnslashdot-directory)) - (unless (gnus-buffer-live-p nnslashdot-buffer) - (setq nnslashdot-buffer - (save-excursion - (nnheader-set-temp-buffer - (format " *nnslashdot %s*" server)))) - (push nnslashdot-buffer gnus-buffers))) - -(defun nnslashdot-date-to-date (sdate) - (condition-case err - (let ((elem (delete "" (split-string sdate)))) - (concat (substring (nth 0 elem) 0 3) " " - (substring (nth 1 elem) 0 3) " " - (substring (nth 2 elem) 0 2) " " - (substring (nth 3 elem) 1 6) " " - (format-time-string "%Y") " " - (nth 4 elem))) - (error ""))) - -(defun nnslashdot-generate-active () - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (dolist (elem nnslashdot-groups) - (when (numberp (cadr elem)) - (insert (prin1-to-string (car elem)) - " " (number-to-string (cadr elem)) " 1 y\n"))))) - -(defun nnslashdot-lose (why) - (error "Slashdot HTML has changed; please get a new version of nnslashdot")) - -(provide 'nnslashdot) - -;;; arch-tag: aa73df7a-f7e6-4eef-bdea-5ce2f8c691b3 -;;; nnslashdot.el ends here diff --git a/xemacs-packages/gnus/lisp/nnsoup.el b/xemacs-packages/gnus/lisp/nnsoup.el deleted file mode 100644 index 1aaaa09a..00000000 --- a/xemacs-packages/gnus/lisp/nnsoup.el +++ /dev/null @@ -1,820 +0,0 @@ -;;; nnsoup.el --- SOUP access for Gnus - -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Masanobu UMEDA -;; Keywords: news, mail - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(require 'nnheader) -(require 'nnmail) -(require 'gnus-soup) -(require 'gnus-msg) -(require 'nnoo) -(eval-when-compile (require 'cl)) - -(nnoo-declare nnsoup) - -(defvoo nnsoup-directory (nnheader-concat gnus-home-directory "SOUP/") - "*SOUP packet directory.") - -(defvoo nnsoup-tmp-directory - (cond ((fboundp 'temp-directory) (temp-directory)) - ((boundp 'temporary-file-directory) temporary-file-directory) - ("/tmp/")) - "*Where nnsoup will store temporary files.") - -(defvoo nnsoup-replies-directory (expand-file-name "replies/" nnsoup-directory) - "*Directory where outgoing packets will be composed.") - -(defvoo nnsoup-replies-format-type ?u ;; u is USENET news format. - "*Format of the replies packages.") - -(defvoo nnsoup-replies-index-type ?n - "*Index type of the replies packages.") - -(defvoo nnsoup-active-file (expand-file-name "active" nnsoup-directory) - "Active file.") - -(defvoo nnsoup-packer (concat "tar cf - %s | gzip > " - (expand-file-name gnus-home-directory) - "Soupin%d.tgz") - "Format string command for packing a SOUP packet. -The SOUP files will be inserted where the %s is in the string. -This string MUST contain both %s and %d. The file number will be -inserted where %d appears.") - -(defvoo nnsoup-unpacker "gunzip -c %s | tar xvf -" - "*Format string command for unpacking a SOUP packet. -The SOUP packet file name will be inserted at the %s.") - -(defvoo nnsoup-packet-directory gnus-home-directory - "*Where nnsoup will look for incoming packets.") - -(defvoo nnsoup-packet-regexp "Soupout" - "*Regular expression matching SOUP packets in `nnsoup-packet-directory'.") - -(defvoo nnsoup-always-save t - "If non-nil commit the reply buffer on each message send. -This is necessary if using message mode outside Gnus with nnsoup as a -backend for the messages.") - - - -(defconst nnsoup-version "nnsoup 0.0" - "nnsoup version.") - -(defvoo nnsoup-status-string "") -(defvoo nnsoup-group-alist nil) -(defvoo nnsoup-current-prefix 0) -(defvoo nnsoup-replies-list nil) -(defvoo nnsoup-buffers nil) -(defvoo nnsoup-current-group nil) -(defvoo nnsoup-group-alist-touched nil) -(defvoo nnsoup-article-alist nil) - - -;;; Interface functions. - -(nnoo-define-basics nnsoup) - -(deffoo nnsoup-retrieve-headers (sequence &optional group server fetch-old) - (nnsoup-possibly-change-group group) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (let ((areas (cddr (assoc nnsoup-current-group nnsoup-group-alist))) - (articles sequence) - (use-nov t) - useful-areas this-area-seq msg-buf) - (if (stringp (car sequence)) - ;; We don't support fetching by Message-ID. - 'headers - ;; We go through all the areas and find which files the - ;; articles in SEQUENCE come from. - (while (and areas sequence) - ;; Peel off areas that are below sequence. - (while (and areas (< (cdar (car areas)) (car sequence))) - (setq areas (cdr areas))) - (when areas - ;; This is a useful area. - (push (car areas) useful-areas) - (setq this-area-seq nil) - ;; We take note whether this MSG has a corresponding IDX - ;; for later use. - (when (or (= (gnus-soup-encoding-index - (gnus-soup-area-encoding (nth 1 (car areas)))) ?n) - (not (file-exists-p - (nnsoup-file - (gnus-soup-area-prefix (nth 1 (car areas))))))) - (setq use-nov nil)) - ;; We assign the portion of `sequence' that is relevant to - ;; this MSG packet to this packet. - (while (and sequence (<= (car sequence) (cdar (car areas)))) - (push (car sequence) this-area-seq) - (setq sequence (cdr sequence))) - (setcar useful-areas (cons (nreverse this-area-seq) - (car useful-areas))))) - - ;; We now have a list of article numbers and corresponding - ;; areas. - (setq useful-areas (nreverse useful-areas)) - - ;; Two different approaches depending on whether all the MSG - ;; files have corresponding IDX files. If they all do, we - ;; simply return the relevant IDX files and let Gnus sort out - ;; what lines are relevant. If some of the IDX files are - ;; missing, we must return HEADs for all the articles. - (if use-nov - ;; We have IDX files for all areas. - (progn - (while useful-areas - (goto-char (point-max)) - (let ((b (point)) - (number (car (nth 1 (car useful-areas)))) - (index-buffer (nnsoup-index-buffer - (gnus-soup-area-prefix - (nth 2 (car useful-areas)))))) - (when index-buffer - (insert-buffer-substring index-buffer) - (goto-char b) - ;; We have to remove the index number entries and - ;; insert article numbers instead. - (while (looking-at "[0-9]+") - (replace-match (int-to-string number) t t) - (incf number) - (forward-line 1)))) - (setq useful-areas (cdr useful-areas))) - 'nov) - ;; We insert HEADs. - (while useful-areas - (setq articles (caar useful-areas) - useful-areas (cdr useful-areas)) - (while articles - (when (setq msg-buf - (nnsoup-narrow-to-article - (car articles) (cdar useful-areas) 'head)) - (goto-char (point-max)) - (insert (format "221 %d Article retrieved.\n" (car articles))) - (insert-buffer-substring msg-buf) - (goto-char (point-max)) - (insert ".\n")) - (setq articles (cdr articles)))) - - (nnheader-fold-continuation-lines) - 'headers))))) - -(deffoo nnsoup-open-server (server &optional defs) - (nnoo-change-server 'nnsoup server defs) - (when (not (file-exists-p nnsoup-directory)) - (condition-case () - (make-directory nnsoup-directory t) - (error t))) - (cond - ((not (file-exists-p nnsoup-directory)) - (nnsoup-close-server) - (nnheader-report 'nnsoup "Couldn't create directory: %s" nnsoup-directory)) - ((not (file-directory-p (file-truename nnsoup-directory))) - (nnsoup-close-server) - (nnheader-report 'nnsoup "Not a directory: %s" nnsoup-directory)) - (t - (nnsoup-read-active-file) - (nnheader-report 'nnsoup "Opened server %s using directory %s" - server nnsoup-directory) - t))) - -(deffoo nnsoup-request-close () - (nnsoup-write-active-file) - (nnsoup-write-replies) - (gnus-soup-save-areas) - ;; Kill all nnsoup buffers. - (let (buffer) - (while nnsoup-buffers - (setq buffer (cdr (pop nnsoup-buffers))) - (and buffer - (buffer-name buffer) - (kill-buffer buffer)))) - (setq nnsoup-group-alist nil - nnsoup-group-alist-touched nil - nnsoup-current-group nil - nnsoup-replies-list nil) - (nnoo-close-server 'nnoo) - t) - -(deffoo nnsoup-request-article (id &optional newsgroup server buffer) - (nnsoup-possibly-change-group newsgroup) - (let (buf) - (save-excursion - (set-buffer (or buffer nntp-server-buffer)) - (erase-buffer) - (when (and (not (stringp id)) - (setq buf (nnsoup-narrow-to-article id))) - (insert-buffer-substring buf) - t)))) - -(deffoo nnsoup-request-group (group &optional server dont-check) - (nnsoup-possibly-change-group group) - (if dont-check - t - (let ((active (cadr (assoc group nnsoup-group-alist)))) - (if (not active) - (nnheader-report 'nnsoup "No such group: %s" group) - (nnheader-insert - "211 %d %d %d %s\n" - (max (1+ (- (cdr active) (car active))) 0) - (car active) (cdr active) group))))) - -(deffoo nnsoup-request-type (group &optional article) - (nnsoup-possibly-change-group group) - ;; Try to guess the type based on the first article in the group. - (when (not article) - (setq article - (cdar (car (cddr (assoc group nnsoup-group-alist)))))) - (if (not article) - 'unknown - (let ((kind (gnus-soup-encoding-kind - (gnus-soup-area-encoding - (nth 1 (nnsoup-article-to-area - article nnsoup-current-group)))))) - (cond ((= kind ?m) 'mail) - ((= kind ?n) 'news) - (t 'unknown))))) - -(deffoo nnsoup-close-group (group &optional server) - ;; Kill all nnsoup buffers. - (let ((buffers nnsoup-buffers) - elem) - (while buffers - (when (equal (car (setq elem (pop buffers))) group) - (setq nnsoup-buffers (delq elem nnsoup-buffers)) - (and (cdr elem) (buffer-name (cdr elem)) - (kill-buffer (cdr elem)))))) - t) - -(deffoo nnsoup-request-list (&optional server) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (unless nnsoup-group-alist - (nnsoup-read-active-file)) - (let ((alist nnsoup-group-alist) - (standard-output (current-buffer)) - entry) - (while (setq entry (pop alist)) - (insert (car entry) " ") - (princ (cdadr entry)) - (insert " ") - (princ (caadr entry)) - (insert " y\n")) - t))) - -(deffoo nnsoup-request-scan (group &optional server) - (nnsoup-unpack-packets)) - -(deffoo nnsoup-request-newgroups (date &optional server) - (nnsoup-request-list)) - -(deffoo nnsoup-request-list-newsgroups (&optional server) - nil) - -(deffoo nnsoup-request-post (&optional server) - (nnsoup-store-reply "news") - t) - -(deffoo nnsoup-request-mail (&optional server) - (nnsoup-store-reply "mail") - t) - -(deffoo nnsoup-request-expire-articles (articles group &optional server force) - (nnsoup-possibly-change-group group) - (let* ((total-infolist (assoc group nnsoup-group-alist)) - (active (cadr total-infolist)) - (infolist (cddr total-infolist)) - info range-list mod-time prefix) - (while infolist - (setq info (pop infolist) - range-list (gnus-uncompress-range (car info)) - prefix (gnus-soup-area-prefix (nth 1 info))) - (when;; All the articles in this file are marked for expiry. - (and (or (setq mod-time (nth 5 (file-attributes - (nnsoup-file prefix)))) - (setq mod-time (nth 5 (file-attributes - (nnsoup-file prefix t))))) - (gnus-sublist-p articles range-list) - ;; This file is old enough. - (nnmail-expired-article-p group mod-time force)) - ;; Ok, we delete this file. - (when (ignore-errors - (nnheader-message - 5 "Deleting %s in group %s..." (nnsoup-file prefix) - group) - (when (file-exists-p (nnsoup-file prefix)) - (delete-file (nnsoup-file prefix))) - (nnheader-message - 5 "Deleting %s in group %s..." (nnsoup-file prefix t) - group) - (when (file-exists-p (nnsoup-file prefix t)) - (delete-file (nnsoup-file prefix t))) - t) - (setcdr (cdr total-infolist) (delq info (cddr total-infolist))) - (setq articles (gnus-sorted-difference articles range-list)))) - (when (not mod-time) - (setcdr (cdr total-infolist) (delq info (cddr total-infolist))))) - (if (cddr total-infolist) - (setcar active (caaadr (cdr total-infolist))) - (setcar active (1+ (cdr active)))) - (nnsoup-write-active-file t) - ;; Return the articles that weren't expired. - articles)) - - -;;; Internal functions - -(defun nnsoup-possibly-change-group (group &optional force) - (when (and group - (not (equal nnsoup-current-group group))) - (setq nnsoup-article-alist nil) - (setq nnsoup-current-group group)) - t) - -(defun nnsoup-read-active-file () - (setq nnsoup-group-alist nil) - (when (file-exists-p nnsoup-active-file) - (ignore-errors - (load nnsoup-active-file t t t)) - ;; Be backwards compatible. - (when (and nnsoup-group-alist - (not (atom (caadar nnsoup-group-alist)))) - (let ((alist nnsoup-group-alist) - entry e min max) - (while (setq e (cdr (setq entry (pop alist)))) - (setq min (caaar e)) - (while (cdr e) - (setq e (cdr e))) - (setq max (cdar (car e))) - (setcdr entry (cons (cons min max) (cdr entry))))) - (setq nnsoup-group-alist-touched t)) - nnsoup-group-alist)) - -(defun nnsoup-write-active-file (&optional force) - (when (and nnsoup-group-alist - (or force - nnsoup-group-alist-touched)) - (setq nnsoup-group-alist-touched nil) - (with-temp-file nnsoup-active-file - (gnus-prin1 `(setq nnsoup-group-alist ',nnsoup-group-alist)) - (insert "\n") - (gnus-prin1 `(setq nnsoup-current-prefix ,nnsoup-current-prefix)) - (insert "\n")))) - -(defun nnsoup-next-prefix () - "Return the next free prefix." - (let (prefix) - (while (or (file-exists-p - (nnsoup-file (setq prefix (int-to-string - nnsoup-current-prefix)))) - (file-exists-p (nnsoup-file prefix t))) - (incf nnsoup-current-prefix)) - (incf nnsoup-current-prefix) - prefix)) - -(defun nnsoup-file-name (dir file) - "Return the full name of FILE (in any case) in DIR." - (let* ((case-fold-search t) - (files (directory-files dir t)) - (regexp (concat (regexp-quote file) "$"))) - (car (delq nil - (mapcar - (lambda (file) - (if (string-match regexp file) - file - nil)) - files))))) - -(defun nnsoup-read-areas () - (let ((areas-file (nnsoup-file-name nnsoup-tmp-directory "areas"))) - (when areas-file - (save-excursion - (set-buffer nntp-server-buffer) - (let ((areas (gnus-soup-parse-areas areas-file)) - entry number area lnum cur-prefix file) - ;; Go through all areas in the new AREAS file. - (while (setq area (pop areas)) - ;; Change the name to the permanent name and move the files. - (setq cur-prefix (nnsoup-next-prefix)) - (nnheader-message 5 "Incorporating file %s..." cur-prefix) - (when (file-exists-p - (setq file - (expand-file-name - (concat (gnus-soup-area-prefix area) ".IDX") - nnsoup-tmp-directory))) - (rename-file file (nnsoup-file cur-prefix))) - (when (file-exists-p - (setq file (expand-file-name - (concat (gnus-soup-area-prefix area) ".MSG") - nnsoup-tmp-directory))) - (rename-file file (nnsoup-file cur-prefix t)) - (gnus-soup-set-area-prefix area cur-prefix) - ;; Find the number of new articles in this area. - (setq number (nnsoup-number-of-articles area)) - (if (not (setq entry (assoc (gnus-soup-area-name area) - nnsoup-group-alist))) - ;; If this is a new area (group), we just add this info to - ;; the group alist. - (push (list (gnus-soup-area-name area) - (cons 1 number) - (list (cons 1 number) area)) - nnsoup-group-alist) - ;; There are already articles in this group, so we add this - ;; info to the end of the entry. - (nconc entry (list (list (cons (1+ (setq lnum (cdadr entry))) - (+ lnum number)) - area))) - (setcdr (cadr entry) (+ lnum number)))))) - (nnsoup-write-active-file t) - (delete-file areas-file))))) - -(defun nnsoup-number-of-articles (area) - (save-excursion - (cond - ;; If the number is in the area info, we just return it. - ((gnus-soup-area-number area) - (gnus-soup-area-number area)) - ;; If there is an index file, we just count the lines. - ((/= (gnus-soup-encoding-index (gnus-soup-area-encoding area)) ?n) - (set-buffer (nnsoup-index-buffer (gnus-soup-area-prefix area))) - (count-lines (point-min) (point-max))) - ;; We do it the hard way - re-searching through the message - ;; buffer. - (t - (set-buffer (nnsoup-message-buffer (gnus-soup-area-prefix area))) - (unless (assoc (gnus-soup-area-prefix area) nnsoup-article-alist) - (nnsoup-dissect-buffer area)) - (length (cdr (assoc (gnus-soup-area-prefix area) - nnsoup-article-alist))))))) - -(defun nnsoup-dissect-buffer (area) - (let ((mbox-delim (concat "^" message-unix-mail-delimiter)) - (format (gnus-soup-encoding-format (gnus-soup-area-encoding area))) - (i 0) - alist len) - (goto-char (point-min)) - (cond - ;; rnews batch format - ((or (= format ?u) - (= format ?n)) ;; Gnus back compatibility. - (while (looking-at "^#! *rnews \\(+[0-9]+\\) *$") - (forward-line 1) - (push (list - (incf i) (point) - (progn - (forward-char (string-to-number (match-string 1))) - (point))) - alist))) - ;; Unix mbox format - ((= format ?m) - (while (looking-at mbox-delim) - (forward-line 1) - (push (list - (incf i) (point) - (progn - (if (re-search-forward mbox-delim nil t) - (beginning-of-line) - (goto-char (point-max))) - (point))) - alist))) - ;; MMDF format - ((= format ?M) - (while (looking-at "\^A\^A\^A\^A\n") - (forward-line 1) - (push (list - (incf i) (point) - (progn - (if (search-forward "\n\^A\^A\^A\^A\n" nil t) - (beginning-of-line) - (goto-char (point-max))) - (point))) - alist))) - ;; Binary format - ((or (= format ?B) (= format ?b)) - (while (not (eobp)) - (setq len (+ (* (char-after (point)) (expt 2.0 24)) - (* (char-after (+ (point) 1)) (expt 2 16)) - (* (char-after (+ (point) 2)) (expt 2 8)) - (char-after (+ (point) 3)))) - (push (list - (incf i) (+ (point) 4) - (progn - (forward-char (floor (+ len 4))) - (point))) - alist))) - (t - (error "Unknown format: %c" format))) - (push (cons (gnus-soup-area-prefix area) alist) nnsoup-article-alist))) - -(defun nnsoup-index-buffer (prefix &optional message) - (let* ((file (concat prefix (if message ".MSG" ".IDX"))) - (buffer-name (concat " *nnsoup " file "*"))) - (or (get-buffer buffer-name) ; File already loaded. - (when (file-exists-p (expand-file-name file nnsoup-directory)) - (save-excursion ; Load the file. - (set-buffer (get-buffer-create buffer-name)) - (buffer-disable-undo) - (push (cons nnsoup-current-group (current-buffer)) nnsoup-buffers) - (nnheader-insert-file-contents - (expand-file-name file nnsoup-directory)) - (current-buffer)))))) - -(defun nnsoup-file (prefix &optional message) - (expand-file-name - (concat prefix (if message ".MSG" ".IDX")) - nnsoup-directory)) - -(defun nnsoup-message-buffer (prefix) - (nnsoup-index-buffer prefix 'msg)) - -(defun nnsoup-unpack-packets () - "Unpack all packets in `nnsoup-packet-directory'." - (let ((packets (directory-files - nnsoup-packet-directory t nnsoup-packet-regexp)) - packet) - (while (setq packet (pop packets)) - (nnheader-message 5 "nnsoup: unpacking %s..." packet) - (if (not (gnus-soup-unpack-packet - nnsoup-tmp-directory nnsoup-unpacker packet)) - (nnheader-message 5 "Couldn't unpack %s" packet) - (delete-file packet) - (nnsoup-read-areas) - (nnheader-message 5 "Unpacking...done"))))) - -(defun nnsoup-narrow-to-article (article &optional area head) - (let* ((area (or area (nnsoup-article-to-area article nnsoup-current-group))) - (prefix (and area (gnus-soup-area-prefix (nth 1 area)))) - (msg-buf (and prefix (nnsoup-index-buffer prefix 'msg))) - beg end) - (when area - (save-excursion - (cond - ;; There is no MSG file. - ((null msg-buf) - nil) - ;; We use the index file to find out where the article - ;; begins and ends. - ((and (= (gnus-soup-encoding-index - (gnus-soup-area-encoding (nth 1 area))) - ?c) - (file-exists-p (nnsoup-file prefix))) - (set-buffer (nnsoup-index-buffer prefix)) - (widen) - (goto-char (point-min)) - (forward-line (- article (caar area))) - (setq beg (read (current-buffer))) - (forward-line 1) - (if (looking-at "[0-9]+") - (progn - (setq end (read (current-buffer))) - (set-buffer msg-buf) - (widen) - (let ((format (gnus-soup-encoding-format - (gnus-soup-area-encoding (nth 1 area))))) - (goto-char end) - (when (or (= format ?u) (= format ?n) (= format ?m)) - (setq end (progn (forward-line -1) (point)))))) - (set-buffer msg-buf)) - (widen) - (narrow-to-region beg (or end (point-max)))) - (t - (set-buffer msg-buf) - (widen) - (unless (assoc (gnus-soup-area-prefix (nth 1 area)) - nnsoup-article-alist) - (nnsoup-dissect-buffer (nth 1 area))) - (let ((entry (assq article (cdr (assoc (gnus-soup-area-prefix - (nth 1 area)) - nnsoup-article-alist))))) - (when entry - (narrow-to-region (cadr entry) (caddr entry)))))) - (goto-char (point-min)) - (if (not head) - () - (narrow-to-region - (point-min) - (if (search-forward "\n\n" nil t) - (1- (point)) - (point-max)))) - msg-buf)))) - -;;;###autoload -(defun nnsoup-pack-replies () - "Make an outbound package of SOUP replies." - (interactive) - (unless (file-exists-p nnsoup-replies-directory) - (nnheader-message 5 "No such directory: %s" nnsoup-replies-directory)) - ;; Write all data buffers. - (gnus-soup-save-areas) - ;; Write the active file. - (nnsoup-write-active-file) - ;; Write the REPLIES file. - (nnsoup-write-replies) - ;; Check whether there is anything here. - (when (null (directory-files nnsoup-replies-directory nil "\\.MSG$")) - (error "No files to pack")) - ;; Pack all these files into a SOUP packet. - (gnus-soup-pack nnsoup-replies-directory nnsoup-packer)) - -(defun nnsoup-write-replies () - "Write the REPLIES file." - (when nnsoup-replies-list - (gnus-soup-write-replies nnsoup-replies-directory nnsoup-replies-list) - (setq nnsoup-replies-list nil))) - -(defun nnsoup-article-to-area (article group) - "Return the area that ARTICLE in GROUP is located in." - (let ((areas (cddr (assoc group nnsoup-group-alist)))) - (while (and areas (< (cdar (car areas)) article)) - (setq areas (cdr areas))) - (and areas (car areas)))) - -(defvar nnsoup-old-functions - (list message-send-mail-real-function message-send-news-function)) - -;;;###autoload -(defun nnsoup-set-variables () - "Use the SOUP methods for posting news and mailing mail." - (interactive) - (setq message-send-news-function 'nnsoup-request-post) - (setq message-send-mail-real-function 'nnsoup-request-mail)) - -;;;###autoload -(defun nnsoup-revert-variables () - "Revert posting and mailing methods to the standard Emacs methods." - (interactive) - (setq message-send-mail-real-function (car nnsoup-old-functions)) - (setq message-send-news-function (cadr nnsoup-old-functions))) - -(defun nnsoup-store-reply (kind) - ;; Mostly stolen from `message.el'. - (require 'mail-utils) - (let ((tembuf (generate-new-buffer " message temp")) - (case-fold-search nil) - delimline - (mailbuf (current-buffer))) - (unwind-protect - (save-excursion - (save-restriction - (message-narrow-to-headers) - (if (equal kind "mail") - (message-generate-headers message-required-mail-headers) - (message-generate-headers message-required-news-headers))) - (set-buffer tembuf) - (erase-buffer) - (insert-buffer-substring mailbuf) - ;; Remove some headers. - (save-restriction - (message-narrow-to-headers) - ;; Remove some headers. - (message-remove-header message-ignored-mail-headers t)) - (goto-char (point-max)) - ;; require one newline at the end. - (or (= (preceding-char) ?\n) - (insert ?\n)) - (let ((case-fold-search t)) - ;; Change header-delimiter to be what sendmail expects. - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "\n")) - (replace-match "\n") - (backward-char 1) - (setq delimline (point-marker)) - (goto-char (1+ delimline)) - (let ((msg-buf - (gnus-soup-store - nnsoup-replies-directory - (nnsoup-kind-to-prefix kind) nil nnsoup-replies-format-type - nnsoup-replies-index-type)) - (num 0)) - (when (and msg-buf (bufferp msg-buf)) - (save-excursion - (set-buffer msg-buf) - (goto-char (point-min)) - (while (re-search-forward "^#! *rnews" nil t) - (incf num)) - (when nnsoup-always-save - (save-buffer))) - (nnheader-message 5 "Stored %d messages" num))) - (nnsoup-write-replies) - (kill-buffer tembuf)))))) - -(defun nnsoup-kind-to-prefix (kind) - (unless nnsoup-replies-list - (setq nnsoup-replies-list - (gnus-soup-parse-replies - (expand-file-name "REPLIES" nnsoup-replies-directory)))) - (let ((replies nnsoup-replies-list)) - (while (and replies - (not (string= kind (gnus-soup-reply-kind (car replies))))) - (setq replies (cdr replies))) - (if replies - (gnus-soup-reply-prefix (car replies)) - (push (vector (gnus-soup-unique-prefix nnsoup-replies-directory) - kind - (format "%c%c%c" - nnsoup-replies-format-type - nnsoup-replies-index-type - (if (string= kind "news") - ?n ?m))) - nnsoup-replies-list) - (gnus-soup-reply-prefix (car nnsoup-replies-list))))) - -(defun nnsoup-make-active () - "(Re-)create the SOUP active file." - (interactive) - (let ((files (sort (directory-files nnsoup-directory t "IDX$") - (lambda (f1 f2) - (< (progn (string-match "/\\([0-9]+\\)\\." f1) - (string-to-number (match-string 1 f1))) - (progn (string-match "/\\([0-9]+\\)\\." f2) - (string-to-number (match-string 1 f2))))))) - active group lines ident elem min) - (set-buffer (get-buffer-create " *nnsoup work*")) - (while files - (nnheader-message 5 "Doing %s..." (car files)) - (erase-buffer) - (nnheader-insert-file-contents (car files)) - (goto-char (point-min)) - (if (not (re-search-forward "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t *\\(Xref: \\)? *[^ ]* \\([^ ]+\\):[0-9]" nil t)) - (setq group "unknown") - (setq group (match-string 2))) - (setq lines (count-lines (point-min) (point-max))) - (setq ident (progn (string-match - "/\\([0-9]+\\)\\." (car files)) - (substring - (car files) (match-beginning 1) - (match-end 1)))) - (if (not (setq elem (assoc group active))) - (push (list group (cons 1 lines) - (list (cons 1 lines) - (vector ident group "ucm" "" lines))) - active) - (nconc elem - (list - (list (cons (1+ (setq min (cdadr elem))) - (+ min lines)) - (vector ident group "ucm" "" lines)))) - (setcdr (cadr elem) (+ min lines))) - (setq files (cdr files))) - (nnheader-message 5 "") - (setq nnsoup-group-alist active) - (nnsoup-write-active-file t))) - -(defun nnsoup-delete-unreferenced-message-files () - "Delete any *.MSG and *.IDX files that aren't known by nnsoup." - (interactive) - (let* ((known (apply 'nconc (mapcar - (lambda (ga) - (mapcar - (lambda (area) - (gnus-soup-area-prefix (cadr area))) - (cddr ga))) - nnsoup-group-alist))) - (regexp "\\.MSG$\\|\\.IDX$") - (files (directory-files nnsoup-directory nil regexp)) - non-files file) - ;; Find all files that aren't known by nnsoup. - (while (setq file (pop files)) - (string-match regexp file) - (unless (member (substring file 0 (match-beginning 0)) known) - (push file non-files))) - ;; Sort and delete the files. - (setq non-files (sort non-files 'string<)) - (map-y-or-n-p "Delete file %s? " - (lambda (file) (delete-file - (expand-file-name file nnsoup-directory))) - non-files))) - -(provide 'nnsoup) - -;;; arch-tag: b0451389-5703-4450-9425-f66f6b38c828 -;;; nnsoup.el ends here diff --git a/xemacs-packages/gnus/lisp/nnspool.el b/xemacs-packages/gnus/lisp/nnspool.el deleted file mode 100644 index e68bd8de..00000000 --- a/xemacs-packages/gnus/lisp/nnspool.el +++ /dev/null @@ -1,471 +0,0 @@ -;;; nnspool.el --- spool access for GNU Emacs - -;; Copyright (C) 1988, 1989, 1990, 1993, 1994, 1995, 1996, 1997, 1998, -;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Masanobu UMEDA -;; Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(require 'nnheader) -(require 'nntp) -(require 'nnoo) -(eval-when-compile (require 'cl)) - -(nnoo-declare nnspool) - -(defvoo nnspool-inews-program news-inews-program - "Program to post news. -This is most commonly `inews' or `injnews'.") - -(defvoo nnspool-inews-switches '("-h" "-S") - "Switches for nnspool-request-post to pass to `inews' for posting news. -If you are using Cnews, you probably should set this variable to nil.") - -(defvoo nnspool-spool-directory - (file-name-as-directory (if (boundp 'news-directory) - (symbol-value 'news-directory) - news-path)) - "Local news spool directory.") - -(defvoo nnspool-nov-directory (concat nnspool-spool-directory "over.view/") - "Local news nov directory.") - -(defvoo nnspool-lib-dir - (if (file-exists-p "/usr/lib/news/active") - "/usr/lib/news/" - "/var/lib/news/") - "Where the local news library files are stored.") - -(defvoo nnspool-active-file (concat nnspool-lib-dir "active") - "Local news active file.") - -(defvoo nnspool-newsgroups-file (concat nnspool-lib-dir "newsgroups") - "Local news newsgroups file.") - -(defvoo nnspool-distributions-file (concat nnspool-lib-dir "distribs.pat") - "Local news distributions file.") - -(defvoo nnspool-history-file (concat nnspool-lib-dir "history") - "Local news history file.") - -(defvoo nnspool-active-times-file (concat nnspool-lib-dir "active.times") - "Local news active date file.") - -(defvoo nnspool-large-newsgroup 50 - "The number of articles which indicates a large newsgroup. -If the number of articles is greater than the value, verbose -messages will be shown to indicate the current status.") - -(defvoo nnspool-nov-is-evil nil - "Non-nil means that nnspool will never return NOV lines instead of headers.") - -(defconst nnspool-sift-nov-with-sed nil - "If non-nil, use sed to get the relevant portion from the overview file. -If nil, nnspool will load the entire file into a buffer and process it -there.") - -(defvoo nnspool-rejected-article-hook nil - "*A hook that will be run when an article has been rejected by the server.") - -(defvoo nnspool-file-coding-system nnheader-file-coding-system - "Coding system for nnspool.") - - - -(defconst nnspool-version "nnspool 2.0" - "Version numbers of this version of NNSPOOL.") - -(defvoo nnspool-current-directory nil - "Current news group directory.") - -(defvoo nnspool-current-group nil) -(defvoo nnspool-status-string "") - - -;;; Interface functions. - -(nnoo-define-basics nnspool) - -(deffoo nnspool-retrieve-headers (articles &optional group server fetch-old) - "Retrieve the headers of ARTICLES." - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (when (nnspool-possibly-change-directory group) - (let* ((number (length articles)) - (count 0) - (default-directory nnspool-current-directory) - (do-message (and (numberp nnspool-large-newsgroup) - (> number nnspool-large-newsgroup))) - (nnheader-file-coding-system nnspool-file-coding-system) - file beg article ag) - (if (and (numberp (car articles)) - (nnspool-retrieve-headers-with-nov articles fetch-old)) - ;; We successfully retrieved the NOV headers. - 'nov - ;; No NOV headers here, so we do it the hard way. - (while (setq article (pop articles)) - (if (stringp article) - ;; This is a Message-ID. - (setq ag (nnspool-find-id article) - file (and ag (nnspool-article-pathname - (car ag) (cdr ag))) - article (cdr ag)) - ;; This is an article in the current group. - (setq file (int-to-string article))) - ;; Insert the head of the article. - (when (and file - (file-exists-p file)) - (insert "221 ") - (princ article (current-buffer)) - (insert " Article retrieved.\n") - (setq beg (point)) - (inline (nnheader-insert-head file)) - (goto-char beg) - (if (search-forward "\n\n" nil t) - (progn - (forward-char -1) - (insert ".\n")) - (goto-char (point-max)) - (if (bolp) - (insert ".\n") - (insert "\n.\n"))) - (delete-region (point) (point-max))) - - (and do-message - (zerop (% (incf count) 20)) - (nnheader-message 5 "nnspool: Receiving headers... %d%%" - (/ (* count 100) number)))) - - (when do-message - (nnheader-message 5 "nnspool: Receiving headers...done")) - - ;; Fold continuation lines. - (nnheader-fold-continuation-lines) - 'headers))))) - -(deffoo nnspool-open-server (server &optional defs) - (nnoo-change-server 'nnspool server defs) - (cond - ((not (file-exists-p nnspool-spool-directory)) - (nnspool-close-server) - (nnheader-report 'nnspool "Spool directory doesn't exist: %s" - nnspool-spool-directory)) - ((not (file-directory-p - (directory-file-name - (file-truename nnspool-spool-directory)))) - (nnspool-close-server) - (nnheader-report 'nnspool "Not a directory: %s" nnspool-spool-directory)) - ((not (file-exists-p nnspool-active-file)) - (nnheader-report 'nnspool "The active file doesn't exist: %s" - nnspool-active-file)) - (t - (nnheader-report 'nnspool "Opened server %s using directory %s" - server nnspool-spool-directory) - t))) - -(deffoo nnspool-request-article (id &optional group server buffer) - "Select article by message ID (or number)." - (nnspool-possibly-change-directory group) - (let ((nntp-server-buffer (or buffer nntp-server-buffer)) - file ag) - (if (stringp id) - ;; This is a Message-ID. - (when (setq ag (nnspool-find-id id)) - (setq file (nnspool-article-pathname (car ag) (cdr ag)))) - (setq file (nnspool-article-pathname nnspool-current-group id))) - (and file - (file-exists-p file) - (not (file-directory-p file)) - (save-excursion (nnspool-find-file file)) - ;; We return the article number and group name. - (if (numberp id) - (cons nnspool-current-group id) - ag)))) - -(deffoo nnspool-request-body (id &optional group server) - "Select article body by message ID (or number)." - (nnspool-possibly-change-directory group) - (let ((res (nnspool-request-article id))) - (when res - (save-excursion - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (delete-region (point-min) (point))) - res)))) - -(deffoo nnspool-request-head (id &optional group server) - "Select article head by message ID (or number)." - (nnspool-possibly-change-directory group) - (let ((res (nnspool-request-article id))) - (when res - (save-excursion - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (delete-region (1- (point)) (point-max))) - (nnheader-fold-continuation-lines))) - res)) - -(deffoo nnspool-request-group (group &optional server dont-check) - "Select news GROUP." - (let ((pathname (nnspool-article-pathname group)) - dir) - (if (not (file-directory-p pathname)) - (nnheader-report - 'nnspool "Invalid group name (no such directory): %s" group) - (setq nnspool-current-directory pathname) - (nnheader-report 'nnspool "Selected group %s" group) - (if dont-check - (progn - (nnheader-report 'nnspool "Selected group %s" group) - t) - ;; Yes, completely empty spool directories *are* possible. - ;; Fix by Sudish Joseph - (when (setq dir (directory-files pathname nil "^[0-9]+$" t)) - (setq dir - (sort (mapcar (lambda (name) (string-to-number name)) dir) '<))) - (if dir - (nnheader-insert - "211 %d %d %d %s\n" (length dir) (car dir) - (progn (while (cdr dir) (setq dir (cdr dir))) (car dir)) - group) - (nnheader-report 'nnspool "Empty group %s" group) - (nnheader-insert "211 0 0 0 %s\n" group)))))) - -(deffoo nnspool-request-type (group &optional article) - 'news) - -(deffoo nnspool-close-group (group &optional server) - t) - -(deffoo nnspool-request-list (&optional server) - "List active newsgroups." - (save-excursion - (or (nnspool-find-file nnspool-active-file) - (nnheader-report 'nnspool (nnheader-file-error nnspool-active-file))))) - -(deffoo nnspool-request-list-newsgroups (&optional server) - "List newsgroups (defined in NNTP2)." - (save-excursion - (or (nnspool-find-file nnspool-newsgroups-file) - (nnheader-report 'nnspool (nnheader-file-error - nnspool-newsgroups-file))))) - -(deffoo nnspool-request-list-distributions (&optional server) - "List distributions (defined in NNTP2)." - (save-excursion - (or (nnspool-find-file nnspool-distributions-file) - (nnheader-report 'nnspool (nnheader-file-error - nnspool-distributions-file))))) - -;; Suggested by Hallvard B Furuseth . -(deffoo nnspool-request-newgroups (date &optional server) - "List groups created after DATE." - (if (nnspool-find-file nnspool-active-times-file) - (save-excursion - ;; Find the last valid line. - (goto-char (point-max)) - (while (and (not (looking-at - "\\([^ ]+\\) +\\([0-9]+\\)[0-9][0-9][0-9] ")) - (zerop (forward-line -1)))) - (let ((seconds (time-to-seconds (date-to-time date))) - groups) - ;; Go through lines and add the latest groups to a list. - (while (and (looking-at "\\([^ ]+\\) +[0-9]+ ") - (progn - ;; We insert a .0 to make the list reader - ;; interpret the number as a float. It is far - ;; too big to be stored in a lisp integer. - (goto-char (1- (match-end 0))) - (insert ".0") - (> (progn - (goto-char (match-end 1)) - (read (current-buffer))) - seconds)) - (push (buffer-substring - (match-beginning 1) (match-end 1)) - groups) - (zerop (forward-line -1)))) - (erase-buffer) - (while groups - (insert (car groups) " 0 0 y\n") - (setq groups (cdr groups)))) - t) - nil)) - -(deffoo nnspool-request-post (&optional server) - "Post a new news in current buffer." - (save-excursion - (let* ((process-connection-type nil) ; t bugs out on Solaris - (inews-buffer (generate-new-buffer " *nnspool post*")) - (proc - (condition-case err - (apply 'start-process "*nnspool inews*" inews-buffer - nnspool-inews-program nnspool-inews-switches) - (error - (nnheader-report 'nnspool "inews error: %S" err))))) - (if (not proc) - ;; The inews program failed. - () - (nnheader-report 'nnspool "") - (set-process-sentinel proc 'nnspool-inews-sentinel) - (mm-with-unibyte-current-buffer - (process-send-region proc (point-min) (point-max))) - ;; We slap a condition-case around this, because the process may - ;; have exited already... - (ignore-errors - (process-send-eof proc)) - t)))) - - - -;;; Internal functions. - -(defun nnspool-inews-sentinel (proc status) - (save-excursion - (set-buffer (process-buffer proc)) - (goto-char (point-min)) - (if (or (zerop (buffer-size)) - (search-forward "spooled" nil t)) - (kill-buffer (current-buffer)) - ;; Make status message by folding lines. - (while (re-search-forward "[ \t\n]+" nil t) - (replace-match " " t t)) - (nnheader-report 'nnspool "%s" (buffer-string)) - (nnheader-message 5 "nnspool: %s" nnspool-status-string) - (ding) - (run-hooks 'nnspool-rejected-article-hook)))) - -(defun nnspool-retrieve-headers-with-nov (articles &optional fetch-old) - (if (or gnus-nov-is-evil nnspool-nov-is-evil) - nil - (let ((nov (nnheader-group-pathname - nnspool-current-group nnspool-nov-directory ".overview")) - (arts articles) - (nnheader-file-coding-system nnspool-file-coding-system) - last) - (if (not (file-exists-p nov)) - () - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (if nnspool-sift-nov-with-sed - (nnspool-sift-nov-with-sed articles nov) - (nnheader-insert-file-contents nov) - (if (and fetch-old - (not (numberp fetch-old))) - t ; We want all the headers. - (ignore-errors - ;; Delete unwanted NOV lines. - (nnheader-nov-delete-outside-range - (if fetch-old (max 1 (- (car articles) fetch-old)) - (car articles)) - (car (last articles))) - ;; If the buffer is empty, this wasn't very successful. - (unless (zerop (buffer-size)) - ;; We check what the last article number was. - ;; The NOV file may be out of sync with the articles - ;; in the group. - (forward-line -1) - (setq last (read (current-buffer))) - (if (= last (car articles)) - ;; Yup, it's all there. - t - ;; Perhaps not. We try to find the missing articles. - (while (and arts - (<= last (car arts))) - (pop arts)) - ;; The articles in `arts' are missing from the buffer. - (while arts - (nnspool-insert-nov-head (pop arts))) - t)))))))))) - -(defun nnspool-insert-nov-head (article) - "Read the head of ARTICLE, convert to NOV headers, and insert." - (save-excursion - (let ((cur (current-buffer)) - buf) - (setq buf (nnheader-set-temp-buffer " *nnspool head*")) - (when (nnheader-insert-head - (nnspool-article-pathname nnspool-current-group article)) - (nnheader-insert-article-line article) - (let ((headers (nnheader-parse-head))) - (set-buffer cur) - (goto-char (point-max)) - (nnheader-insert-nov headers))) - (kill-buffer buf)))) - -(defun nnspool-sift-nov-with-sed (articles file) - (let ((first (car articles)) - (last (progn (while (cdr articles) (setq articles (cdr articles))) - (car articles)))) - (call-process "awk" nil t nil - (format "BEGIN {firstmsg=%d; lastmsg=%d;}\n $1 >= firstmsg && $1 <= lastmsg {print;}" - (1- first) (1+ last)) - file))) - -;; Fixed by fdc@cliwe.ping.de (Frank D. Cringle). -;; Find out what group an article identified by a Message-ID is in. -(defun nnspool-find-id (id) - (save-excursion - (set-buffer (get-buffer-create " *nnspool work*")) - (erase-buffer) - (ignore-errors - (call-process "grep" nil t nil (regexp-quote id) nnspool-history-file)) - (goto-char (point-min)) - (prog1 - (when (looking-at "<[^>]+>[ \t]+[-0-9~]+[ \t]+\\([^ /\t\n]+\\)/\\([0-9]+\\)[ \t\n]") - (cons (match-string 1) (string-to-number (match-string 2)))) - (kill-buffer (current-buffer))))) - -(defun nnspool-find-file (file) - "Insert FILE in server buffer safely." - (set-buffer nntp-server-buffer) - (erase-buffer) - (condition-case () - (let ((coding-system-for-read nnspool-file-coding-system)) - (mm-insert-file-contents file) - t) - (file-error nil))) - -(defun nnspool-possibly-change-directory (group) - (if (not group) - t - (let ((pathname (nnspool-article-pathname group))) - (if (file-directory-p pathname) - (setq nnspool-current-directory pathname - nnspool-current-group group) - (nnheader-report 'nnspool "No such newsgroup: %s" group))))) - -(defun nnspool-article-pathname (group &optional article) - "Find the file name for GROUP." - (nnheader-group-pathname group nnspool-spool-directory article)) - -(provide 'nnspool) - -;;; arch-tag: bdac8d27-2934-4eee-bad0-49e6b90c0d05 -;;; nnspool.el ends here diff --git a/xemacs-packages/gnus/lisp/nntp.el b/xemacs-packages/gnus/lisp/nntp.el deleted file mode 100644 index cea2921d..00000000 --- a/xemacs-packages/gnus/lisp/nntp.el +++ /dev/null @@ -1,1936 +0,0 @@ -;;; nntp.el --- nntp access for Gnus - -;; Copyright (C) 1987, 1988, 1989, 1990, 1992, 1993, -;; 1994, 1995, 1996, 1997, 1998, 2000, 2001, 2002, -;; 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published -;; by the Free Software Foundation; either version 3, or (at your -;; option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, -;; MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -(require 'nnheader) -(require 'nnoo) -(require 'gnus-util) - -(nnoo-declare nntp) - -(eval-when-compile (require 'cl)) - -(defgroup nntp nil - "NNTP access for Gnus." - :group 'gnus) - -(defvoo nntp-address nil - "Address of the physical nntp server.") - -(defvoo nntp-port-number "nntp" - "Port number on the physical nntp server.") - -(defvoo nntp-server-opened-hook '(nntp-send-mode-reader) - "*Hook used for sending commands to the server at startup. -The default value is `nntp-send-mode-reader', which makes an innd -server spawn an nnrpd server.") - -(defvoo nntp-authinfo-function 'nntp-send-authinfo - "Function used to send AUTHINFO to the server. -It is called with no parameters.") - -(defvoo nntp-server-action-alist - '(("nntpd 1\\.5\\.11t" - (remove-hook 'nntp-server-opened-hook 'nntp-send-mode-reader)) - ("NNRP server Netscape" - (setq nntp-server-list-active-group nil))) - "Alist of regexps to match on server types and actions to be taken. -For instance, if you want Gnus to beep every time you connect -to innd, you could say something like: - -\(setq nntp-server-action-alist - '((\"innd\" (ding)))) - -You probably don't want to do that, though.") - -(defvoo nntp-open-connection-function 'nntp-open-network-stream - "*Function used for connecting to a remote system. -It will be called with the buffer to output in as argument. - -Currently, five such functions are provided (please refer to their -respective doc string for more information), three of them establishing -direct connections to the nntp server, and two of them using an indirect -host. - -Direct connections: -- `nntp-open-network-stream' (the default), -- `nntp-open-ssl-stream', -- `nntp-open-tls-stream', -- `nntp-open-telnet-stream'. - -Indirect connections: -- `nntp-open-via-rlogin-and-telnet', -- `nntp-open-via-telnet-and-telnet'.") - -(defvoo nntp-never-echoes-commands nil - "*Non-nil means the nntp server never echoes commands. -It is reported that some nntps server doesn't echo commands. So, you -may want to set this to non-nil in the method for such a server setting -`nntp-open-connection-function' to `nntp-open-ssl-stream' for example. -Note that the `nntp-open-connection-functions-never-echo-commands' -variable overrides the nil value of this variable.") - -(defvoo nntp-open-connection-functions-never-echo-commands - '(nntp-open-network-stream) - "*List of functions that never echo commands. -Add or set a function which you set to `nntp-open-connection-function' -to this list if it does not echo commands. Note that a non-nil value -of the `nntp-never-echoes-commands' variable overrides this variable.") - -(defvoo nntp-pre-command nil - "*Pre-command to use with the various nntp-open-via-* methods. -This is where you would put \"runsocks\" or stuff like that.") - -(defvoo nntp-telnet-command "telnet" - "*Telnet command used to connect to the nntp server. -This command is used by the various nntp-open-via-* methods.") - -(defvoo nntp-telnet-switches '("-8") - "*Switches given to the telnet command `nntp-telnet-command'.") - -(defvoo nntp-end-of-line "\r\n" - "*String to use on the end of lines when talking to the NNTP server. -This is \"\\r\\n\" by default, but should be \"\\n\" when -using an indirect connection method (nntp-open-via-*).") - -(defvoo nntp-via-rlogin-command "rsh" - "*Rlogin command used to connect to an intermediate host. -This command is used by the `nntp-open-via-rlogin-and-telnet' method. -The default is \"rsh\", but \"ssh\" is a popular alternative.") - -(defvoo nntp-via-rlogin-command-switches nil - "*Switches given to the rlogin command `nntp-via-rlogin-command'. -If you use \"ssh\" for `nntp-via-rlogin-command', you may set this to -\(\"-C\") in order to compress all data connections, otherwise set this -to \(\"-t\" \"-e\" \"none\") or (\"-C\" \"-t\" \"-e\" \"none\") if the telnet -command requires a pseudo-tty allocation on an intermediate host.") - -(defvoo nntp-via-telnet-command "telnet" - "*Telnet command used to connect to an intermediate host. -This command is used by the `nntp-open-via-telnet-and-telnet' method.") - -(defvoo nntp-via-telnet-switches '("-8") - "*Switches given to the telnet command `nntp-via-telnet-command'.") - -(defvoo nntp-via-user-name nil - "*User name to log in on an intermediate host with. -This variable is used by the `nntp-open-via-telnet-and-telnet' method.") - -(defvoo nntp-via-user-password nil - "*Password to use to log in on an intermediate host with. -This variable is used by the `nntp-open-via-telnet-and-telnet' method.") - -(defvoo nntp-via-address nil - "*Address of an intermediate host to connect to. -This variable is used by the `nntp-open-via-rlogin-and-telnet' and -`nntp-open-via-telnet-and-telnet' methods.") - -(defvoo nntp-via-envuser nil - "*Whether both telnet client and server support the ENVIRON option. -If non-nil, there will be no prompt for a login name.") - -(defvoo nntp-via-shell-prompt "bash\\|\$ *\r?$\\|> *\r?" - "*Regular expression to match the shell prompt on an intermediate host. -This variable is used by the `nntp-open-via-telnet-and-telnet' method.") - -(defvoo nntp-large-newsgroup 50 - "*The number of articles which indicates a large newsgroup. -If the number of articles is greater than the value, verbose -messages will be shown to indicate the current status.") - -(defvoo nntp-maximum-request 400 - "*The maximum number of the requests sent to the NNTP server at one time. -If Emacs hangs up while retrieving headers, set the variable to a -lower value.") - -(defvoo nntp-nov-is-evil nil - "*If non-nil, nntp will never attempt to use XOVER when talking to the server.") - -(defvoo nntp-xover-commands '("XOVER" "XOVERVIEW") - "*List of strings that are used as commands to fetch NOV lines from a server. -The strings are tried in turn until a positive response is gotten. If -none of the commands are successful, nntp will just grab headers one -by one.") - -(defvoo nntp-nov-gap 5 - "*Maximum allowed gap between two articles. -If the gap between two consecutive articles is bigger than this -variable, split the XOVER request into two requests.") - -(defvoo nntp-xref-number-is-evil nil - "*If non-nil, Gnus never trusts article numbers in the Xref header. -Some news servers, e.g., ones running Diablo, run multiple engines -having the same articles but article numbers are not kept synchronized -between them. If you connect to such a server, set this to a non-nil -value, and Gnus never uses article numbers (that appear in the Xref -header and vary by which engine is chosen) to refer to articles.") - -(defvoo nntp-prepare-server-hook nil - "*Hook run before a server is opened. -If can be used to set up a server remotely, for instance. Say you -have an account at the machine \"other.machine\". This machine has -access to an NNTP server that you can't access locally. You could -then use this hook to rsh to the remote machine and start a proxy NNTP -server there that you can connect to. See also -`nntp-open-connection-function'") - -(defvoo nntp-coding-system-for-read 'binary - "*Coding system to read from NNTP.") - -(defvoo nntp-coding-system-for-write 'binary - "*Coding system to write to NNTP.") - -(defcustom nntp-authinfo-file "~/.authinfo" - ".netrc-like file that holds nntp authinfo passwords." - :group 'nntp - :type - '(choice file - (repeat :tag "Entries" - :menu-tag "Inline" - (list :format "%v" - :value ("" ("login" . "") ("password" . "")) - (string :tag "Host") - (checklist :inline t - (cons :format "%v" - (const :format "" "login") - (string :format "Login: %v")) - (cons :format "%v" - (const :format "" "password") - (string :format "Password: %v"))))))) - - - -(defvoo nntp-connection-timeout nil - "*Number of seconds to wait before an nntp connection times out. -If this variable is nil, which is the default, no timers are set. -NOTE: This variable is never seen to work in Emacs 20 and XEmacs 21.") - -(defvoo nntp-prepare-post-hook nil - "*Hook run just before posting an article. It is supposed to be used -to insert Cancel-Lock headers.") - -;;; Internal variables. - -(defvar nntp-record-commands nil - "*If non-nil, nntp will record all commands in the \"*nntp-log*\" buffer.") - -(defvar nntp-have-messaged nil) - -(defvar nntp-process-wait-for nil) -(defvar nntp-process-to-buffer nil) -(defvar nntp-process-callback nil) -(defvar nntp-process-decode nil) -(defvar nntp-process-start-point nil) -(defvar nntp-inside-change-function nil) -(defvoo nntp-last-command-time nil) -(defvoo nntp-last-command nil) -(defvoo nntp-authinfo-password nil) -(defvoo nntp-authinfo-user nil) - -(defvar nntp-connection-list nil) - -(defvoo nntp-server-type nil) -(defvoo nntp-connection-alist nil) -(defvoo nntp-status-string "") -(defconst nntp-version "nntp 5.0") -(defvoo nntp-inhibit-erase nil) -(defvoo nntp-inhibit-output nil) - -(defvoo nntp-server-xover 'try) -(defvoo nntp-server-list-active-group 'try) - -(defvar nntp-async-needs-kluge - (string-match "^GNU Emacs 20\\.3\\." (emacs-version)) - "*When non-nil, nntp will poll asynchronous connections -once a second. By default, this is turned on only for Emacs -20.3, which has a bug that breaks nntp's normal method of -noticing asynchronous data.") - -(defvar nntp-async-timer nil) -(defvar nntp-async-process-list nil) - -(defvar nntp-ssl-program - "openssl s_client -quiet -ssl3 -connect %s:%p" -"A string containing commands for SSL connections. -Within a string, %s is replaced with the server address and %p with -port number on server. The program should accept IMAP commands on -stdin and return responses to stdout.") - -(defvar nntp-authinfo-rejected nil -"A custom error condition used to report 'Authentication Rejected' errors. -Condition handlers that match just this condition ensure that the nntp -backend doesn't catch this error.") -(put 'nntp-authinfo-rejected 'error-conditions '(error nntp-authinfo-rejected)) -(put 'nntp-authinfo-rejected 'error-message "Authorization Rejected") - - - -;;; Internal functions. - -(defsubst nntp-send-string (process string) - "Send STRING to PROCESS." - ;; We need to store the time to provide timeouts, and - ;; to store the command so the we can replay the command - ;; if the server gives us an AUTHINFO challenge. - (setq nntp-last-command-time (current-time) - nntp-last-command string) - (when nntp-record-commands - (nntp-record-command string)) - (process-send-string process (concat string nntp-end-of-line)) - (or (memq (process-status process) '(open run)) - (nntp-report "Server closed connection"))) - -(defun nntp-record-command (string) - "Record the command STRING." - (save-excursion - (set-buffer (get-buffer-create "*nntp-log*")) - (goto-char (point-max)) - (let ((time (current-time))) - (insert (format-time-string "%Y%m%dT%H%M%S" time) - "." (format "%03d" (/ (nth 2 time) 1000)) - " " nntp-address " " string "\n")))) - -(defun nntp-report (&rest args) - "Report an error from the nntp backend. The first string in ARGS -can be a format string. For some commands, the failed command may be -retried once before actually displaying the error report." - - (when nntp-record-commands - (nntp-record-command "*** CALLED nntp-report ***")) - - (nnheader-report 'nntp args) - - (apply 'error args)) - -(defun nntp-report-1 (&rest args) - "Throws out to nntp-with-open-group-error so that the connection may -be restored and the command retried." - - (when nntp-record-commands - (nntp-record-command "*** CONNECTION LOST ***")) - - (throw 'nntp-with-open-group-error t)) - -(defsubst nntp-wait-for (process wait-for buffer &optional decode discard) - "Wait for WAIT-FOR to arrive from PROCESS." - (save-excursion - (set-buffer (process-buffer process)) - (goto-char (point-min)) - (while (and (or (not (memq (char-after (point)) '(?2 ?3 ?4 ?5))) - (looking-at "48[02]")) - (memq (process-status process) '(open run))) - (cond ((looking-at "480") - (nntp-handle-authinfo process)) - ((looking-at "482") - (nnheader-report 'nntp (get 'nntp-authinfo-rejected 'error-message)) - (signal 'nntp-authinfo-rejected nil)) - ((looking-at "^.*\n") - (delete-region (point) (progn (forward-line 1) (point))))) - (nntp-accept-process-output process) - (goto-char (point-min))) - (prog1 - (cond - ((looking-at "[45]") - (progn - (nntp-snarf-error-message) - nil)) - ((not (memq (process-status process) '(open run))) - (nntp-report "Server closed connection")) - (t - (goto-char (point-max)) - (let ((limit (point-min)) - response) - (while (not (re-search-backward wait-for limit t)) - (nntp-accept-process-output process) - ;; We assume that whatever we wait for is less than 1000 - ;; characters long. - (setq limit (max (- (point-max) 1000) (point-min))) - (goto-char (point-max))) - (setq response (match-string 0)) - (with-current-buffer nntp-server-buffer - (setq nntp-process-response response))) - (nntp-decode-text (not decode)) - (unless discard - (save-excursion - (set-buffer buffer) - (goto-char (point-max)) - (insert-buffer-substring (process-buffer process)) - ;; Nix out "nntp reading...." message. - (when nntp-have-messaged - (setq nntp-have-messaged nil) - (nnheader-message 5 "")))) - t)) - (unless discard - (erase-buffer))))) - -(defun nntp-kill-buffer (buffer) - (when (buffer-name buffer) - (kill-buffer buffer) - (nnheader-init-server-buffer))) - -(defsubst nntp-find-connection (buffer) - "Find the connection delivering to BUFFER." - (let ((alist nntp-connection-alist) - (buffer (if (stringp buffer) (get-buffer buffer) buffer)) - process entry) - (while (and alist (setq entry (pop alist))) - (when (eq buffer (cadr entry)) - (setq process (car entry) - alist nil))) - (when process - (if (memq (process-status process) '(open run)) - process - (nntp-kill-buffer (process-buffer process)) - (setq nntp-connection-alist (delq entry nntp-connection-alist)) - nil)))) - -(defsubst nntp-find-connection-entry (buffer) - "Return the entry for the connection to BUFFER." - (assq (nntp-find-connection buffer) nntp-connection-alist)) - -(defun nntp-find-connection-buffer (buffer) - "Return the process connection buffer tied to BUFFER." - (let ((process (nntp-find-connection buffer))) - (when process - (process-buffer process)))) - -(defsubst nntp-retrieve-data (command address port buffer - &optional wait-for callback decode) - "Use COMMAND to retrieve data into BUFFER from PORT on ADDRESS." - (let ((process (or (nntp-find-connection buffer) - (nntp-open-connection buffer)))) - (if process - (progn - (unless (or nntp-inhibit-erase nnheader-callback-function) - (save-excursion - (set-buffer (process-buffer process)) - (erase-buffer))) - (condition-case err - (progn - (when command - (nntp-send-string process command)) - (cond - ((eq callback 'ignore) - t) - ((and callback wait-for) - (nntp-async-wait process wait-for buffer decode callback) - t) - (wait-for - (nntp-wait-for process wait-for buffer decode)) - (t t))) - (nntp-authinfo-rejected - (signal 'nntp-authinfo-rejected (cdr err))) - (error - (nnheader-report 'nntp "Couldn't open connection to %s: %s" - address err)) - (quit - (message "Quit retrieving data from nntp") - (signal 'quit nil) - nil))) - (nnheader-report 'nntp "Couldn't open connection to %s" address)))) - -(defsubst nntp-send-command (wait-for &rest strings) - "Send STRINGS to server and wait until WAIT-FOR returns." - (when (and (not nnheader-callback-function) - (not nntp-inhibit-output)) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer))) - (let* ((command (mapconcat 'identity strings " ")) - (process (nntp-find-connection nntp-server-buffer)) - (buffer (and process (process-buffer process))) - (pos (and buffer (with-current-buffer buffer (point))))) - (if process - (prog1 - (nntp-retrieve-data command - nntp-address nntp-port-number - nntp-server-buffer - wait-for nnheader-callback-function) - ;; If nothing to wait for, still remove possibly echo'ed commands. - ;; We don't have echoes if `nntp-never-echoes-commands' is non-nil - ;; or the value of `nntp-open-connection-function' is in - ;; `nntp-open-connection-functions-never-echo-commands', so we - ;; skip this in that cases. - (unless (or wait-for - nntp-never-echoes-commands - (memq - nntp-open-connection-function - nntp-open-connection-functions-never-echo-commands)) - (nntp-accept-response) - (save-excursion - (set-buffer buffer) - (goto-char pos) - (if (looking-at (regexp-quote command)) - (delete-region pos (progn (forward-line 1) - (gnus-point-at-bol)))) - ))) - (nnheader-report 'nntp "Couldn't open connection to %s." - nntp-address)))) - -(defun nntp-send-command-nodelete (wait-for &rest strings) - "Send STRINGS to server and wait until WAIT-FOR returns." - (let* ((command (mapconcat 'identity strings " ")) - (process (nntp-find-connection nntp-server-buffer)) - (buffer (and process (process-buffer process))) - (pos (and buffer (with-current-buffer buffer (point))))) - (if process - (prog1 - (nntp-retrieve-data command - nntp-address nntp-port-number - nntp-server-buffer - wait-for nnheader-callback-function) - ;; If nothing to wait for, still remove possibly echo'ed commands - (unless wait-for - (nntp-accept-response) - (save-excursion - (set-buffer buffer) - (goto-char pos) - (if (looking-at (regexp-quote command)) - (delete-region pos (progn (forward-line 1) - (gnus-point-at-bol))))))) - (nnheader-report 'nntp "Couldn't open connection to %s." - nntp-address)))) - -(defun nntp-send-command-and-decode (wait-for &rest strings) - "Send STRINGS to server and wait until WAIT-FOR returns." - (when (and (not nnheader-callback-function) - (not nntp-inhibit-output)) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer))) - (let* ((command (mapconcat 'identity strings " ")) - (process (nntp-find-connection nntp-server-buffer)) - (buffer (and process (process-buffer process))) - (pos (and buffer (with-current-buffer buffer (point))))) - (if process - (prog1 - (nntp-retrieve-data command - nntp-address nntp-port-number - nntp-server-buffer - wait-for nnheader-callback-function t) - ;; If nothing to wait for, still remove possibly echo'ed commands - (unless wait-for - (nntp-accept-response) - (save-excursion - (set-buffer buffer) - (goto-char pos) - (if (looking-at (regexp-quote command)) - (delete-region pos (progn (forward-line 1) (gnus-point-at-bol)))) - ))) - (nnheader-report 'nntp "Couldn't open connection to %s." - nntp-address)))) - - -(defun nntp-send-buffer (wait-for) - "Send the current buffer to server and wait until WAIT-FOR returns." - (when (and (not nnheader-callback-function) - (not nntp-inhibit-output)) - (save-excursion - (set-buffer (nntp-find-connection-buffer nntp-server-buffer)) - (erase-buffer))) - (nntp-encode-text) - (mm-with-unibyte-current-buffer - ;; Some encoded unicode text contains character 0x80-0x9f e.g. Euro. - (process-send-region (nntp-find-connection nntp-server-buffer) - (point-min) (point-max))) - (nntp-retrieve-data - nil nntp-address nntp-port-number nntp-server-buffer - wait-for nnheader-callback-function)) - - - -;;; Interface functions. - -(nnoo-define-basics nntp) - -(defsubst nntp-next-result-arrived-p () - (cond - ;; A result that starts with a 2xx code is terminated by - ;; a line with only a "." on it. - ((eq (char-after) ?2) - (if (re-search-forward "\n\\.\r?\n" nil t) - t - nil)) - ;; A result that starts with a 3xx or 4xx code is terminated - ;; by a newline. - ((looking-at "[34]") - (if (search-forward "\n" nil t) - t - nil)) - ;; No result here. - (t - nil))) - -(eval-when-compile - (defvar nntp-with-open-group-internal nil) - (defvar nntp-report-n nil)) - -(defmacro nntp-with-open-group (group server &optional connectionless &rest forms) - "Protect against servers that don't like clients that keep idle connections opens. -The problem being that these servers may either close a connection or -simply ignore any further requests on a connection. Closed -connections are not detected until accept-process-output has updated -the process-status. Dropped connections are not detected until the -connection timeouts (which may be several minutes) or -nntp-connection-timeout has expired. When these occur -nntp-with-open-group, opens a new connection then re-issues the NNTP -command whose response triggered the error." - (when (and (listp connectionless) - (not (eq connectionless nil))) - (setq forms (cons connectionless forms) - connectionless nil)) - `(letf ((nntp-report-n (symbol-function 'nntp-report)) - ((symbol-function 'nntp-report) (symbol-function 'nntp-report-1)) - (nntp-with-open-group-internal nil)) - (while (catch 'nntp-with-open-group-error - ;; Open the connection to the server - ;; NOTE: Existing connections are NOT tested. - (nntp-possibly-change-group ,group ,server ,connectionless) - - (let ((timer - (and nntp-connection-timeout - (nnheader-run-at-time - nntp-connection-timeout nil - '(lambda () - (let ((process (nntp-find-connection - nntp-server-buffer)) - (buffer (and process - (process-buffer process)))) - ;; When I an able to identify the - ;; connection to the server AND I've - ;; received NO reponse for - ;; nntp-connection-timeout seconds. - (when (and buffer (eq 0 (buffer-size buffer))) - ;; Close the connection. Take no - ;; other action as the accept input - ;; code will handle the closed - ;; connection. - (nntp-kill-buffer buffer)))))))) - (unwind-protect - (setq nntp-with-open-group-internal - (condition-case nil - (progn ,@forms) - (quit - (nntp-close-server) - (signal 'quit nil)))) - (when timer - (nnheader-cancel-timer timer))) - nil)) - (setf (symbol-function 'nntp-report) nntp-report-n)) - nntp-with-open-group-internal)) - -(deffoo nntp-retrieve-headers (articles &optional group server fetch-old) - "Retrieve the headers of ARTICLES." - (nntp-with-open-group - group server - (save-excursion - (set-buffer (nntp-find-connection-buffer nntp-server-buffer)) - (erase-buffer) - (if (and (not gnus-nov-is-evil) - (not nntp-nov-is-evil) - (nntp-retrieve-headers-with-xover articles fetch-old)) - ;; We successfully retrieved the headers via XOVER. - 'nov - ;; XOVER didn't work, so we do it the hard, slow and inefficient - ;; way. - (let ((number (length articles)) - (articles articles) - (count 0) - (received 0) - (last-point (point-min)) - (buf (nntp-find-connection-buffer nntp-server-buffer)) - (nntp-inhibit-erase t) - article) - ;; Send HEAD commands. - (while (setq article (pop articles)) - (nntp-send-command - nil - "HEAD" (if (numberp article) - (int-to-string article) - ;; `articles' is either a list of article numbers - ;; or a list of article IDs. - article)) - (incf count) - ;; Every 400 requests we have to read the stream in - ;; order to avoid deadlocks. - (when (or (null articles) ;All requests have been sent. - (zerop (% count nntp-maximum-request))) - (nntp-accept-response) - (while (progn - (set-buffer buf) - (goto-char last-point) - ;; Count replies. - (while (nntp-next-result-arrived-p) - (setq last-point (point)) - (incf received)) - (< received count)) - ;; If number of headers is greater than 100, give - ;; informative messages. - (and (numberp nntp-large-newsgroup) - (> number nntp-large-newsgroup) - (zerop (% received 20)) - (nnheader-message 6 "NNTP: Receiving headers... %d%%" - (/ (* received 100) number))) - (nntp-accept-response)))) - (and (numberp nntp-large-newsgroup) - (> number nntp-large-newsgroup) - (nnheader-message 6 "NNTP: Receiving headers...done")) - - ;; Now all of replies are received. Fold continuation lines. - (nnheader-fold-continuation-lines) - ;; Remove all "\r"'s. - (nnheader-strip-cr) - (copy-to-buffer nntp-server-buffer (point-min) (point-max)) - 'headers))))) - -(deffoo nntp-retrieve-groups (groups &optional server) - "Retrieve group info on GROUPS." - (nntp-with-open-group - nil server - (when (nntp-find-connection-buffer nntp-server-buffer) - (catch 'done - (save-excursion - ;; Erase nntp-server-buffer before nntp-inhibit-erase. - (set-buffer nntp-server-buffer) - (erase-buffer) - (set-buffer (nntp-find-connection-buffer nntp-server-buffer)) - ;; The first time this is run, this variable is `try'. So we - ;; try. - (when (eq nntp-server-list-active-group 'try) - (nntp-try-list-active (car groups))) - (erase-buffer) - (let ((count 0) - (groups groups) - (received 0) - (last-point (point-min)) - (nntp-inhibit-erase t) - (buf (nntp-find-connection-buffer nntp-server-buffer)) - (command (if nntp-server-list-active-group - "LIST ACTIVE" "GROUP"))) - (while groups - ;; Timeout may have killed the buffer. - (unless (gnus-buffer-live-p buf) - (nnheader-report 'nntp "Connection to %s is closed." server) - (throw 'done nil)) - ;; Send the command to the server. - (nntp-send-command nil command (pop groups)) - (incf count) - ;; Every 400 requests we have to read the stream in - ;; order to avoid deadlocks. - (when (or (null groups) ;All requests have been sent. - (zerop (% count nntp-maximum-request))) - (nntp-accept-response) - (while (and (gnus-buffer-live-p buf) - (progn - ;; Search `blue moon' in this file for the - ;; reason why set-buffer here. - (set-buffer buf) - (goto-char last-point) - ;; Count replies. - (while (re-search-forward "^[0-9]" nil t) - (incf received)) - (setq last-point (point)) - (< received count))) - (nntp-accept-response)))) - - ;; Wait for the reply from the final command. - (unless (gnus-buffer-live-p buf) - (nnheader-report 'nntp "Connection to %s is closed." server) - (throw 'done nil)) - (set-buffer buf) - (goto-char (point-max)) - (re-search-backward "^[0-9]" nil t) - (when (looking-at "^[23]") - (while (and (gnus-buffer-live-p buf) - (progn - (set-buffer buf) - (goto-char (point-max)) - (if (not nntp-server-list-active-group) - (not (re-search-backward "\r?\n" - (- (point) 3) t)) - (not (re-search-backward "^\\.\r?\n" - (- (point) 4) t))))) - (nntp-accept-response))) - - ;; Now all replies are received. We remove CRs. - (unless (gnus-buffer-live-p buf) - (nnheader-report 'nntp "Connection to %s is closed." server) - (throw 'done nil)) - (set-buffer buf) - (goto-char (point-min)) - (while (search-forward "\r" nil t) - (replace-match "" t t)) - - (if (not nntp-server-list-active-group) - (progn - (copy-to-buffer nntp-server-buffer (point-min) (point-max)) - 'group) - ;; We have read active entries, so we just delete the - ;; superfluous gunk. - (goto-char (point-min)) - (while (re-search-forward "^[.2-5]" nil t) - (delete-region (match-beginning 0) - (progn (forward-line 1) (point)))) - (copy-to-buffer nntp-server-buffer (point-min) (point-max)) - 'active))))))) - -(deffoo nntp-retrieve-articles (articles &optional group server) - (nntp-with-open-group - group server - (save-excursion - (let ((number (length articles)) - (articles articles) - (count 0) - (received 0) - (last-point (point-min)) - (buf (nntp-find-connection-buffer nntp-server-buffer)) - (nntp-inhibit-erase t) - (map (apply 'vector articles)) - (point 1) - article) - (set-buffer buf) - (erase-buffer) - ;; Send ARTICLE command. - (while (setq article (pop articles)) - (nntp-send-command - nil - "ARTICLE" (if (numberp article) - (int-to-string article) - ;; `articles' is either a list of article numbers - ;; or a list of article IDs. - article)) - (incf count) - ;; Every 400 requests we have to read the stream in - ;; order to avoid deadlocks. - (when (or (null articles) ;All requests have been sent. - (zerop (% count nntp-maximum-request))) - (nntp-accept-response) - (while (progn - (set-buffer buf) - (goto-char last-point) - ;; Count replies. - (while (nntp-next-result-arrived-p) - (aset map received (cons (aref map received) (point))) - (setq last-point (point)) - (incf received)) - (< received count)) - ;; If number of headers is greater than 100, give - ;; informative messages. - (and (numberp nntp-large-newsgroup) - (> number nntp-large-newsgroup) - (zerop (% received 20)) - (nnheader-message 6 "NNTP: Receiving articles... %d%%" - (/ (* received 100) number))) - (nntp-accept-response)))) - (and (numberp nntp-large-newsgroup) - (> number nntp-large-newsgroup) - (nnheader-message 6 "NNTP: Receiving articles...done")) - - ;; Now we have all the responses. We go through the results, - ;; wash it and copy it over to the server buffer. - (set-buffer nntp-server-buffer) - (erase-buffer) - (setq last-point (point-min)) - (mapcar - (lambda (entry) - (narrow-to-region - (setq point (goto-char (point-max))) - (progn - (insert-buffer-substring buf last-point (cdr entry)) - (point-max))) - (setq last-point (cdr entry)) - (nntp-decode-text) - (widen) - (cons (car entry) point)) - map))))) - -(defun nntp-try-list-active (group) - (nntp-list-active-group group) - (save-excursion - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (cond ((or (eobp) - (looking-at "5[0-9]+")) - (setq nntp-server-list-active-group nil)) - (t - (setq nntp-server-list-active-group t))))) - -(deffoo nntp-list-active-group (group &optional server) - "Return the active info on GROUP (which can be a regexp)." - (nntp-with-open-group - nil server - (nntp-send-command "^\\.*\r?\n" "LIST ACTIVE" group))) - -(deffoo nntp-request-group-articles (group &optional server) - "Return the list of existing articles in GROUP." - (nntp-with-open-group - nil server - (nntp-send-command "^\\.*\r?\n" "LISTGROUP" group))) - -(deffoo nntp-request-article (article &optional group server buffer command) - (nntp-with-open-group - group server - (when (nntp-send-command-and-decode - "\r?\n\\.\r?\n" "ARTICLE" - (if (numberp article) (int-to-string article) article)) - (if (and buffer - (not (equal buffer nntp-server-buffer))) - (save-excursion - (set-buffer nntp-server-buffer) - (copy-to-buffer buffer (point-min) (point-max)) - (nntp-find-group-and-number group)) - (nntp-find-group-and-number group))))) - -(deffoo nntp-request-head (article &optional group server) - (nntp-with-open-group - group server - (when (nntp-send-command - "\r?\n\\.\r?\n" "HEAD" - (if (numberp article) (int-to-string article) article)) - (prog1 - (nntp-find-group-and-number group) - (nntp-decode-text))))) - -(deffoo nntp-request-body (article &optional group server) - (nntp-with-open-group - group server - (nntp-send-command-and-decode - "\r?\n\\.\r?\n" "BODY" - (if (numberp article) (int-to-string article) article)))) - -(deffoo nntp-request-group (group &optional server dont-check) - (nntp-with-open-group - nil server - (when (nntp-send-command "^[245].*\n" "GROUP" group) - (let ((entry (nntp-find-connection-entry nntp-server-buffer))) - (setcar (cddr entry) group))))) - -(deffoo nntp-close-group (group &optional server) - t) - -(deffoo nntp-server-opened (&optional server) - "Say whether a connection to SERVER has been opened." - (and (nnoo-current-server-p 'nntp server) - nntp-server-buffer - (gnus-buffer-live-p nntp-server-buffer) - (nntp-find-connection nntp-server-buffer))) - -(deffoo nntp-open-server (server &optional defs connectionless) - (nnheader-init-server-buffer) - (if (nntp-server-opened server) - t - (when (or (stringp (car defs)) - (numberp (car defs))) - (setq defs (cons (list 'nntp-port-number (car defs)) (cdr defs)))) - (unless (assq 'nntp-address defs) - (setq defs (append defs (list (list 'nntp-address server))))) - (nnoo-change-server 'nntp server defs) - (unless connectionless - (or (nntp-find-connection nntp-server-buffer) - (nntp-open-connection nntp-server-buffer))))) - -(deffoo nntp-close-server (&optional server) - (nntp-possibly-change-group nil server t) - (let ((process (nntp-find-connection nntp-server-buffer))) - (while process - (when (memq (process-status process) '(open run)) - (ignore-errors - (nntp-send-string process "QUIT") - (unless (eq nntp-open-connection-function 'nntp-open-network-stream) - ;; Ok, this is evil, but when using telnet and stuff - ;; as the connection method, it's important that the - ;; QUIT command actually is sent out before we kill - ;; the process. - (sleep-for 1)))) - (nntp-kill-buffer (process-buffer process)) - (setq process (car (pop nntp-connection-alist)))) - (nnoo-close-server 'nntp))) - -(deffoo nntp-request-close () - (let (process) - (while (setq process (pop nntp-connection-list)) - (when (memq (process-status process) '(open run)) - (ignore-errors - (nntp-send-string process "QUIT") - (unless (eq nntp-open-connection-function 'nntp-open-network-stream) - ;; Ok, this is evil, but when using telnet and stuff - ;; as the connection method, it's important that the - ;; QUIT command actually is sent out before we kill - ;; the process. - (sleep-for 1)))) - (nntp-kill-buffer (process-buffer process))))) - -(deffoo nntp-request-list (&optional server) - (nntp-with-open-group - nil server - (nntp-send-command-and-decode "\r?\n\\.\r?\n" "LIST"))) - -(deffoo nntp-request-list-newsgroups (&optional server) - (nntp-with-open-group - nil server - (nntp-send-command "\r?\n\\.\r?\n" "LIST NEWSGROUPS"))) - -(deffoo nntp-request-newgroups (date &optional server) - (nntp-with-open-group - nil server - (save-excursion - (set-buffer nntp-server-buffer) - (let* ((time (date-to-time date)) - (ls (- (cadr time) (nth 8 (decode-time time))))) - (cond ((< ls 0) - (setcar time (1- (car time))) - (setcar (cdr time) (+ ls 65536))) - ((>= ls 65536) - (setcar time (1+ (car time))) - (setcar (cdr time) (- ls 65536))) - (t - (setcar (cdr time) ls))) - (prog1 - (nntp-send-command - "^\\.\r?\n" "NEWGROUPS" - (format-time-string "%y%m%d %H%M%S" time) - "GMT") - (nntp-decode-text)))))) - -(deffoo nntp-request-post (&optional server) - (nntp-with-open-group - nil server - (when (nntp-send-command "^[23].*\r?\n" "POST") - (let ((response (with-current-buffer nntp-server-buffer - nntp-process-response)) - server-id) - (when (and response - (string-match "^[23].*\\(<[^\t\n @<>]+@[^\t\n @<>]+>\\)" - response)) - (setq server-id (match-string 1 response)) - (narrow-to-region (goto-char (point-min)) - (if (search-forward "\n\n" nil t) - (1- (point)) - (point-max))) - (unless (mail-fetch-field "Message-ID") - (goto-char (point-min)) - (insert "Message-ID: " server-id "\n")) - (widen)) - (run-hooks 'nntp-prepare-post-hook) - (nntp-send-buffer "^[23].*\n"))))) - -(deffoo nntp-request-type (group article) - 'news) - -(deffoo nntp-asynchronous-p () - t) - -;;; Hooky functions. - -(defun nntp-send-mode-reader () - "Send the MODE READER command to the nntp server. -This function is supposed to be called from `nntp-server-opened-hook'. -It will make innd servers spawn an nnrpd process to allow actual article -reading." - (nntp-send-command "^.*\n" "MODE READER")) - -(defun nntp-send-authinfo (&optional send-if-force) - "Send the AUTHINFO to the nntp server. -It will look in the \"~/.authinfo\" file for matching entries. If -nothing suitable is found there, it will prompt for a user name -and a password. - -If SEND-IF-FORCE, only send authinfo to the server if the -.authinfo file has the FORCE token." - (let* ((list (gnus-parse-netrc nntp-authinfo-file)) - (alist (gnus-netrc-machine list nntp-address "nntp")) - (force (gnus-netrc-get alist "force")) - (user (or (gnus-netrc-get alist "login") nntp-authinfo-user)) - (passwd (gnus-netrc-get alist "password"))) - (when (or (not send-if-force) - force) - (unless user - (setq user (read-string (format "NNTP (%s) user name: " nntp-address)) - nntp-authinfo-user user)) - (unless (member user '(nil "")) - (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" user) - (when t ;???Should check if AUTHINFO succeeded - (nntp-send-command - "^2.*\r?\n" "AUTHINFO PASS" - (or passwd - nntp-authinfo-password - (setq nntp-authinfo-password - (read-passwd (format "NNTP (%s@%s) password: " - user nntp-address)))))))))) - -(defun nntp-send-nosy-authinfo () - "Send the AUTHINFO to the nntp server." - (let ((user (read-string (format "NNTP (%s) user name: " nntp-address)))) - (unless (member user '(nil "")) - (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" user) - (when t ;???Should check if AUTHINFO succeeded - (nntp-send-command "^2.*\r?\n" "AUTHINFO PASS" - (read-passwd (format "NNTP (%s@%s) password: " - user nntp-address))))))) - -(defun nntp-send-authinfo-from-file () - "Send the AUTHINFO to the nntp server. - -The authinfo login name is taken from the user's login name and the -password contained in '~/.nntp-authinfo'." - (when (file-exists-p "~/.nntp-authinfo") - (with-temp-buffer - (insert-file-contents "~/.nntp-authinfo") - (goto-char (point-min)) - (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" (user-login-name)) - (nntp-send-command - "^2.*\r?\n" "AUTHINFO PASS" - (buffer-substring (point) (gnus-point-at-eol)))))) - -;;; Internal functions. - -(defun nntp-handle-authinfo (process) - "Take care of an authinfo response from the server." - (let ((last nntp-last-command)) - (funcall nntp-authinfo-function) - ;; We have to re-send the function that was interrupted by - ;; the authinfo request. - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer)) - (nntp-send-string process last))) - -(defun nntp-make-process-buffer (buffer) - "Create a new, fresh buffer usable for nntp process connections." - (save-excursion - (set-buffer - (generate-new-buffer - (format " *server %s %s %s*" - nntp-address nntp-port-number - (gnus-buffer-exists-p buffer)))) - (mm-enable-multibyte) - (set (make-local-variable 'after-change-functions) nil) - (set (make-local-variable 'nntp-process-wait-for) nil) - (set (make-local-variable 'nntp-process-callback) nil) - (set (make-local-variable 'nntp-process-to-buffer) nil) - (set (make-local-variable 'nntp-process-start-point) nil) - (set (make-local-variable 'nntp-process-decode) nil) - (current-buffer))) - -(defun nntp-open-connection (buffer) - "Open a connection to PORT on ADDRESS delivering output to BUFFER." - (run-hooks 'nntp-prepare-server-hook) - (let* ((pbuffer (nntp-make-process-buffer buffer)) - (timer - (and nntp-connection-timeout - (nnheader-run-at-time - nntp-connection-timeout nil - `(lambda () - (nntp-kill-buffer ,pbuffer))))) - (process - (condition-case () - (let ((coding-system-for-read nntp-coding-system-for-read) - (coding-system-for-write nntp-coding-system-for-write)) - (funcall nntp-open-connection-function pbuffer)) - (error nil) - (quit - (message "Quit opening connection") - (nntp-kill-buffer pbuffer) - (signal 'quit nil) - nil)))) - (when timer - (nnheader-cancel-timer timer)) - (unless process - (nntp-kill-buffer pbuffer)) - (when (and (buffer-name pbuffer) - process) - (gnus-set-process-query-on-exit-flag process nil) - (if (and (nntp-wait-for process "^2.*\n" buffer nil t) - (memq (process-status process) '(open run))) - (prog1 - (caar (push (list process buffer nil) nntp-connection-alist)) - (push process nntp-connection-list) - (save-excursion - (set-buffer pbuffer) - (nntp-read-server-type) - (erase-buffer) - (set-buffer nntp-server-buffer) - (let ((nnheader-callback-function nil)) - (run-hooks 'nntp-server-opened-hook) - (nntp-send-authinfo t)))) - (nntp-kill-buffer (process-buffer process)) - nil)))) - -(defun nntp-open-network-stream (buffer) - (open-network-stream "nntpd" buffer nntp-address nntp-port-number)) - -(eval-and-compile - (autoload 'format-spec "format-spec") - (autoload 'format-spec-make "format-spec") - (autoload 'open-tls-stream "tls")) - -(defun nntp-open-ssl-stream (buffer) - (let* ((process-connection-type nil) - (proc (start-process "nntpd" buffer - shell-file-name - shell-command-switch - (format-spec nntp-ssl-program - (format-spec-make - ?s nntp-address - ?p nntp-port-number))))) - (gnus-set-process-query-on-exit-flag proc nil) - (save-excursion - (set-buffer buffer) - (let ((nntp-connection-alist (list proc buffer nil))) - (nntp-wait-for-string "^\r*20[01]")) - (beginning-of-line) - (delete-region (point-min) (point)) - proc))) - -(defun nntp-open-tls-stream (buffer) - (let ((proc (open-tls-stream "nntpd" buffer nntp-address nntp-port-number))) - (gnus-set-process-query-on-exit-flag proc nil) - (save-excursion - (set-buffer buffer) - (let ((nntp-connection-alist (list proc buffer nil))) - (nntp-wait-for-string "^\r*20[01]")) - (beginning-of-line) - (delete-region (point-min) (point)) - proc))) - -(defun nntp-read-server-type () - "Find out what the name of the server we have connected to is." - ;; Wait for the status string to arrive. - (setq nntp-server-type (buffer-string)) - (let ((alist nntp-server-action-alist) - (case-fold-search t) - entry) - ;; Run server-specific commands. - (while alist - (setq entry (pop alist)) - (when (string-match (car entry) nntp-server-type) - (if (and (listp (cadr entry)) - (not (eq 'lambda (caadr entry)))) - (eval (cadr entry)) - (funcall (cadr entry))))))) - -(defun nntp-async-wait (process wait-for buffer decode callback) - (save-excursion - (set-buffer (process-buffer process)) - (unless nntp-inside-change-function - (erase-buffer)) - (setq nntp-process-wait-for wait-for - nntp-process-to-buffer buffer - nntp-process-decode decode - nntp-process-callback callback - nntp-process-start-point (point-max)) - (setq after-change-functions '(nntp-after-change-function)) - (if nntp-async-needs-kluge - (nntp-async-kluge process)))) - -(defun nntp-async-kluge (process) - ;; emacs 20.3 bug: process output with encoding 'binary - ;; doesn't trigger after-change-functions. - (unless nntp-async-timer - (setq nntp-async-timer - (nnheader-run-at-time 1 1 'nntp-async-timer-handler))) - (add-to-list 'nntp-async-process-list process)) - -(defun nntp-async-timer-handler () - (mapcar - (lambda (proc) - (if (memq (process-status proc) '(open run)) - (nntp-async-trigger proc) - (nntp-async-stop proc))) - nntp-async-process-list)) - -(defun nntp-async-stop (proc) - (setq nntp-async-process-list (delq proc nntp-async-process-list)) - (when (and nntp-async-timer (not nntp-async-process-list)) - (nnheader-cancel-timer nntp-async-timer) - (setq nntp-async-timer nil))) - -(defun nntp-after-change-function (beg end len) - (unwind-protect - ;; we only care about insertions at eob - (when (and (eq 0 len) (eq (point-max) end)) - (save-match-data - (let ((proc (get-buffer-process (current-buffer)))) - (when proc - (nntp-async-trigger proc))))) - ;; any throw from after-change-functions will leave it - ;; set to nil. so we reset it here, if necessary. - (when quit-flag - (setq after-change-functions '(nntp-after-change-function))))) - -(defun nntp-async-trigger (process) - (save-excursion - (set-buffer (process-buffer process)) - (when nntp-process-callback - ;; do we have an error message? - (goto-char nntp-process-start-point) - (if (memq (following-char) '(?4 ?5)) - ;; wants credentials? - (if (looking-at "480") - (nntp-handle-authinfo process) - ;; report error message. - (nntp-snarf-error-message) - (nntp-do-callback nil)) - - ;; got what we expect? - (goto-char (point-max)) - (when (re-search-backward - nntp-process-wait-for nntp-process-start-point t) - (let ((response (match-string 0))) - (with-current-buffer nntp-server-buffer - (setq nntp-process-response response))) - (nntp-async-stop process) - ;; convert it. - (when (gnus-buffer-exists-p nntp-process-to-buffer) - (let ((buf (current-buffer)) - (start nntp-process-start-point) - (decode nntp-process-decode)) - (save-excursion - (set-buffer nntp-process-to-buffer) - (goto-char (point-max)) - (save-restriction - (narrow-to-region (point) (point)) - (insert-buffer-substring buf start) - (when decode - (nntp-decode-text)))))) - ;; report it. - (goto-char (point-max)) - (nntp-do-callback - (buffer-name (get-buffer nntp-process-to-buffer)))))))) - -(defun nntp-do-callback (arg) - (let ((callback nntp-process-callback) - (nntp-inside-change-function t)) - (setq nntp-process-callback nil) - (funcall callback arg))) - -(defun nntp-snarf-error-message () - "Save the error message in the current buffer." - (let ((message (buffer-string))) - (while (string-match "[\r\n]+" message) - (setq message (replace-match " " t t message))) - (nnheader-report 'nntp message) - message)) - -(defun nntp-accept-process-output (process) - "Wait for output from PROCESS and message some dots." - (save-excursion - (set-buffer (or (nntp-find-connection-buffer nntp-server-buffer) - nntp-server-buffer)) - (let ((len (/ (buffer-size) 1024)) - message-log-max) - (unless (< len 10) - (setq nntp-have-messaged t) - (nnheader-message 7 "nntp read: %dk" len))) - (nnheader-accept-process-output process) - ;; accept-process-output may update status of process to indicate - ;; that the server has closed the connection. This MUST be - ;; handled here as the buffer restored by the save-excursion may - ;; be the process's former output buffer (i.e. now killed) - (or (and process - (memq (process-status process) '(open run))) - (nntp-report "Server closed connection")))) - -(defun nntp-accept-response () - "Wait for output from the process that outputs to BUFFER." - (nntp-accept-process-output (nntp-find-connection nntp-server-buffer))) - -(defun nntp-possibly-change-group (group server &optional connectionless) - (let ((nnheader-callback-function nil)) - (when server - (or (nntp-server-opened server) - (nntp-open-server server nil connectionless))) - - (unless connectionless - (or (nntp-find-connection nntp-server-buffer) - (nntp-open-connection nntp-server-buffer)))) - - (when group - (let ((entry (nntp-find-connection-entry nntp-server-buffer))) - (cond ((not entry) - (nntp-report "Server closed connection")) - ((not (equal group (caddr entry))) - (save-excursion - (set-buffer (process-buffer (car entry))) - (erase-buffer) - (nntp-send-command "^[245].*\n" "GROUP" group) - (setcar (cddr entry) group) - (erase-buffer) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer)))))))) - -(defun nntp-decode-text (&optional cr-only) - "Decode the text in the current buffer." - (goto-char (point-min)) - (while (search-forward "\r" nil t) - (delete-char -1)) - (unless cr-only - ;; Remove trailing ".\n" end-of-transfer marker. - (goto-char (point-max)) - (forward-line -1) - (when (looking-at ".\n") - (delete-char 2)) - ;; Delete status line. - (goto-char (point-min)) - (while (looking-at "[1-5][0-9][0-9] .*\n") - ;; For some unknown reason, there is more than one status line. - (delete-region (point) (progn (forward-line 1) (point)))) - ;; Remove "." -> ".." encoding. - (while (search-forward "\n.." nil t) - (delete-char -1)))) - -(defun nntp-encode-text () - "Encode the text in the current buffer." - (save-excursion - ;; Replace "." at beginning of line with "..". - (goto-char (point-min)) - (while (re-search-forward "^\\." nil t) - (insert ".")) - (goto-char (point-max)) - ;; Insert newline at the end of the buffer. - (unless (bolp) - (insert "\n")) - ;; Insert `.' at end of buffer (end of text mark). - (goto-char (point-max)) - (insert ".\n") - (goto-char (point-min)) - (while (not (eobp)) - (end-of-line) - (delete-char 1) - (insert nntp-end-of-line)))) - -(defun nntp-retrieve-headers-with-xover (articles &optional fetch-old) - (set-buffer nntp-server-buffer) - (erase-buffer) - (cond - - ;; This server does not talk NOV. - ((not nntp-server-xover) - nil) - - ;; We don't care about gaps. - ((or (not nntp-nov-gap) - fetch-old) - (nntp-send-xover-command - (if fetch-old - (if (numberp fetch-old) - (max 1 (- (car articles) fetch-old)) - 1) - (car articles)) - (car (last articles)) 'wait) - - (goto-char (point-min)) - (when (looking-at "[1-5][0-9][0-9] .*\n") - (delete-region (point) (progn (forward-line 1) (point)))) - (while (search-forward "\r" nil t) - (replace-match "" t t)) - (goto-char (point-max)) - (forward-line -1) - (when (looking-at "\\.") - (delete-region (point) (progn (forward-line 1) (point))))) - - ;; We do it the hard way. For each gap, an XOVER command is sent - ;; to the server. We do not wait for a reply from the server, we - ;; just send them off as fast as we can. That means that we have - ;; to count the number of responses we get back to find out when we - ;; have gotten all we asked for. - ((numberp nntp-nov-gap) - (let ((count 0) - (received 0) - last-point - in-process-buffer-p - (buf nntp-server-buffer) - (process-buffer (nntp-find-connection-buffer nntp-server-buffer)) - first last status) - ;; We have to check `nntp-server-xover'. If it gets set to nil, - ;; that means that the server does not understand XOVER, but we - ;; won't know that until we try. - (while (and nntp-server-xover articles) - (setq first (car articles)) - ;; Search forward until we find a gap, or until we run out of - ;; articles. - (while (and (cdr articles) - (< (- (nth 1 articles) (car articles)) nntp-nov-gap)) - (setq articles (cdr articles))) - - (setq in-process-buffer-p (stringp nntp-server-xover)) - (nntp-send-xover-command first (setq last (car articles))) - (setq articles (cdr articles)) - - (when (and nntp-server-xover in-process-buffer-p) - ;; Don't count tried request. - (setq count (1+ count)) - - ;; Every 400 requests we have to read the stream in - ;; order to avoid deadlocks. - (when (or (null articles) ;All requests have been sent. - (= 1 (% count nntp-maximum-request))) - - (nntp-accept-response) - ;; On some Emacs versions the preceding function has a - ;; tendency to change the buffer. Perhaps. It's quite - ;; difficult to reproduce, because it only seems to happen - ;; once in a blue moon. - (set-buffer process-buffer) - (while (progn - (goto-char (or last-point (point-min))) - ;; Count replies. - (while (re-search-forward "^\\([0-9][0-9][0-9]\\) .*\n" - nil t) - (incf received) - (setq status (match-string 1)) - (if (string-match "^[45]" status) - (setq status 'error) - (setq status 'ok))) - (setq last-point (point)) - (or (< received count) - (if (eq status 'error) - nil - ;; I haven't started reading the final response - (progn - (goto-char (point-max)) - (forward-line -1) - (not (looking-at "^\\.\r?\n")))))) - ;; I haven't read the end of the final response - (nntp-accept-response) - (set-buffer process-buffer)))) - - ;; Some nntp servers seem to have an extension to the XOVER - ;; extension. On these servers, requesting an article range - ;; preceeding the active range does not return an error as - ;; specified in the RFC. What we instead get is the NOV entry - ;; for the first available article. Obviously, a client can - ;; use that entry to avoid making unnecessary requests. The - ;; only problem is for a client that assumes that the response - ;; will always be within the requested ranage. For such a - ;; client, we can get N copies of the same entry (one for each - ;; XOVER command sent to the server). - - (when (<= count 1) - (goto-char (point-min)) - (when (re-search-forward "^[0-9][0-9][0-9] .*\n\\([0-9]+\\)" nil t) - (let ((low-limit (string-to-number - (buffer-substring (match-beginning 1) - (match-end 1))))) - (while (and articles (<= (car articles) low-limit)) - (setq articles (cdr articles)))))) - (set-buffer buf)) - - (when nntp-server-xover - (when in-process-buffer-p - (set-buffer buf) - (goto-char (point-max)) - (insert-buffer-substring process-buffer) - (set-buffer process-buffer) - (erase-buffer) - (set-buffer buf)) - - ;; We remove any "." lines and status lines. - (goto-char (point-min)) - (while (search-forward "\r" nil t) - (delete-char -1)) - (goto-char (point-min)) - (delete-matching-lines "^\\.$\\|^[1-5][0-9][0-9] ") - t)))) - - nntp-server-xover) - -(defun nntp-send-xover-command (beg end &optional wait-for-reply) - "Send the XOVER command to the server." - (let ((range (format "%d-%d" beg end)) - (nntp-inhibit-erase t)) - (if (stringp nntp-server-xover) - ;; If `nntp-server-xover' is a string, then we just send this - ;; command. - (if wait-for-reply - (nntp-send-command-nodelete - "\r?\n\\.\r?\n" nntp-server-xover range) - ;; We do not wait for the reply. - (nntp-send-command-nodelete nil nntp-server-xover range)) - (let ((commands nntp-xover-commands)) - ;; `nntp-xover-commands' is a list of possible XOVER commands. - ;; We try them all until we get at positive response. - (while (and commands (eq nntp-server-xover 'try)) - (nntp-send-command-nodelete "\r?\n\\.\r?\n" (car commands) range) - (save-excursion - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (and (looking-at "[23]") ; No error message. - ;; We also have to look at the lines. Some buggy - ;; servers give back simple lines with just the - ;; article number. How... helpful. - (progn - (forward-line 1) - ;; More text after number, or a dot. - (looking-at "[0-9]+\t...\\|\\.\r?\n")) - (setq nntp-server-xover (car commands)))) - (setq commands (cdr commands))) - ;; If none of the commands worked, we disable XOVER. - (when (eq nntp-server-xover 'try) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (setq nntp-server-xover nil))) - nntp-server-xover)))) - -(defun nntp-find-group-and-number (&optional group) - (save-excursion - (save-restriction - (set-buffer nntp-server-buffer) - (narrow-to-region (goto-char (point-min)) - (or (search-forward "\n\n" nil t) (point-max))) - (goto-char (point-min)) - ;; We first find the number by looking at the status line. - (let ((number (and (looking-at "2[0-9][0-9] +\\([0-9]+\\) ") - (string-to-number - (buffer-substring (match-beginning 1) - (match-end 1))))) - newsgroups xref) - (and number (zerop number) (setq number nil)) - (if number - ;; Then we find the group name. - (setq group - (cond - ;; If there is only one group in the Newsgroups - ;; header, then it seems quite likely that this - ;; article comes from that group, I'd say. - ((and (setq newsgroups - (mail-fetch-field "newsgroups")) - (not (string-match "," newsgroups))) - newsgroups) - ;; If there is more than one group in the - ;; Newsgroups header, then the Xref header should - ;; be filled out. We hazard a guess that the group - ;; that has this article number in the Xref header - ;; is the one we are looking for. This might very - ;; well be wrong if this article happens to have - ;; the same number in several groups, but that's - ;; life. - ((and (setq xref (mail-fetch-field "xref")) - number - (string-match - (format "\\([^ :]+\\):%d" number) xref)) - (match-string 1 xref)) - (t ""))) - (cond - ((and (not nntp-xref-number-is-evil) - (setq xref (mail-fetch-field "xref")) - (string-match - (if group - (concat "\\(" (regexp-quote group) "\\):\\([0-9]+\\)") - "\\([^ :]+\\):\\([0-9]+\\)") - xref)) - (setq group (match-string 1 xref) - number (string-to-number (match-string 2 xref)))) - ((and (setq newsgroups - (mail-fetch-field "newsgroups")) - (not (string-match "," newsgroups))) - (setq group newsgroups)) - (group) - (t (setq group "")))) - (when (string-match "\r" group) - (setq group (substring group 0 (match-beginning 0)))) - (cons group number))))) - -(defun nntp-wait-for-string (regexp) - "Wait until string arrives in the buffer." - (let ((buf (current-buffer)) - proc) - (goto-char (point-min)) - (while (and (setq proc (get-buffer-process buf)) - (memq (process-status proc) '(open run)) - (not (re-search-forward regexp nil t))) - (accept-process-output proc) - (set-buffer buf) - (goto-char (point-min))))) - - -;; ========================================================================== -;; Obsolete nntp-open-* connection methods -- drv -;; ========================================================================== - -(defvoo nntp-open-telnet-envuser nil - "*If non-nil, telnet session (client and server both) will support the ENVIRON option and not prompt for login name.") - -(defvoo nntp-telnet-shell-prompt "bash\\|\$ *\r?$\\|> *\r?" - "*Regular expression to match the shell prompt on the remote machine.") - -(defvoo nntp-rlogin-program "rsh" - "*Program used to log in on remote machines. -The default is \"rsh\", but \"ssh\" is a popular alternative.") - -(defvoo nntp-rlogin-parameters '("telnet" "-8" "${NNTPSERVER:=news}" "nntp") - "*Parameters to `nntp-open-rlogin'. -That function may be used as `nntp-open-connection-function'. In that -case, this list will be used as the parameter list given to rsh.") - -(defvoo nntp-rlogin-user-name nil - "*User name on remote system when using the rlogin connect method.") - -(defvoo nntp-telnet-parameters - '("exec" "telnet" "-8" "${NNTPSERVER:=news}" "nntp") - "*Parameters to `nntp-open-telnet'. -That function may be used as `nntp-open-connection-function'. In that -case, this list will be executed as a command after logging in -via telnet.") - -(defvoo nntp-telnet-user-name nil - "User name to log in via telnet with.") - -(defvoo nntp-telnet-passwd nil - "Password to use to log in via telnet with.") - -(defun nntp-open-telnet (buffer) - (save-excursion - (set-buffer buffer) - (erase-buffer) - (let ((proc (apply - 'start-process - "nntpd" buffer nntp-telnet-command nntp-telnet-switches)) - (case-fold-search t)) - (when (memq (process-status proc) '(open run)) - (nntp-wait-for-string "^r?telnet") - (process-send-string proc "set escape \^X\n") - (cond - ((and nntp-open-telnet-envuser nntp-telnet-user-name) - (process-send-string proc (concat "open " "-l" nntp-telnet-user-name - nntp-address "\n"))) - (t - (process-send-string proc (concat "open " nntp-address "\n")))) - (cond - ((not nntp-open-telnet-envuser) - (nntp-wait-for-string "^\r*.?login:") - (process-send-string - proc (concat - (or nntp-telnet-user-name - (setq nntp-telnet-user-name (read-string "login: "))) - "\n")))) - (nntp-wait-for-string "^\r*.?password:") - (process-send-string - proc (concat - (or nntp-telnet-passwd - (setq nntp-telnet-passwd - (read-passwd "Password: "))) - "\n")) - (nntp-wait-for-string nntp-telnet-shell-prompt) - (process-send-string - proc (concat (mapconcat 'identity nntp-telnet-parameters " ") "\n")) - (nntp-wait-for-string "^\r*20[01]") - (beginning-of-line) - (delete-region (point-min) (point)) - (process-send-string proc "\^]") - (nntp-wait-for-string "^r?telnet") - (process-send-string proc "mode character\n") - (accept-process-output proc 1) - (sit-for 1) - (goto-char (point-min)) - (forward-line 1) - (delete-region (point) (point-max))) - proc))) - -(defun nntp-open-rlogin (buffer) - "Open a connection to SERVER using rsh." - (let ((proc (if nntp-rlogin-user-name - (apply 'start-process - "nntpd" buffer nntp-rlogin-program - nntp-address "-l" nntp-rlogin-user-name - nntp-rlogin-parameters) - (apply 'start-process - "nntpd" buffer nntp-rlogin-program nntp-address - nntp-rlogin-parameters)))) - (save-excursion - (set-buffer buffer) - (nntp-wait-for-string "^\r*20[01]") - (beginning-of-line) - (delete-region (point-min) (point)) - proc))) - - -;; ========================================================================== -;; Replacements for the nntp-open-* functions -- drv -;; ========================================================================== - -(defun nntp-open-telnet-stream (buffer) - "Open a nntp connection by telnet'ing the news server. - -Please refer to the following variables to customize the connection: -- `nntp-pre-command', -- `nntp-telnet-command', -- `nntp-telnet-switches', -- `nntp-address', -- `nntp-port-number', -- `nntp-end-of-line'." - (let ((command `(,nntp-telnet-command - ,@nntp-telnet-switches - ,nntp-address - ,(if (integerp nntp-port-number) - (number-to-string nntp-port-number) - nntp-port-number))) - proc) - (and nntp-pre-command - (push nntp-pre-command command)) - (setq proc (apply 'start-process "nntpd" buffer command)) - (save-excursion - (set-buffer buffer) - (nntp-wait-for-string "^\r*20[01]") - (beginning-of-line) - (delete-region (point-min) (point)) - proc))) - -(defun nntp-open-via-rlogin-and-telnet (buffer) - "Open a connection to an nntp server through an intermediate host. -First rlogin to the remote host, and then telnet the real news server -from there. - -Please refer to the following variables to customize the connection: -- `nntp-pre-command', -- `nntp-via-rlogin-command', -- `nntp-via-rlogin-command-switches', -- `nntp-via-user-name', -- `nntp-via-address', -- `nntp-telnet-command', -- `nntp-telnet-switches', -- `nntp-address', -- `nntp-port-number', -- `nntp-end-of-line'." - (let ((command `(,nntp-via-address - ,nntp-telnet-command - ,@nntp-telnet-switches)) - proc) - (when nntp-via-user-name - (setq command `("-l" ,nntp-via-user-name ,@command))) - (when nntp-via-rlogin-command-switches - (setq command (append nntp-via-rlogin-command-switches command))) - (push nntp-via-rlogin-command command) - (and nntp-pre-command - (push nntp-pre-command command)) - (setq proc (apply 'start-process "nntpd" buffer command)) - (save-excursion - (set-buffer buffer) - (nntp-wait-for-string "^r?telnet") - (process-send-string proc (concat "open " nntp-address " " - (if (integerp nntp-port-number) - (number-to-string nntp-port-number) - nntp-port-number) - "\n")) - (nntp-wait-for-string "^\r*20[01]") - (beginning-of-line) - (delete-region (point-min) (point)) - (process-send-string proc "\^]") - (nntp-wait-for-string "^r?telnet") - (process-send-string proc "mode character\n") - (accept-process-output proc 1) - (sit-for 1) - (goto-char (point-min)) - (forward-line 1) - (delete-region (point) (point-max))) - proc)) - -(defun nntp-open-via-telnet-and-telnet (buffer) - "Open a connection to an nntp server through an intermediate host. -First telnet the remote host, and then telnet the real news server -from there. - -Please refer to the following variables to customize the connection: -- `nntp-pre-command', -- `nntp-via-telnet-command', -- `nntp-via-telnet-switches', -- `nntp-via-address', -- `nntp-via-envuser', -- `nntp-via-user-name', -- `nntp-via-user-password', -- `nntp-via-shell-prompt', -- `nntp-telnet-command', -- `nntp-telnet-switches', -- `nntp-address', -- `nntp-port-number', -- `nntp-end-of-line'." - (save-excursion - (set-buffer buffer) - (erase-buffer) - (let ((command `(,nntp-via-telnet-command ,@nntp-via-telnet-switches)) - (case-fold-search t) - proc) - (and nntp-pre-command (push nntp-pre-command command)) - (setq proc (apply 'start-process "nntpd" buffer command)) - (when (memq (process-status proc) '(open run)) - (nntp-wait-for-string "^r?telnet") - (process-send-string proc "set escape \^X\n") - (cond - ((and nntp-via-envuser nntp-via-user-name) - (process-send-string proc (concat "open " "-l" nntp-via-user-name - nntp-via-address "\n"))) - (t - (process-send-string proc (concat "open " nntp-via-address - "\n")))) - (when (not nntp-via-envuser) - (nntp-wait-for-string "^\r*.?login:") - (process-send-string proc - (concat - (or nntp-via-user-name - (setq nntp-via-user-name - (read-string "login: "))) - "\n"))) - (nntp-wait-for-string "^\r*.?password:") - (process-send-string proc - (concat - (or nntp-via-user-password - (setq nntp-via-user-password - (read-passwd "Password: "))) - "\n")) - (nntp-wait-for-string nntp-via-shell-prompt) - (let ((real-telnet-command `("exec" - ,nntp-telnet-command - ,@nntp-telnet-switches - ,nntp-address - ,(if (integerp nntp-port-number) - (number-to-string nntp-port-number) - nntp-port-number)))) - (process-send-string proc - (concat (mapconcat 'identity - real-telnet-command " ") - "\n"))) - (nntp-wait-for-string "^\r*20[01]") - (beginning-of-line) - (delete-region (point-min) (point)) - (process-send-string proc "\^]") - (nntp-wait-for-string "^r?telnet") - (process-send-string proc "mode character\n") - (accept-process-output proc 1) - (sit-for 1) - (goto-char (point-min)) - (forward-line 1) - (delete-region (point) (point-max))) - proc))) - -(provide 'nntp) - -;;; arch-tag: 8655466a-b1b5-4929-9c45-7b1b2e767271 -;;; nntp.el ends here diff --git a/xemacs-packages/gnus/lisp/nnultimate.el b/xemacs-packages/gnus/lisp/nnultimate.el deleted file mode 100644 index ffa246c9..00000000 --- a/xemacs-packages/gnus/lisp/nnultimate.el +++ /dev/null @@ -1,482 +0,0 @@ -;;; nnultimate.el --- interfacing with the Ultimate Bulletin Board system - -;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; Note: You need to have `url' and `w3' installed for this -;; backend to work. - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'nnoo) -(require 'message) -(require 'gnus-util) -(require 'gnus) -(require 'nnmail) -(require 'mm-util) -(require 'mm-url) -(require 'nnweb) -(require 'parse-time) -(autoload 'w3-parse-buffer "w3-parse") - -(nnoo-declare nnultimate) - -(defvoo nnultimate-directory (nnheader-concat gnus-directory "ultimate/") - "Where nnultimate will save its files.") - -(defvoo nnultimate-address "" - "The address of the Ultimate bulletin board.") - -;;; Internal variables - -(defvar nnultimate-groups-alist nil) -(defvoo nnultimate-groups nil) -(defvoo nnultimate-headers nil) -(defvoo nnultimate-articles nil) -(defvar nnultimate-table-regexp - "postings.*editpost\\|forumdisplay\\|Forum[0-9]+/HTML\\|getbio") - -;;; Interface functions - -(nnoo-define-basics nnultimate) - -(deffoo nnultimate-retrieve-headers (articles &optional group server fetch-old) - (nnultimate-possibly-change-server group server) - (unless gnus-nov-is-evil - (let* ((last (car (last articles))) - (did nil) - (start 1) - (entry (assoc group nnultimate-groups)) - (sid (nth 2 entry)) - (topics (nth 4 entry)) - (mapping (nth 5 entry)) - (old-total (or (nth 6 entry) 1)) - (furl "forumdisplay.cgi?action=topics&number=%d&DaysPrune=1000") - (furls (list (concat nnultimate-address (format furl sid)))) - (nnultimate-table-regexp - "postings.*editpost\\|forumdisplay\\|getbio") - headers article subject score from date lines parent point - contents tinfo fetchers map elem a href garticles topic old-max - inc datel table current-page total-contents pages - farticles forum-contents parse furl-fetched mmap farticle) - (setq map mapping) - (while (and (setq article (car articles)) - map) - ;; Skip past the articles in the map until we reach the - ;; article we're looking for. - (while (and map - (or (> article (caar map)) - (< (cadar map) (caar map)))) - (pop map)) - (when (setq mmap (car map)) - (setq farticle -1) - (while (and article - (<= article (nth 1 mmap))) - ;; Do we already have a fetcher for this topic? - (if (setq elem (assq (nth 2 mmap) fetchers)) - ;; Yes, so we just add the spec to the end. - (nconc elem (list (cons article - (+ (nth 3 mmap) (incf farticle))))) - ;; No, so we add a new one. - (push (list (nth 2 mmap) - (cons article - (+ (nth 3 mmap) (incf farticle)))) - fetchers)) - (pop articles) - (setq article (car articles))))) - ;; Now we have the mapping from/to Gnus/nnultimate article numbers, - ;; so we start fetching the topics that we need to satisfy the - ;; request. - (if (not fetchers) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer)) - (setq nnultimate-articles nil) - (mm-with-unibyte-buffer - (dolist (elem fetchers) - (setq pages 1 - current-page 1 - total-contents nil) - (while (<= current-page pages) - (erase-buffer) - (setq subject (nth 2 (assq (car elem) topics))) - (setq href (nth 3 (assq (car elem) topics))) - (if (= current-page 1) - (mm-url-insert href) - (string-match "\\.html$" href) - (mm-url-insert (concat (substring href 0 (match-beginning 0)) - "-" (number-to-string current-page) - (match-string 0 href)))) - (goto-char (point-min)) - (setq contents - (ignore-errors (w3-parse-buffer (current-buffer)))) - (setq table (nnultimate-find-forum-table contents)) - (goto-char (point-min)) - (when (re-search-forward "topic is \\([0-9]+\\) pages" nil t) - (setq pages (string-to-number (match-string 1)))) - (setq contents (cdr (nth 2 (car (nth 2 table))))) - (setq total-contents (nconc total-contents contents)) - (incf current-page)) - (when t - (let ((i 0)) - (dolist (co total-contents) - (push (list (or (nnultimate-topic-article-to-article - group (car elem) (incf i)) - 1) - co subject) - nnultimate-articles)))) - (when nil - (dolist (art (cdr elem)) - (when (nth (1- (cdr art)) total-contents) - (push (list (car art) - (nth (1- (cdr art)) total-contents) - subject) - nnultimate-articles)))))) - (setq nnultimate-articles - (sort nnultimate-articles 'car-less-than-car)) - ;; Now we have all the articles, conveniently in an alist - ;; where the key is the Gnus article number. - (dolist (articlef nnultimate-articles) - (setq article (nth 0 articlef) - contents (nth 1 articlef) - subject (nth 2 articlef)) - (setq from (mapconcat 'identity - (nnweb-text (car (nth 2 contents))) - " ") - datel (nnweb-text (nth 2 (car (cdr (nth 2 contents)))))) - (while datel - (when (string-match "Posted" (car datel)) - (setq date (substring (car datel) (match-end 0)) - datel nil)) - (pop datel)) - (when date - (setq date (delete "" (split-string date "[-, \n\t\r    ]"))) - (setq date - (if (or (member "AM" date) - (member "PM" date)) - (format - "%s %s %s %s" - (nth 1 date) - (if (and (>= (length (nth 0 date)) 3) - (assoc (downcase - (substring (nth 0 date) 0 3)) - parse-time-months)) - (substring (nth 0 date) 0 3) - (car (rassq (string-to-number (nth 0 date)) - parse-time-months))) - (nth 2 date) (nth 3 date)) - (format "%s %s %s %s" - (car (rassq (string-to-number (nth 1 date)) - parse-time-months)) - (nth 0 date) (nth 2 date) (nth 3 date))))) - (push - (cons - article - (make-full-mail-header - article subject - from (or date "") - (concat "<" (number-to-string sid) "%" - (number-to-string article) - "@ultimate." server ">") - "" 0 - (/ (length (mapconcat - 'identity - (nnweb-text - (cdr (nth 2 (nth 1 (nth 2 contents))))) - "")) - 70) - nil nil)) - headers)) - (setq nnultimate-headers (sort headers 'car-less-than-car)) - (save-excursion - (set-buffer nntp-server-buffer) - (mm-with-unibyte-current-buffer - (erase-buffer) - (dolist (header nnultimate-headers) - (nnheader-insert-nov (cdr header)))))) - 'nov))) - -(defun nnultimate-topic-article-to-article (group topic article) - (catch 'found - (dolist (elem (nth 5 (assoc group nnultimate-groups))) - (when (and (= topic (nth 2 elem)) - (>= article (nth 3 elem)) - (< article (+ (- (nth 1 elem) (nth 0 elem)) 1 - (nth 3 elem)))) - (throw 'found - (+ (nth 0 elem) (- article (nth 3 elem)))))))) - -(deffoo nnultimate-request-group (group &optional server dont-check) - (nnultimate-possibly-change-server nil server) - (when (not nnultimate-groups) - (nnultimate-request-list)) - (unless dont-check - (nnultimate-create-mapping group)) - (let ((elem (assoc group nnultimate-groups))) - (cond - ((not elem) - (nnheader-report 'nnultimate "Group does not exist")) - (t - (nnheader-report 'nnultimate "Opened group %s" group) - (nnheader-insert - "211 %d %d %d %s\n" (cadr elem) 1 (cadr elem) - (prin1-to-string group)))))) - -(deffoo nnultimate-request-close () - (setq nnultimate-groups-alist nil - nnultimate-groups nil)) - -(deffoo nnultimate-request-article (article &optional group server buffer) - (nnultimate-possibly-change-server group server) - (let ((contents (cdr (assq article nnultimate-articles)))) - (setq contents (cddr (nth 2 (nth 1 (nth 2 (car contents)))))) - (when contents - (save-excursion - (set-buffer (or buffer nntp-server-buffer)) - (erase-buffer) - (nnweb-insert-html (cons 'p (cons nil (list contents)))) - (goto-char (point-min)) - (insert "Content-Type: text/html\nMIME-Version: 1.0\n") - (let ((header (cdr (assq article nnultimate-headers)))) - (mm-with-unibyte-current-buffer - (nnheader-insert-header header))) - (nnheader-report 'nnultimate "Fetched article %s" article) - (cons group article))))) - -(deffoo nnultimate-request-list (&optional server) - (nnultimate-possibly-change-server nil server) - (mm-with-unibyte-buffer - (mm-url-insert - (if (string-match "/$" nnultimate-address) - (concat nnultimate-address "Ultimate.cgi") - nnultimate-address)) - (let ((contents (nth 2 (car (nth 2 - (nnultimate-find-forum-table - (w3-parse-buffer (current-buffer))))))) - sid elem description articles a href group forum - a1 a2) - (dolist (row contents) - (setq row (nth 2 row)) - (when (setq a (nnweb-parse-find 'a row)) - (setq group (car (last (nnweb-text a))) - href (cdr (assq 'href (nth 1 a)))) - (setq description (car (last (nnweb-text (nth 1 row))))) - (setq a1 (car (last (nnweb-text (nth 2 row))))) - (setq a2 (car (last (nnweb-text (nth 3 row))))) - (when (string-match "^[0-9]+$" a1) - (setq articles (string-to-number a1))) - (when (and a2 (string-match "^[0-9]+$" a2)) - (setq articles (max articles (string-to-number a2)))) - (when href - (string-match "number=\\([0-9]+\\)" href) - (setq forum (string-to-number (match-string 1 href))) - (if (setq elem (assoc group nnultimate-groups)) - (setcar (cdr elem) articles) - (push (list group articles forum description nil nil nil nil) - nnultimate-groups)))))) - (nnultimate-write-groups) - (nnultimate-generate-active) - t)) - -(deffoo nnultimate-request-newgroups (date &optional server) - (nnultimate-possibly-change-server nil server) - (nnultimate-generate-active) - t) - -(nnoo-define-skeleton nnultimate) - -;;; Internal functions - -(defun nnultimate-prune-days (group time) - "Compute the number of days to fetch info for." - (let ((old-time (nth 7 (assoc group nnultimate-groups)))) - (if (null old-time) - 1000 - (- (time-to-days time) (time-to-days old-time))))) - -(defun nnultimate-create-mapping (group) - (let* ((entry (assoc group nnultimate-groups)) - (sid (nth 2 entry)) - (topics (nth 4 entry)) - (mapping (nth 5 entry)) - (old-total (or (nth 6 entry) 1)) - (current-time (current-time)) - (furl - (concat "forumdisplay.cgi?action=topics&number=%d&DaysPrune=" - (number-to-string - (nnultimate-prune-days group current-time)))) - (furls (list (concat nnultimate-address (format furl sid)))) - contents forum-contents furl-fetched a subject href - garticles topic tinfo old-max inc parse) - (mm-with-unibyte-buffer - (while furls - (erase-buffer) - (mm-url-insert (pop furls)) - (goto-char (point-min)) - (setq parse (w3-parse-buffer (current-buffer))) - (setq contents - (cdr (nth 2 (car (nth 2 (nnultimate-find-forum-table - parse)))))) - (setq forum-contents (nconc contents forum-contents)) - (unless furl-fetched - (setq furl-fetched t) - ;; On the first time through this loop, we find all the - ;; forum URLs. - (dolist (a (nnweb-parse-find-all 'a parse)) - (let ((href (cdr (assq 'href (nth 1 a))))) - (when (and href - (string-match "forumdisplay.*startpoint" href)) - (push href furls)))) - (setq furls (nreverse furls)))) - ;; The main idea here is to map Gnus article numbers to - ;; nnultimate article numbers. Say there are three topics in - ;; this forum, the first with 4 articles, the seconds with 2, - ;; and the third with 1. Then this will translate into 7 Gnus - ;; article numbers, where 1-4 comes from the first topic, 5-6 - ;; from the second and 7 from the third. Now, then next time - ;; the group is entered, there's 2 new articles in topic one - ;; and 1 in topic three. Then Gnus article number 8-9 be 5-6 - ;; in topic one and 10 will be the 2 in topic three. - (dolist (row (nreverse forum-contents)) - (setq row (nth 2 row)) - (when (setq a (nnweb-parse-find 'a row)) - (setq subject (car (last (nnweb-text a))) - href (cdr (assq 'href (nth 1 a)))) - (let ((artlist (nreverse (nnweb-text row))) - art) - (while (and (not art) - artlist) - (when (string-match "^[0-9]+$" (car artlist)) - (setq art (1+ (string-to-number (car artlist))))) - (pop artlist)) - (setq garticles art)) - (when garticles - (string-match "/\\([0-9]+\\).html" href) - (setq topic (string-to-number (match-string 1 href))) - (if (setq tinfo (assq topic topics)) - (progn - (setq old-max (cadr tinfo)) - (setcar (cdr tinfo) garticles)) - (setq old-max 0) - (push (list topic garticles subject href) topics) - (setcar (nthcdr 4 entry) topics)) - (when (not (= old-max garticles)) - (setq inc (- garticles old-max)) - (setq mapping (nconc mapping - (list - (list - old-total (1- (incf old-total inc)) - topic (1+ old-max))))) - (incf old-max inc) - (setcar (nthcdr 5 entry) mapping) - (setcar (nthcdr 6 entry) old-total)))))) - (setcar (nthcdr 7 entry) current-time) - (setcar (nthcdr 1 entry) (1- old-total)) - (nnultimate-write-groups) - mapping)) - -(defun nnultimate-possibly-change-server (&optional group server) - (nnultimate-init server) - (when (and server - (not (nnultimate-server-opened server))) - (nnultimate-open-server server)) - (unless nnultimate-groups-alist - (nnultimate-read-groups) - (setq nnultimate-groups (cdr (assoc nnultimate-address - nnultimate-groups-alist))))) - -(deffoo nnultimate-open-server (server &optional defs connectionless) - (nnheader-init-server-buffer) - (if (nnultimate-server-opened server) - t - (unless (assq 'nnultimate-address defs) - (setq defs (append defs (list (list 'nnultimate-address server))))) - (nnoo-change-server 'nnultimate server defs))) - -(defun nnultimate-read-groups () - (setq nnultimate-groups-alist nil) - (let ((file (expand-file-name "groups" nnultimate-directory))) - (when (file-exists-p file) - (mm-with-unibyte-buffer - (insert-file-contents file) - (goto-char (point-min)) - (setq nnultimate-groups-alist (read (current-buffer))))))) - -(defun nnultimate-write-groups () - (setq nnultimate-groups-alist - (delq (assoc nnultimate-address nnultimate-groups-alist) - nnultimate-groups-alist)) - (push (cons nnultimate-address nnultimate-groups) - nnultimate-groups-alist) - (with-temp-file (expand-file-name "groups" nnultimate-directory) - (prin1 nnultimate-groups-alist (current-buffer)))) - -(defun nnultimate-init (server) - "Initialize buffers and such." - (unless (file-exists-p nnultimate-directory) - (gnus-make-directory nnultimate-directory))) - -(defun nnultimate-generate-active () - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (dolist (elem nnultimate-groups) - (insert (prin1-to-string (car elem)) - " " (number-to-string (cadr elem)) " 1 y\n")))) - -(defun nnultimate-find-forum-table (contents) - (catch 'found - (nnultimate-find-forum-table-1 contents))) - -(defun nnultimate-find-forum-table-1 (contents) - (dolist (element contents) - (unless (stringp element) - (when (and (eq (car element) 'table) - (nnultimate-forum-table-p element)) - (throw 'found element)) - (when (nth 2 element) - (nnultimate-find-forum-table-1 (nth 2 element)))))) - -(defun nnultimate-forum-table-p (parse) - (when (not (apply 'gnus-or - (mapcar - (lambda (p) - (nnweb-parse-find 'table p)) - (nth 2 parse)))) - (let ((href (cdr (assq 'href (nth 1 (nnweb-parse-find 'a parse 20))))) - case-fold-search) - (when (and href (string-match nnultimate-table-regexp href)) - t)))) - -(provide 'nnultimate) - -;; Local Variables: -;; coding: iso-8859-1 -;; End: - -;;; arch-tag: ab6bfc45-8fe1-4647-9c78-41050eb152b8 -;;; nnultimate.el ends here diff --git a/xemacs-packages/gnus/lisp/nnvirtual.el b/xemacs-packages/gnus/lisp/nnvirtual.el deleted file mode 100644 index e48a4b6a..00000000 --- a/xemacs-packages/gnus/lisp/nnvirtual.el +++ /dev/null @@ -1,823 +0,0 @@ -;;; nnvirtual.el --- virtual newsgroups access for Gnus - -;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, -;; 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: David Moore -;; Lars Magne Ingebrigtsen -;; Masanobu UMEDA -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; The other access methods (nntp, nnspool, etc) are general news -;; access methods. This module relies on Gnus and can not be used -;; separately. - -;;; Code: - -(require 'nntp) -(require 'nnheader) -(require 'gnus) -(require 'nnoo) -(require 'gnus-util) -(require 'gnus-start) -(require 'gnus-sum) -(require 'gnus-msg) -(eval-when-compile (require 'cl)) - -(nnoo-declare nnvirtual) - -(defvoo nnvirtual-always-rescan t - "If non-nil, always scan groups for unread articles when entering a group. -If this variable is nil and you read articles in a component group -after the virtual group has been activated, the read articles from the -component group will show up when you enter the virtual group.") - -(defvoo nnvirtual-component-regexp nil - "Regexp to match component groups.") - -(defvoo nnvirtual-component-groups nil - "Component group in this nnvirtual group.") - - - -(defconst nnvirtual-version "nnvirtual 1.1") - -(defvoo nnvirtual-current-group nil) - -(defvoo nnvirtual-mapping-table nil - "Table of rules on how to map between component group and article number to virtual article number.") - -(defvoo nnvirtual-mapping-offsets nil - "Table indexed by component group to an offset to be applied to article numbers in that group.") - -(defvoo nnvirtual-mapping-len 0 - "Number of articles in this virtual group.") - -(defvoo nnvirtual-mapping-reads nil - "Compressed sequence of read articles on the virtual group as computed from the unread status of individual component groups.") - -(defvoo nnvirtual-mapping-marks nil - "Compressed marks alist for the virtual group as computed from the marks of individual component groups.") - -(defvoo nnvirtual-info-installed nil - "T if we have already installed the group info for this group, and shouldn't blast over it again.") - -(defvoo nnvirtual-status-string "") - -(eval-and-compile - (autoload 'gnus-cache-articles-in-group "gnus-cache")) - - - -;;; Interface functions. - -(nnoo-define-basics nnvirtual) - - -(deffoo nnvirtual-retrieve-headers (articles &optional newsgroup - server fetch-old) - (when (nnvirtual-possibly-change-server server) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (if (stringp (car articles)) - 'headers - (let ((vbuf (nnheader-set-temp-buffer - (get-buffer-create " *virtual headers*"))) - (carticles (nnvirtual-partition-sequence articles)) - (system-name (system-name)) - cgroup carticle article result prefix) - (while carticles - (setq cgroup (caar carticles)) - (setq articles (cdar carticles)) - (pop carticles) - (when (and articles - (gnus-check-server - (gnus-find-method-for-group cgroup) t) - (gnus-request-group cgroup t) - (setq prefix (gnus-group-real-prefix cgroup)) - ;; FIX FIX FIX we want to check the cache! - ;; This is probably evil if people have set - ;; gnus-use-cache to nil themselves, but I - ;; have no way of finding the true value of it. - (let ((gnus-use-cache t)) - (setq result (gnus-retrieve-headers - articles cgroup nil)))) - (set-buffer nntp-server-buffer) - ;; If we got HEAD headers, we convert them into NOV - ;; headers. This is slow, inefficient and, come to think - ;; of it, downright evil. So sue me. I couldn't be - ;; bothered to write a header parse routine that could - ;; parse a mixed HEAD/NOV buffer. - (when (eq result 'headers) - (nnvirtual-convert-headers)) - (goto-char (point-min)) - (while (not (eobp)) - (delete-region (point) - (progn - (setq carticle (read nntp-server-buffer)) - (point))) - - ;; We remove this article from the articles list, if - ;; anything is left in the articles list after going through - ;; the entire buffer, then those articles have been - ;; expired or canceled, so we appropriately update the - ;; component group below. They should be coming up - ;; generally in order, so this shouldn't be slow. - (setq articles (delq carticle articles)) - - (setq article (nnvirtual-reverse-map-article cgroup carticle)) - (if (null article) - ;; This line has no reverse mapping, that means it - ;; was an extra article reference returned by nntp. - (progn - (beginning-of-line) - (delete-region (point) (progn (forward-line 1) (point)))) - ;; Otherwise insert the virtual article number, - ;; and clean up the xrefs. - (princ article nntp-server-buffer) - (nnvirtual-update-xref-header cgroup carticle - prefix system-name) - (forward-line 1)) - ) - - (set-buffer vbuf) - (goto-char (point-max)) - (insert-buffer-substring nntp-server-buffer)) - ;; Anything left in articles is expired or canceled. - ;; Could be smart and not tell it about articles already known? - (when articles - (gnus-group-make-articles-read cgroup articles)) - ) - - ;; The headers are ready for reading, so they are inserted into - ;; the nntp-server-buffer, which is where Gnus expects to find - ;; them. - (prog1 - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (insert-buffer-substring vbuf) - ;; FIX FIX FIX, we should be able to sort faster than - ;; this if needed, since each cgroup is sorted, we just - ;; need to merge - (sort-numeric-fields 1 (point-min) (point-max)) - 'nov) - (kill-buffer vbuf))))))) - - -(defvoo nnvirtual-last-accessed-component-group nil) - -(deffoo nnvirtual-request-article (article &optional group server buffer) - (when (nnvirtual-possibly-change-server server) - (if (stringp article) - ;; This is a fetch by Message-ID. - (cond - ((not nnvirtual-last-accessed-component-group) - (nnheader-report - 'nnvirtual "Don't know what server to request from")) - (t - (save-excursion - (when buffer - (set-buffer buffer)) - (let* ((gnus-override-method nil) - (method (gnus-find-method-for-group - nnvirtual-last-accessed-component-group))) - (funcall (gnus-get-function method 'request-article) - article nil (nth 1 method) buffer))))) - ;; This is a fetch by number. - (let* ((amap (nnvirtual-map-article article)) - (cgroup (car amap))) - (cond - ((not amap) - (nnheader-report 'nnvirtual "No such article: %s" article)) - ((not (gnus-check-group cgroup)) - (nnheader-report - 'nnvirtual "Can't open server where %s exists" cgroup)) - ((not (gnus-request-group cgroup t)) - (nnheader-report 'nnvirtual "Can't open component group %s" cgroup)) - (t - (setq nnvirtual-last-accessed-component-group cgroup) - (if buffer - (save-excursion - (set-buffer buffer) - ;; We bind this here to avoid double decoding. - (let ((gnus-article-decode-hook nil)) - (gnus-request-article-this-buffer (cdr amap) cgroup))) - (gnus-request-article (cdr amap) cgroup)))))))) - - -(deffoo nnvirtual-open-server (server &optional defs) - (unless (assq 'nnvirtual-component-regexp defs) - (push `(nnvirtual-component-regexp ,server) - defs)) - (nnoo-change-server 'nnvirtual server defs) - (if nnvirtual-component-groups - t - (setq nnvirtual-mapping-table nil - nnvirtual-mapping-offsets nil - nnvirtual-mapping-len 0 - nnvirtual-mapping-reads nil - nnvirtual-mapping-marks nil - nnvirtual-info-installed nil) - (when nnvirtual-component-regexp - ;; Go through the newsrc alist and find all component groups. - (let ((newsrc (cdr gnus-newsrc-alist)) - group) - (while (setq group (car (pop newsrc))) - (when (string-match nnvirtual-component-regexp group) ; Match - ;; Add this group to the list of component groups. - (setq nnvirtual-component-groups - (cons group (delete group nnvirtual-component-groups))))))) - (if (not nnvirtual-component-groups) - (nnheader-report 'nnvirtual "No component groups: %s" server) - t))) - - -(deffoo nnvirtual-request-group (group &optional server dont-check) - (nnvirtual-possibly-change-server server) - (setq nnvirtual-component-groups - (delete (nnvirtual-current-group) nnvirtual-component-groups)) - (cond - ((null nnvirtual-component-groups) - (setq nnvirtual-current-group nil) - (nnheader-report 'nnvirtual "No component groups in %s" group)) - (t - (setq nnvirtual-current-group group) - (when (or (not dont-check) - nnvirtual-always-rescan) - (nnvirtual-create-mapping) - (when nnvirtual-always-rescan - (nnvirtual-request-update-info - (nnvirtual-current-group) - (gnus-get-info (nnvirtual-current-group))))) - (nnheader-insert "211 %d 1 %d %s\n" - nnvirtual-mapping-len nnvirtual-mapping-len group)))) - - -(deffoo nnvirtual-request-type (group &optional article) - (if (not article) - 'unknown - (if (numberp article) - (let ((mart (nnvirtual-map-article article))) - (if mart - (gnus-request-type (car mart) (cdr mart)))) - (gnus-request-type - nnvirtual-last-accessed-component-group nil)))) - -(deffoo nnvirtual-request-update-mark (group article mark) - (let* ((nart (nnvirtual-map-article article)) - (cgroup (car nart))) - (when (and nart - (memq mark gnus-auto-expirable-marks) - ;; The component group might be a virtual group. - (= mark (gnus-request-update-mark cgroup (cdr nart) mark)) - (gnus-group-auto-expirable-p cgroup)) - (setq mark gnus-expirable-mark))) - mark) - - -(deffoo nnvirtual-close-group (group &optional server) - (when (and (nnvirtual-possibly-change-server server) - (not (gnus-ephemeral-group-p (nnvirtual-current-group)))) - (nnvirtual-update-read-and-marked t t)) - t) - - -(deffoo nnvirtual-request-list (&optional server) - (nnheader-report 'nnvirtual "LIST is not implemented.")) - - -(deffoo nnvirtual-request-newgroups (date &optional server) - (nnheader-report 'nnvirtual "NEWGROUPS is not supported.")) - - -(deffoo nnvirtual-request-list-newsgroups (&optional server) - (nnheader-report 'nnvirtual "LIST NEWSGROUPS is not implemented.")) - - -(deffoo nnvirtual-request-update-info (group info &optional server) - (when (and (nnvirtual-possibly-change-server server) - (not nnvirtual-info-installed)) - ;; Install the precomputed lists atomically, so the virtual group - ;; is not left in a half-way state in case of C-g. - (gnus-atomic-progn - (setcar (cddr info) nnvirtual-mapping-reads) - (if (nthcdr 3 info) - (setcar (nthcdr 3 info) nnvirtual-mapping-marks) - (when nnvirtual-mapping-marks - (setcdr (nthcdr 2 info) (list nnvirtual-mapping-marks)))) - (setq nnvirtual-info-installed t)) - t)) - - -(deffoo nnvirtual-catchup-group (group &optional server all) - (when (and (nnvirtual-possibly-change-server server) - (not (gnus-ephemeral-group-p (nnvirtual-current-group)))) - ;; copy over existing marks first, in case they set anything - (nnvirtual-update-read-and-marked nil nil) - ;; do a catchup on all component groups - (let ((gnus-group-marked (copy-sequence nnvirtual-component-groups)) - (gnus-expert-user t)) - ;; Make sure all groups are activated. - (mapcar - (lambda (g) - (when (not (numberp (car (gnus-gethash g gnus-newsrc-hashtb)))) - (gnus-activate-group g))) - nnvirtual-component-groups) - (save-excursion - (set-buffer gnus-group-buffer) - (gnus-group-catchup-current nil all))))) - - -(deffoo nnvirtual-find-group-art (group article) - "Return the real group and article for virtual GROUP and ARTICLE." - (nnvirtual-map-article article)) - - -(deffoo nnvirtual-request-post (&optional server) - (if (not gnus-message-group-art) - (nnheader-report 'nnvirtual "Can't post to an nnvirtual group") - (let ((group (car (nnvirtual-find-group-art - (car gnus-message-group-art) - (cdr gnus-message-group-art))))) - (gnus-request-post (gnus-find-method-for-group group))))) - - -(deffoo nnvirtual-request-expire-articles (articles group - &optional server force) - (nnvirtual-possibly-change-server server) - (setq nnvirtual-component-groups - (delete (nnvirtual-current-group) nnvirtual-component-groups)) - (let (unexpired) - (dolist (group nnvirtual-component-groups) - (setq unexpired (nconc unexpired - (mapcar - #'(lambda (article) - (nnvirtual-reverse-map-article - group article)) - (gnus-uncompress-range - (gnus-group-expire-articles-1 group)))))) - (sort (delq nil unexpired) '<))) - - -;;; Internal functions. - -(defun nnvirtual-convert-headers () - "Convert HEAD headers into NOV headers." - (save-excursion - (set-buffer nntp-server-buffer) - (let* ((dependencies (make-vector 100 0)) - (headers (gnus-get-newsgroup-headers dependencies)) - header) - (erase-buffer) - (while (setq header (pop headers)) - (nnheader-insert-nov header))))) - - -(defun nnvirtual-update-xref-header (group article prefix system-name) - "Edit current NOV header in current buffer to have an xref to the component group, and also server prefix any existing xref lines." - ;; Move to beginning of Xref field, creating a slot if needed. - (beginning-of-line) - (looking-at - "[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t") - (goto-char (match-end 0)) - (unless (search-forward "\t" (gnus-point-at-eol) 'move) - (insert "\t")) - - ;; Remove any spaces at the beginning of the Xref field. - (while (eq (char-after (1- (point))) ? ) - (forward-char -1) - (delete-char 1)) - - (insert "Xref: " system-name " " group ":") - (princ article (current-buffer)) - (insert " ") - - ;; If there were existing xref lines, clean them up to have the correct - ;; component server prefix. - (save-restriction - (narrow-to-region (point) - (or (search-forward "\t" (gnus-point-at-eol) t) - (gnus-point-at-eol))) - (goto-char (point-min)) - (when (re-search-forward "Xref: *[^\n:0-9 ]+ *" nil t) - (replace-match "" t t)) - (goto-char (point-min)) - (when (re-search-forward - (concat (regexp-quote (gnus-group-real-name group)) ":[0-9]+") - nil t) - (replace-match "" t t)) - (unless (eobp) - (insert " ") - (when (not (string= "" prefix)) - (while (re-search-forward "[^ ]+:[0-9]+" nil t) - (save-excursion - (goto-char (match-beginning 0)) - (insert prefix)))))) - - ;; Ensure a trailing \t. - (end-of-line) - (or (eq (char-after (1- (point))) ?\t) - (insert ?\t))) - - -(defun nnvirtual-possibly-change-server (server) - (or (not server) - (nnoo-current-server-p 'nnvirtual server) - (nnvirtual-open-server server))) - - -(defun nnvirtual-update-read-and-marked (read-p update-p) - "Copy marks from the virtual group to the component groups. -If READ-P is not nil, update the (un)read status of the components. -If UPDATE-P is not nil, call gnus-group-update-group on the components." - (when nnvirtual-current-group - (let ((unreads (and read-p - (nnvirtual-partition-sequence - (gnus-list-of-unread-articles - (nnvirtual-current-group))))) - (type-marks - (delq nil - (mapcar (lambda (ml) - (if (eq (car ml) 'score) - nil - (cons (car ml) - (nnvirtual-partition-sequence (cdr ml))))) - (gnus-info-marks (gnus-get-info - (nnvirtual-current-group)))))) - mark type groups carticles info entry) - - ;; Ok, atomically move all of the (un)read info, clear any old - ;; marks, and move all of the current marks. This way if someone - ;; hits C-g, you won't leave the component groups in a half-way state. - (progn - ;; move (un)read - ;; bind for workaround guns-update-read-articles - (let ((gnus-newsgroup-active nil)) - (while (setq entry (pop unreads)) - (gnus-update-read-articles (car entry) (cdr entry)))) - - ;; clear all existing marks on the component groups - (setq groups nnvirtual-component-groups) - (while groups - (when (and (setq info (gnus-get-info (pop groups))) - (gnus-info-marks info)) - (gnus-info-set-marks - info - (if (assq 'score (gnus-info-marks info)) - (list (assq 'score (gnus-info-marks info))) - nil)))) - - ;; Ok, currently type-marks is an assq list with keys of a mark type, - ;; with data of an assq list with keys of component group names - ;; and the articles which correspond to that key/group pair. - (while (setq mark (pop type-marks)) - (setq type (car mark)) - (setq groups (cdr mark)) - (while (setq carticles (pop groups)) - (gnus-add-marked-articles (car carticles) type (cdr carticles) - nil t)))) - - ;; possibly update the display, it is really slow - (when update-p - (setq groups nnvirtual-component-groups) - (while groups - (gnus-group-update-group (pop groups) t)))))) - - -(defun nnvirtual-current-group () - "Return the prefixed name of the current nnvirtual group." - (concat "nnvirtual:" nnvirtual-current-group)) - - - -;;; This is currently O(kn^2) to merge n lists of length k. -;;; You could do it in O(knlogn), but we have a small n, and the -;;; overhead of the other approach is probably greater. -(defun nnvirtual-merge-sorted-lists (&rest lists) - "Merge many sorted lists of numbers." - (if (null (cdr lists)) - (car lists) - (sort (apply 'nconc lists) '<))) - - -;;; We map between virtual articles and real articles in a manner -;;; which keeps the size of the virtual active list the same as the -;;; sum of the component active lists. - -;;; To achieve fair mixing of the groups, the last article in each of -;;; N component groups will be in the last N articles in the virtual -;;; group. - -;;; If you have 3 components A, B and C, with articles 1-8, 1-5, and -;;; 6-7 respectively, then the virtual article numbers look like: -;;; -;;; 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 -;;; A1 A2 A3 A4 B1 A5 B2 A6 B3 A7 B4 C6 A8 B5 C7 - -;;; To compute these mappings we generate a couple tables and then -;;; do some fast operations on them. Tables for the example above: -;;; -;;; Offsets - [(A 0) (B -3) (C -1)] -;;; -;;; a b c d e -;;; Mapping - ([ 3 0 1 3 0 ] -;;; [ 6 3 2 9 3 ] -;;; [ 8 6 3 15 9 ]) -;;; -;;; (note column 'e' is different in real algorithm, which is slightly -;;; different than described here, but this gives you the methodology.) -;;; -;;; The basic idea is this, when going from component->virtual, apply -;;; the appropriate offset to the article number. Then search the first -;;; column of the table for a row where 'a' is less than or equal to the -;;; modified number. You can see that only group A can therefore go to -;;; the first row, groups A and B to the second, and all to the last. -;;; The third column of the table is telling us the number of groups -;;; which might be able to reach that row (it might increase by more than -;;; 1 if several groups have the same size). -;;; Then column 'b' provides an additional offset you apply when you have -;;; found the correct row. You then multiply by 'c' and add on the groups -;;; _position_ in the offset table. The basic idea here is that on -;;; any given row we are going to map back and forth using X'=X*c+Y and -;;; X=(X'/c), Y=(X' mod c). Then once you've done this transformation, -;;; you apply a final offset from column 'e' to give the virtual article. -;;; -;;; Going the other direction, you instead search on column 'd' instead -;;; of 'a', and apply everything in reverse order. - -;;; Convert component -> virtual: -;;; set num = num - Offset(group) -;;; find first row in Mapping where num <= 'a' -;;; num = (num-'b')*c + Position(group) + 'e' - -;;; Convert virtual -> component: -;;; find first row in Mapping where num <= 'd' -;;; num = num - 'e' -;;; group_pos = num mod 'c' -;;; num = (num / 'c') + 'b' + Offset(group_pos) - -;;; Easy no? :) -;;; -;;; Well actually, you need to keep column e offset smaller by the 'c' -;;; column for that line, and always add 1 more when going from -;;; component -> virtual. Otherwise you run into a problem with -;;; unique reverse mapping. - -(defun nnvirtual-map-article (article) - "Return a cons of the component group and article corresponding to the given virtual ARTICLE." - (let ((table nnvirtual-mapping-table) - entry group-pos) - (while (and table - (> article (aref (car table) 3))) - (setq table (cdr table))) - (when (and table - (> article 0)) - (setq entry (car table)) - (setq article (- article (aref entry 4) 1)) - (setq group-pos (mod article (aref entry 2))) - (cons (car (aref nnvirtual-mapping-offsets group-pos)) - (+ (/ article (aref entry 2)) - (aref entry 1) - (cdr (aref nnvirtual-mapping-offsets group-pos))) - )) - )) - - - -(defun nnvirtual-reverse-map-article (group article) - "Return the virtual article number corresponding to the given component GROUP and ARTICLE." - (when (numberp article) - (let ((table nnvirtual-mapping-table) - (group-pos 0) - entry) - (while (not (string= group (car (aref nnvirtual-mapping-offsets - group-pos)))) - (setq group-pos (1+ group-pos))) - (setq article (- article (cdr (aref nnvirtual-mapping-offsets - group-pos)))) - (while (and table - (> article (aref (car table) 0))) - (setq table (cdr table))) - (setq entry (car table)) - (when (and entry - (> article 0) - (< group-pos (aref entry 2))) ; article not out of range below - (+ (aref entry 4) - group-pos - (* (- article (aref entry 1)) - (aref entry 2)) - 1)) - ))) - - -(defsubst nnvirtual-reverse-map-sequence (group articles) - "Return list of virtual article numbers for all ARTICLES in GROUP. -The ARTICLES should be sorted, and can be a compressed sequence. -If any of the article numbers has no corresponding virtual article, -then it is left out of the result." - (when (numberp (cdr-safe articles)) - (setq articles (list articles))) - (let (result a i j new-a) - (while (setq a (pop articles)) - (if (atom a) - (setq i a - j a) - (setq i (car a) - j (cdr a))) - (while (<= i j) - ;; If this is slow, you can optimize by moving article checking - ;; into here. You don't have to recompute the group-pos, - ;; nor scan the table every time. - (when (setq new-a (nnvirtual-reverse-map-article group i)) - (push new-a result)) - (setq i (1+ i)))) - (nreverse result))) - - -(defun nnvirtual-partition-sequence (articles) - "Return an association list of component article numbers. -These are indexed by elements of nnvirtual-component-groups, based on -the sequence ARTICLES of virtual article numbers. ARTICLES should be -sorted, and can be a compressed sequence. If any of the article -numbers has no corresponding component article, then it is left out of -the result." - (when (numberp (cdr-safe articles)) - (setq articles (list articles))) - (let ((carticles (mapcar (lambda (g) (list g)) - nnvirtual-component-groups)) - a i j article entry) - (while (setq a (pop articles)) - (if (atom a) - (setq i a - j a) - (setq i (car a) - j (cdr a))) - (while (<= i j) - (when (setq article (nnvirtual-map-article i)) - (setq entry (assoc (car article) carticles)) - (setcdr entry (cons (cdr article) (cdr entry)))) - (setq i (1+ i)))) - (mapcar (lambda (x) (setcdr x (nreverse (cdr x)))) - carticles) - carticles)) - - -(defun nnvirtual-create-mapping () - "Build the tables necessary to map between component (group, article) to virtual article. -Generate the set of read messages and marks for the virtual group -based on the marks on the component groups." - (let ((cnt 0) - (tot 0) - (M 0) - (i 0) - actives all-unreads all-marks - active min max size unreads marks - next-M next-tot - reads beg) - ;; Ok, we loop over all component groups and collect a lot of - ;; information: - ;; Into actives we place (g size max), where size is max-min+1. - ;; Into all-unreads we put (g unreads). - ;; Into all-marks we put (g marks). - ;; We also increment cnt and tot here, and compute M (max of sizes). - (mapcar (lambda (g) - (setq active (gnus-activate-group g) - min (car active) - max (cdr active)) - (when (and active (>= max min) (not (zerop max))) - ;; store active information - (push (list g (- max min -1) max) actives) - ;; collect unread/mark info for later - (setq unreads (gnus-list-of-unread-articles g)) - (setq marks (gnus-info-marks (gnus-get-info g))) - (when gnus-use-cache - (push (cons 'cache - (gnus-cache-articles-in-group g)) - marks)) - (push (cons g unreads) all-unreads) - (push (cons g marks) all-marks) - ;; count groups, total #articles, and max size - (setq size (- max min -1)) - (setq cnt (1+ cnt) - tot (+ tot size) - M (max M size)))) - nnvirtual-component-groups) - - ;; Number of articles in the virtual group. - (setq nnvirtual-mapping-len tot) - - - ;; We want the actives list sorted by size, to build the tables. - (setq actives (sort actives (lambda (g1 g2) (< (nth 1 g1) (nth 1 g2))))) - - ;; Build the offset table. Largest sized groups are at the front. - (setq nnvirtual-mapping-offsets - (vconcat - (nreverse - (mapcar (lambda (entry) - (cons (nth 0 entry) - (- (nth 2 entry) M))) - actives)))) - - ;; Build the mapping table. - (setq nnvirtual-mapping-table nil) - (setq actives (mapcar (lambda (entry) (nth 1 entry)) actives)) - (while actives - (setq size (car actives)) - (setq next-M (- M size)) - (setq next-tot (- tot (* cnt size))) - ;; make current row in table - (push (vector M next-M cnt tot (- next-tot cnt)) - nnvirtual-mapping-table) - ;; update M and tot - (setq M next-M) - (setq tot next-tot) - ;; subtract the current size from all entries. - (setq actives (mapcar (lambda (x) (- x size)) actives)) - ;; remove anything that went to 0. - (while (and actives - (= (car actives) 0)) - (pop actives) - (setq cnt (- cnt 1)))) - - - ;; Now that the mapping tables are generated, we can convert - ;; and combine the separate component unreads and marks lists - ;; into single lists of virtual article numbers. - (setq unreads (apply 'nnvirtual-merge-sorted-lists - (mapcar (lambda (x) - (nnvirtual-reverse-map-sequence - (car x) (cdr x))) - all-unreads))) - (setq marks (mapcar - (lambda (type) - (cons (cdr type) - (gnus-compress-sequence - (apply - 'nnvirtual-merge-sorted-lists - (mapcar (lambda (x) - (nnvirtual-reverse-map-sequence - (car x) - (cdr (assq (cdr type) (cdr x))))) - all-marks))))) - gnus-article-mark-lists)) - - ;; Remove any empty marks lists, and store. - (setq nnvirtual-mapping-marks nil) - (while marks - (if (cdr (car marks)) - (push (car marks) nnvirtual-mapping-marks)) - (setq marks (cdr marks))) - - ;; We need to convert the unreads to reads. We compress the - ;; sequence as we go, otherwise it could be huge. - (while (and (<= (incf i) nnvirtual-mapping-len) - unreads) - (if (= i (car unreads)) - (setq unreads (cdr unreads)) - ;; try to get a range. - (setq beg i) - (while (and (<= (incf i) nnvirtual-mapping-len) - (not (= i (car unreads))))) - (setq i (- i 1)) - (if (= i beg) - (push i reads) - (push (cons beg i) reads)) - )) - (when (<= i nnvirtual-mapping-len) - (if (= i nnvirtual-mapping-len) - (push i reads) - (push (cons i nnvirtual-mapping-len) reads))) - - ;; Store the reads list for later use. - (setq nnvirtual-mapping-reads (nreverse reads)) - - ;; Throw flag to show we changed the info. - (setq nnvirtual-info-installed nil) - )) - -(provide 'nnvirtual) - -;;; arch-tag: ca8c8ad9-1bd8-4b0f-9722-90dc645a45f5 -;;; nnvirtual.el ends here diff --git a/xemacs-packages/gnus/lisp/nnwarchive.el b/xemacs-packages/gnus/lisp/nnwarchive.el deleted file mode 100644 index 36dec52a..00000000 --- a/xemacs-packages/gnus/lisp/nnwarchive.el +++ /dev/null @@ -1,729 +0,0 @@ -;;; nnwarchive.el --- interfacing with web archives - -;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Shenghuo Zhu -;; Keywords: news egroups mail-archive - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published -;; by the Free Software Foundation; either version 3, or (at your -;; option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; Note: You need to have `url' (w3 0.46) or greater version -;; installed for some functions of this backend to work. - -;; Todo: -;; 1. To support more web archives. -;; 2. Generalize webmail to other MHonArc archive. - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'nnoo) -(require 'message) -(require 'gnus-util) -(require 'gnus) -(require 'gnus-bcklg) -(require 'nnmail) -(require 'mm-util) -(require 'mm-url) - -(nnoo-declare nnwarchive) - -(defvar nnwarchive-type-definition - '((egroups - (address . "www.egroups.com") - (open-url - "http://www.egroups.com/login.cgi?&login_email=%s&login_password=%s" - nnwarchive-login nnwarchive-passwd) - (list-url - "http://www.egroups.com/mygroups") - (list-dissect . nnwarchive-egroups-list) - (list-groups . nnwarchive-egroups-list-groups) - (xover-url - "http://www.egroups.com/messages/%s/%d" group aux) - (xover-last-url - "http://www.egroups.com/messages/%s/" group) - (xover-page-size . 13) - (xover-dissect . nnwarchive-egroups-xover) - (article-url - "http://www.egroups.com/message/%s/%d?source=1" group article) - (article-dissect . nnwarchive-egroups-article) - (authentication . t) - (article-offset . 0) - (xover-files . nnwarchive-egroups-xover-files)) - (mail-archive - (address . "www.mail-archive.com") - (open-url) - (list-url - "http://www.mail-archive.com/lists.html") - (list-dissect . nnwarchive-mail-archive-list) - (list-groups . nnwarchive-mail-archive-list-groups) - (xover-url - "http://www.mail-archive.com/%s/mail%d.html" group aux) - (xover-last-url - "http://www.mail-archive.com/%s/maillist.html" group) - (xover-page-size) - (xover-dissect . nnwarchive-mail-archive-xover) - (article-url - "http://www.mail-archive.com/%s/msg%05d.html" group article1) - (article-dissect . nnwarchive-mail-archive-article) - (xover-files . nnwarchive-mail-archive-xover-files) - (authentication) - (article-offset . 1)))) - -(defvar nnwarchive-default-type 'egroups) - -(defvoo nnwarchive-directory (nnheader-concat gnus-directory "warchive/") - "Where nnwarchive will save its files.") - -(defvoo nnwarchive-type nil - "The type of nnwarchive.") - -(defvoo nnwarchive-address "" - "The address of nnwarchive.") - -(defvoo nnwarchive-login nil - "Your login name for the group.") - -(defvoo nnwarchive-passwd nil - "Your password for the group.") - -(defvoo nnwarchive-groups nil) - -(defvoo nnwarchive-headers-cache nil) - -(defvoo nnwarchive-authentication nil) - -(defvoo nnwarchive-nov-is-evil nil) - -(defconst nnwarchive-version "nnwarchive 1.0") - -;;; Internal variables - -(defvoo nnwarchive-open-url nil) -(defvoo nnwarchive-open-dissect nil) - -(defvoo nnwarchive-list-url nil) -(defvoo nnwarchive-list-dissect nil) -(defvoo nnwarchive-list-groups nil) - -(defvoo nnwarchive-xover-files nil) -(defvoo nnwarchive-xover-url nil) -(defvoo nnwarchive-xover-last-url nil) -(defvoo nnwarchive-xover-dissect nil) -(defvoo nnwarchive-xover-page-size nil) - -(defvoo nnwarchive-article-url nil) -(defvoo nnwarchive-article-dissect nil) -(defvoo nnwarchive-xover-files nil) -(defvoo nnwarchive-article-offset 0) - -(defvoo nnwarchive-buffer nil) - -(defvoo nnwarchive-keep-backlog 300) -(defvar nnwarchive-backlog-articles nil) -(defvar nnwarchive-backlog-hashtb nil) - -(defvoo nnwarchive-headers nil) - - -;;; Interface functions - -(nnoo-define-basics nnwarchive) - -(defun nnwarchive-set-default (type) - (let ((defs (cdr (assq type nnwarchive-type-definition))) - def) - (dolist (def defs) - (set (intern (concat "nnwarchive-" (symbol-name (car def)))) - (cdr def))))) - -(defmacro nnwarchive-backlog (&rest form) - `(let ((gnus-keep-backlog nnwarchive-keep-backlog) - (gnus-backlog-buffer - (format " *nnwarchive backlog %s*" nnwarchive-address)) - (gnus-backlog-articles nnwarchive-backlog-articles) - (gnus-backlog-hashtb nnwarchive-backlog-hashtb)) - (unwind-protect - (progn ,@form) - (setq nnwarchive-backlog-articles gnus-backlog-articles - nnwarchive-backlog-hashtb gnus-backlog-hashtb)))) -(put 'nnwarchive-backlog 'lisp-indent-function 0) -(put 'nnwarchive-backlog 'edebug-form-spec '(form body)) - -(defun nnwarchive-backlog-enter-article (group number buffer) - (nnwarchive-backlog - (gnus-backlog-enter-article group number buffer))) - -(defun nnwarchive-get-article (article &optional group server buffer) - (if (numberp article) - (if (nnwarchive-backlog - (gnus-backlog-request-article group article - (or buffer nntp-server-buffer))) - (cons group article) - (let (contents) - (save-excursion - (set-buffer nnwarchive-buffer) - (goto-char (point-min)) - (let ((article1 (- article nnwarchive-article-offset))) - (nnwarchive-url nnwarchive-article-url)) - (setq contents (funcall nnwarchive-article-dissect group article))) - (when contents - (save-excursion - (set-buffer (or buffer nntp-server-buffer)) - (erase-buffer) - (insert contents) - (nnwarchive-backlog-enter-article group article (current-buffer)) - (nnheader-report 'nnwarchive "Fetched article %s" article) - (cons group article))))) - nil)) - -(deffoo nnwarchive-retrieve-headers (articles &optional group server fetch-old) - (nnwarchive-possibly-change-server group server) - (if (or gnus-nov-is-evil nnwarchive-nov-is-evil) - (with-temp-buffer - (with-current-buffer nntp-server-buffer - (erase-buffer)) - (let ((buf (current-buffer)) b e) - (dolist (art articles) - (nnwarchive-get-article art group server buf) - (setq b (goto-char (point-min))) - (if (search-forward "\n\n" nil t) - (forward-char -1) - (goto-char (point-max))) - (setq e (point)) - (with-current-buffer nntp-server-buffer - (insert (format "221 %d Article retrieved.\n" art)) - (insert-buffer-substring buf b e) - (insert ".\n")))) - 'headers) - (setq nnwarchive-headers (cdr (assoc group nnwarchive-headers-cache))) - (save-excursion - (set-buffer nnwarchive-buffer) - (erase-buffer) - (funcall nnwarchive-xover-files group articles)) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (let (header) - (dolist (art articles) - (if (setq header (assq art nnwarchive-headers)) - (nnheader-insert-nov (cdr header)))))) - (let ((elem (assoc group nnwarchive-headers-cache))) - (if elem - (setcdr elem nnwarchive-headers) - (push (cons group nnwarchive-headers) nnwarchive-headers-cache))) - 'nov)) - -(deffoo nnwarchive-request-group (group &optional server dont-check) - (nnwarchive-possibly-change-server nil server) - (when (and (not dont-check) nnwarchive-list-groups) - (funcall nnwarchive-list-groups (list group)) - (nnwarchive-write-groups)) - (let ((elem (assoc group nnwarchive-groups))) - (cond - ((not elem) - (nnheader-report 'nnwarchive "Group does not exist")) - (t - (nnheader-report 'nnwarchive "Opened group %s" group) - (nnheader-insert - "211 %d %d %d %s\n" (or (cadr elem) 0) 1 (or (cadr elem) 0) - (prin1-to-string group)) - t)))) - -(deffoo nnwarchive-request-article (article &optional group server buffer) - (nnwarchive-possibly-change-server group server) - (nnwarchive-get-article article group server buffer)) - -(deffoo nnwarchive-close-server (&optional server) - (when (and (nnwarchive-server-opened server) - (gnus-buffer-live-p nnwarchive-buffer)) - (save-excursion - (set-buffer nnwarchive-buffer) - (kill-buffer nnwarchive-buffer))) - (nnwarchive-backlog - (gnus-backlog-shutdown)) - (nnoo-close-server 'nnwarchive server)) - -(deffoo nnwarchive-request-list (&optional server) - (nnwarchive-possibly-change-server nil server) - (save-excursion - (set-buffer nnwarchive-buffer) - (erase-buffer) - (if nnwarchive-list-url - (nnwarchive-url nnwarchive-list-url)) - (if nnwarchive-list-dissect - (funcall nnwarchive-list-dissect)) - (nnwarchive-write-groups) - (nnwarchive-generate-active)) - t) - -(deffoo nnwarchive-open-server (server &optional defs connectionless) - (nnoo-change-server 'nnwarchive server defs) - (nnwarchive-init server) - (when nnwarchive-authentication - (setq nnwarchive-login - (or nnwarchive-login - (read-string - (format "Login at %s: " server) - user-mail-address))) - (setq nnwarchive-passwd - (or nnwarchive-passwd - (read-passwd - (format "Password for %s at %s: " - nnwarchive-login server))))) - (unless nnwarchive-groups - (nnwarchive-read-groups)) - (save-excursion - (set-buffer nnwarchive-buffer) - (erase-buffer) - (if nnwarchive-open-url - (nnwarchive-url nnwarchive-open-url)) - (if nnwarchive-open-dissect - (funcall nnwarchive-open-dissect))) - t) - -(nnoo-define-skeleton nnwarchive) - -;;; Internal functions - -(defun nnwarchive-possibly-change-server (&optional group server) - (nnwarchive-init server) - (when (and server - (not (nnwarchive-server-opened server))) - (nnwarchive-open-server server))) - -(defun nnwarchive-read-groups () - (let ((file (expand-file-name (concat "groups-" nnwarchive-address) - nnwarchive-directory))) - (when (file-exists-p file) - (with-temp-buffer - (insert-file-contents file) - (goto-char (point-min)) - (setq nnwarchive-groups (read (current-buffer))))))) - -(defun nnwarchive-write-groups () - (with-temp-file (expand-file-name (concat "groups-" nnwarchive-address) - nnwarchive-directory) - (prin1 nnwarchive-groups (current-buffer)))) - -(defun nnwarchive-init (server) - "Initialize buffers and such." - (let ((type (intern server)) (defs nnwarchive-type-definition) def) - (cond - ((equal server "") - (setq type nnwarchive-default-type)) - ((assq type nnwarchive-type-definition) t) - (t - (setq type nil) - (while (setq def (pop defs)) - (when (equal (cdr (assq 'address (cdr def))) server) - (setq defs nil) - (setq type (car def)))) - (unless type - (error "Undefined server %s" server)))) - (setq nnwarchive-type type)) - (unless (file-exists-p nnwarchive-directory) - (gnus-make-directory nnwarchive-directory)) - (unless (gnus-buffer-live-p nnwarchive-buffer) - (setq nnwarchive-buffer - (save-excursion - (nnheader-set-temp-buffer - (format " *nnwarchive %s %s*" nnwarchive-type server))))) - (nnwarchive-set-default nnwarchive-type)) - -(defun nnwarchive-eval (expr) - (cond - ((consp expr) - (cons (nnwarchive-eval (car expr)) (nnwarchive-eval (cdr expr)))) - ((symbolp expr) - (eval expr)) - (t - expr))) - -(defun nnwarchive-url (xurl) - (mm-with-unibyte-current-buffer - (let ((url-confirmation-func 'identity) ;; Some hacks. - (url-cookie-multiple-line nil)) - (cond - ((eq (car xurl) 'post) - (pop xurl) - (mm-url-fetch-form (car xurl) (nnwarchive-eval (cdr xurl)))) - (t - (mm-url-insert (apply 'format (nnwarchive-eval xurl)))))))) - -(defun nnwarchive-generate-active () - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (dolist (elem nnwarchive-groups) - (insert (prin1-to-string (car elem)) - " " (number-to-string (or (cadr elem) 0)) " 1 y\n")))) - -(defun nnwarchive-paged (articles) - (let (art narts next) - (while (setq art (pop articles)) - (when (and (>= art (or next 0)) - (not (assq art nnwarchive-headers))) - (push art narts) - (setq next (+ art nnwarchive-xover-page-size)))) - narts)) - -;; egroups - -(defun nnwarchive-egroups-list-groups (groups) - (save-excursion - (let (articles) - (set-buffer nnwarchive-buffer) - (dolist (group groups) - (erase-buffer) - (nnwarchive-url nnwarchive-xover-last-url) - (goto-char (point-min)) - (when (re-search-forward "of \\([0-9]+\\)[ \t\n\r]*" nil t) - (setq articles (string-to-number (match-string 1)))) - (let ((elem (assoc group nnwarchive-groups))) - (if elem - (setcar (cdr elem) articles) - (push (list group articles "") nnwarchive-groups))) - (setq nnwarchive-headers (cdr (assoc group nnwarchive-headers-cache))) - (nnwarchive-egroups-xover group) - (let ((elem (assoc group nnwarchive-headers-cache))) - (if elem - (setcdr elem nnwarchive-headers) - (push (cons group nnwarchive-headers) nnwarchive-headers-cache))))))) - -(defun nnwarchive-egroups-list () - (let ((case-fold-search t) - group description elem articles) - (goto-char (point-min)) - (while - (re-search-forward "href=\"/group/\\([^/\"\> ]+\\)" nil t) - (setq group (match-string 1) - description (match-string 2)) - (if (setq elem (assoc group nnwarchive-groups)) - (setcar (cdr elem) 0) - (push (list group articles description) nnwarchive-groups)))) - t) - -(defun nnwarchive-egroups-xover (group) - (let (article subject from date) - (goto-char (point-min)) - (while (re-search-forward - "]+>\\([^<]+\\)<" - nil t) - (setq group (match-string 1) - article (string-to-number (match-string 2)) - subject (match-string 3)) - (forward-line 1) - (unless (assq article nnwarchive-headers) - (if (looking-at "]+>]+>\\([^<]+\\)    ") - (setq from (match-string 1))) - (forward-line 1) - (if (looking-at "]+>]+>\\([^<]+\\)") - (setq date (identity (match-string 1)))) - (push (cons - article - (make-full-mail-header - article - (mm-url-decode-entities-string subject) - (mm-url-decode-entities-string from) - date - (concat "<" group "%" - (number-to-string article) - "@egroup.com>") - "" - 0 0 "")) nnwarchive-headers)))) - nnwarchive-headers) - -(defun nnwarchive-egroups-article (group articles) - (goto-char (point-min)) - (if (search-forward "

    " nil t)
-      (delete-region (point-min) (point)))
-  (goto-char (point-max))
-  (if (search-backward "
    " nil t) - (delete-region (point) (point-max))) - (goto-char (point-min)) - (while (re-search-forward "]+>\\([^<]+\\)" nil t) - (replace-match "\\1")) - (mm-url-decode-entities) - (buffer-string)) - -(defun nnwarchive-egroups-xover-files (group articles) - (let (aux auxs) - (setq auxs (nnwarchive-paged (sort articles '<))) - (while (setq aux (pop auxs)) - (goto-char (point-max)) - (nnwarchive-url nnwarchive-xover-url)) - (if nnwarchive-xover-dissect - (nnwarchive-egroups-xover group)))) - -;; mail-archive - -(defun nnwarchive-mail-archive-list-groups (groups) - (save-excursion - (let (articles) - (set-buffer nnwarchive-buffer) - (dolist (group groups) - (erase-buffer) - (nnwarchive-url nnwarchive-xover-last-url) - (goto-char (point-min)) - (when (re-search-forward "msg\\([0-9]+\\)\\.html" nil t) - (setq articles (1+ (string-to-number (match-string 1))))) - (let ((elem (assoc group nnwarchive-groups))) - (if elem - (setcar (cdr elem) articles) - (push (list group articles "") nnwarchive-groups))) - (setq nnwarchive-headers (cdr (assoc group nnwarchive-headers-cache))) - (nnwarchive-mail-archive-xover group) - (let ((elem (assoc group nnwarchive-headers-cache))) - (if elem - (setcdr elem nnwarchive-headers) - (push (cons group nnwarchive-headers) - nnwarchive-headers-cache))))))) - -(defun nnwarchive-mail-archive-list () - (let ((case-fold-search t) - group description elem articles) - (goto-char (point-min)) - (while (re-search-forward "\\([^>]+\\)<" nil t) - (setq group (match-string 1) - description (match-string 2)) - (forward-line 1) - (setq articles 0) - (if (setq elem (assoc group nnwarchive-groups)) - (setcar (cdr elem) articles) - (push (list group articles description) nnwarchive-groups)))) - t) - -(defun nnwarchive-mail-archive-xover (group) - (let (article subject from date) - (goto-char (point-min)) - (while (re-search-forward - "]*HREF=\"msg\\([0-9]+\\)\\.html[^>]+>\\([^<]+\\)<" - nil t) - (setq article (1+ (string-to-number (match-string 1))) - subject (match-string 2)) - (forward-line 1) - (unless (assq article nnwarchive-headers) - (if (looking-at "

    • Xwhus;CLYtPo&nG-wg&m;CT!U zjt&lvTP(K8jc*h@Qbk$yp50Ygfai#Gu26m_5q2BkA{>n7b3qquwRo*=)C(u3wRgIy z6e^2Qji*vcHAEaZf|Xc`&Npt-4}mT|Fnn>~!r<_@5fI;xdO37_MfJ{q`?vr7T*_{+J!j2H}_@Iv~kM!R*FMZ=ZtD#uk-5gB}5BbO`UK+==* zSMK&ICv%GlzeR7P1Jl)jEzOWG~z{ITL}z z3%Yvg%2jrI%%35<%cxI$QP0-sYH)b)q_9<0Rd{(VuVZ@g z*4InRU);NqT3kUB*_hV@y5#uarHgyj4?HURkm0xg9$(Oa{BPnMUXg;1PP0 z#pbkGjCwto?>5+4>_g||!VO^!jY=eu2t*u?KqlevObYm!g;Py@cGJQA;*R30d8098 zI5#x>m%j|2KR*Qel-Xl(C60*+l~pC6E$)0~#}4pkXDNmx%c1t6OXK5ulg(_ln_Zq@ za#;-#@!ATE~2B?1XyHwFXRNGXjU30g*B^H=~e z8to<*3TRq~H`cu!mQ#2tDTAaS5@i?+hFI*BM#e9VBGzH6#bI~f*|;p>iy6=}yfI zE};_yZ5$e&%_C8i5dX38_`Q~iYyd{X9=F9j<1@g8a3GrxxdP51y+`l4r{fVZ_>!Ha zyLav^+k++I%c{6?i1Vf|=(>2}+_`ffocrMXg^Q#9Xsoe@!LOl{D=S%C4310}ytK|$ zyeeX;+BHpmd%v&in^9`JR-=osXZG8N-S?-(^-G!JZ%~grSqOMTCTq|G!-c8Y%;IM9 z=DsU`P(Umyk%rk-v8QZL1%NcA1bPikxZyMnojZU2KhF&eoIgKu>AV4mmX5f9McPxo zd)H13R9;47(TD^Bv8uEbL*)0*+4SQVE(~7+WIN)Ar*b~ntvBaU{kS*V-Eo{vB9X|I zdnzj{_F(A*44%fTlM6mI<^QGX%* z%G7;+s{jlxd^w&8WSGu{f@u_#?EI7$Z934?P%D`$T$5g&K5--zDB2A{$Cwiaq%`1M z-Pgq;Qj|b(z>!$B1S*e2W^*Cvi9GKPS&~s?MLU;0`N>3PX{m_VJjJa*s!ewIv)aQ_ z*|p0G>H5Unt#Dx_Jh|R3+|C1q!j(UE@D=rI>$+McXeVqA3k(HyFO$~(w7W2CJ8S0_ z{yl<*lYvm)?e>n34-bzFjyi&wRw-BVQFqUK2a=u@4nqd??yB;gd&+l|;OG?5o1ZSH z0!Z>tJViridT$coUZ7zA`8?R{L8EPjL4R7!1RSfU=eMsMkkQC^CJzV1W;}<>>(IU2 zj=16uR|rMFJ#a|f*ST~}xjg4L`BAsaF=n(Ht#*SoYt0i`Bn*y@t-$WuT~-O$E0)6i z3h|o9M+PsA=uKm$z-;EYM8Jj^RZsPC_2Va~YkbHKMuXi32F!}=n}5n6cGd3P&+aPS zRY@i?7_~(t7}V=+Mw8EvygHGYeO|WV&Q5s~6QH|={K$8OcFkf7U#trko6m4rKs~F* zlWO~JOeQQg?_91olJ8Nnq+(7rhD70WJ7*#e(}m&jfg$sV!H+)F^7*xFnncO@##i`7 zCz~xIRFvb0OW(3u)hy}ML87*mPwLg(ulK^B4Vi{U9dNowE@{}vqG%|Vh<&8#kdq0O z1R|kf8VNcBTZ{7xg>dfWMkev;`m0D(zT~u6^+Vd_wE2UfR&E1dxP0F?W;9&9_;lHe z_cF=ppCaK;;@)g#UD?w`Wl>4As*0V@?%eg!N!HWV0uqf|dp$X4Gx-DaZ~7BjNc3Z2?d*4J>1d(7na}4_3A|R$Dl!L=B^(}K z266Z-1(#i`{V6myaQ?!%5B}@iu)&h7)3EV4z%jr8!x5n`18!tvvpD&L%a$sc1Ofr- zY54W+197v(X)%o2g0R;YOMl!qBjC+0H)=AWj}<(2H6G6rv*av!1bN5l`TM(D-h;F5 znOHmxr#tI!&j>g`VU{q7g5DqdYY$)jb}HfxH~{`18#6oH3+*B$8^|*lY-MFN5l0mA zne5d<9OxnA`tgxbi_IPCfRt=32I$#*s5hBkap|qrVM8GGwLku*l1{-Bo@&Ajpd&EY zbSChYdef-IWR4(SKb#097ZqQMYA5?JymV}!kYF`dTTNlnJZXKPOmqBy7Xqd$zYhjvqmG* zDV3P2l9G}={8|D-#vzeZatb88lL%TY4m6&J-D%X5$hRz+hR01K17pT<*o8Fq^a@C_ zdLr+@*$QspZA#Nz@1X+yD@};dCrnSVD?*FZP~z zt4Ax_yC3Sg%;jt3t+y|)Z0^5(7a|flWKt9AHJSq7<*avBywje!Mqlnarv^9yR8p#V zKOrQm(Y^FKXKLFLOu6*vFH#1iyLsE$PLh5`#j^2LDkhc-;i+s{ zUkz(%RTP|J)(1_Q=VO-5sZmqZHk9tSI>Zg}f-VzdD_KNU8%^y$l{3H#($mWvCi4l0 zB(78G){iQ*SJ#jwZ4-CR_u8Dd?h7+=H|z|ohTsMHUeW8qk3> z+`n$TXdEf*^sn)DQVqbX6iloxtbuGErP+jAr_E&I(dR{eA z)Lbv3@sAR9E0FgZd3`e-h&h#< zM;`Hb)fLqTi@le_V`kV4PQ5*y+23-6QB}>w0mYW3 z?yMkIQA7S7g~u~(3PJHmX2TI(g=epCPa{jAmGxlZ{$r(TEtN)J%m%rFLnI=btrhUN z%ATgi1kh5^!7+m~|hs=U23ZEwItfh2}!Hl>l_;f z>}qgi;M_Uj-WZ4dTaIb&7stUVX03dSC$oWfQL>|=vJ^+DA`nYC93postP7Yz(QyMX zj7-M!gMqPOuWQ_sb>qr)4%a1!XA&$0t^ek_3oQ~sYXr` zw6bVCEd!W14CR08{7#ESZ=Q{IPxSKIJLVGoKuiN}Jw)$Vl*7gq&o~T^0kg&14J^L> zv-#K$OhJKDg~2oN7~bM-pZWEvpxfj*K&}RswOrRGTXp)wSC(@52?6wK1G{goE$El8 zz)7F`RbQa**SD6`ZD+mq$wPPZjah#t$-}dVcnX!lZ_Y1#9Cutann#_5NPz`(`HIpi zJgb`7BvmMdL=0O&TYRdfj$IrY8@}X(&EumM1P)}hv(dF;16$O}XV+jV%666P+_|fo zj3KIzZ>D4U@OYrt=}-F>vVf78SFgd_t(k}k_=2M&<1S}Z#n)sS2z9S>ImB9K1(884 z-BSVhN_k~9j*<4eEr16N4UY|v`t8FeE1>eIBRaP*3!LuHxx|h&1(PQcw8|jW>)&OQ z5tB95qY!dy7Ra{)vo@dK&L=uzJu>RHcgQ?&F&GJNceKH<127;p| zPbzX&5ovyGM;2gL{RVPRDr%^!t!+&%>pm|Ayvhih0NwWb&7luXvRyP5O{QL#O$bdeB3W#`oWy$VmpDC%pRujeT+|D&V z)GA(e8yx0~V-D}=ko#`fo_;)=5YSjP+!`XKhK$3oilLOp{h?5y==Gt9VbDB#%w>BR z%`5l+wHB}uNo^rE8C?Vm05SrU*Dkq(Ubk!dc+hMP!g_-x;DqCsrFgu8glCXxbuw+c zARb!VyFZsX$P;iCN;Zq#d-BuN5%VQm$l-K4Y_^2=A(JDJv3XsyD^e{B&$vCsPMPB; zR&^kQ!erh^%_aiJBoGS%K?y4M#MJsi*p1|Y0AyaQTd_HlehZv%JN@I7wU6&&%!zHh`~5$w~UOASUsUmh^O5*ojiF`Ns+8b z_qF%TDU!jdQ!R}=770(|^LQ<*$pRXFB-ORkYE>k)oTokT^4}8)*zYusf?nZ<(V#n2 z$Kx`wm^~%srR6NeeB2H~3&5>1qSi}>!c^?4j-%TK9`pl81%-l*NMRFAbjiVB9ifK|@@kR#^A8CfAHZ~17z~mV&)XY({Qy1 zc#ukWM#LuE@@V3WHo{#E$`nn}U)LBp8Ycxem{dlE5cLct)jh}AfZVOMXXoDwbeeMqzB3?vNj4DMsOn7Du~8uk^eiV-RuMcoIYR-Ngd&O_=IoRQHLYu?xoNC_YOWzdNN~tHdS%T;kAKw+G61RPyL+@Dh!4>Ox zFl(^4`c2;3L@cBuS5S{Iagt`Br?^m2O?Q@5m#XLR{Q9(iBrnd{Gi*M(Am_+kSESjs z`he$@oJ-UI^W&c`_hLLq-+L{QkgFxN1d*?eAC621Scgk3Hx+H6-keRE{d=PMua ziTryc9F=cvN)V>4%G6p0H7}m z_qqG{o$>dXu}1m)R#S~E2EX1rX>s)X{octQXyGeCb4y+_CGfq$N6rvAwQTLOuRmk$ z`ei`PAY7Rch+0-3So~1mauPjrVr}ME8VU=B#a#=niM1|1Yw7vcFKodR-mSm&o?VtT z%Zl6cPDJNH)V_OInvPtp`wHmt=_AmZ{dnJq{oR0j+u}Iehz?PYv*+aiUFJnoJ+uKSA~&(RfFbvj8F1yDYtHRaGfvZ$oqDb9()+FLIN)colN z7Fozr-|lEYP{HCK0>OZv%WXhs>B`J8u|U4;D+rKL`)BiRe?OYmK#bmFQ5gB){E?VvnbqhD_b{XZlT$w&IuN(tQuXv9@DC4e2Bz3~Po9NU(yJ<~ z7%KTeixmkXj--qQ@mhpz`X_#S@$5&rbf~*^+z@^zRbNBmwi23>4tv02apffV-Q_|) zo`&NY;bxCjF>lCf3%(_;R6FAf-~3nJXS3UL+!`jG$c5DVkIn`?vmENxxlR_T9%LR= zSIySe`N=8dN<2xC1RAJpCIJg^2+*N^#GIBDBO-OUbt;fSECy37RrFY+mf~!P4??G} za41y%&CC?%KpTF~o+=`XO2-oWKt`zY%>2X_juYiY}Ffz?xFJ|kvJSoyv^yIJS?UtrTE&*1PqN$;ZbO8A@a5g zaYxWq`spp6sxZ6h7#|uLu_DN;Tfyibco3gW#z_uI`X)$}uxmI>B3aihZQJhXS9XM(x5K}ai8qTg@lC`VM5Bl= zv=)!#)KnrX8=SuF@+?~1=3!^h*T&=%Dym9%VaV7jY!yx*74J_M-wl{-NiTpSX6L-s z6!nMD^}KVz>vpFT$x|tWBD&S!pkkE0wy3JTmT;YxuKy!yL;SuqqR*%B;(6K=ckINq zusAPub6$1(91#EtZk=3>#!soVANvCVGuZjalEH-dkYg`fECGl2AGwThxq~Go^5}$W z45hLf6gj0DuRSW6T$(VNkwCy}kIodsAtV)awH<}?e@lj^H+<#*9DtFOSfOU)s(=B9 zuL8C1N8g)91e!boYUTL+ut>fm|)%oIa3W-Z7DXreMV-FU@VK{x@ z)k_;U5}#!quyxGh9y12qR-fb2g^K{7JkU^acq)rbW|C-hss^M}N!7TgW(PwlWJ6On zcfc|ZOs7$U#pG~Vyg@h}Nfhovs)GR) zRIWlJ*$W3^CbJ%hI2MD=VezDr=)In$j{E6Mz>h@ZUgXBw^~>>>A*d4|KQazmzI$g$ zDYgzuwwz%tdd!_vq%zbQ1BqO$NKkilD3S z%P7jXq>U>wUc(mEG5CTbV=nX1xM|erwwPT0fIp+&EVSte zM|s3qjLIMI|jn2Ytlm)ty-UE$LC0E=LW1R|Y?CvZ8O zquonhH*6SjgpB$`&}?(Lz&ktKW^d4UM$@yOLjuVi4FgLh5`fiSNvL5mByZm<9+~jv zHnM+T3j|VgGi^7MU2h)l4TS(F@&(L+bTIt2ShE_7C$6K8cXPh_+J=_L%Es)wZ}XYb zMxgdkF;C+uSP-S4Q>7xPe)d>@BpR}g1J`bN6cmS3Z$=EBV&a=@^2RSe?oi0ObwUWz zf@CKNXsRSUk$|sZ;;L9IrjlQ9!7i6!(Dc-hxbU<)nqpfo&+St*QbA;)qO^iYf%s(k zVJVxRy>-GoZgJU-W^Xj&51>xF)8q9mhA!)hP(?-cuALRTO9@y)4d>eXZ^seXWcCA_ z(qwUkXM%~-8;4H)_4>V6&YnFHS`gnsGbg)O0}BPW%^aCr2dNfPH5OY@T1ml_5&1lM z_boVj=(sH{V;=-N2^{B)Zns#myk%bLHcn*?ZAI90774lE{D3mb^x% zVt_robJw2T)oc}m)2pm)*+6Wd)&n47=6{;MH0#|y3+Rb3ToluLJLt?S3Ie|cC_Z$C z2xR)GG+?+gL4r_oI~v)4sF)1r114nE=ITM+1;2lGDVxh>0ok#*iij(tpwT%>8b!{) z5`Y6t=d0VLlbh|ElhK)f%mv(Gpmr5=D<13eLeQI$2)r4bt#kp|Rj4Q}1}@Jl|9Oa_5HkT$?nVev%1 zPWNf*QOAL0G&7lWyMXf!`$5Psmz$k0TswXC-byrpZpHjTkb<8nEH{g5>zd?E$H0z> zudCQZ9HW*EQh9hh$hFo=*pf}3&u_Pn41#FH`0$8+Y}nwRn+hinK-xOBfCog5YGA1n zDk}i(!-6m$nbUD#ApoQhgMJhk{{c_3kjsQ)`BX5naHVVY4Q=uMyWbZgd6`(kJ>J+V z5MDa~9eN_G=QW>xXNL6K628*|^SH`7Mm^_g{-P>~L zX37;@D)1Ma!}^2poL#%85NB;-RPE``Ei^5pFcGfh8jE@YA}5KRQ> zKxZg7`K3alB8SZCA*60-*Wg ztM-78N}x9IW&d28j{Ci+LvQt340e#lfn83&+h}w+0*HT8pp`OlWMVb&T8W@Vb9j(M zAZTyrs~5goL?d>S83d{AeqRU)rm}OZD~F|;7OkXK+n|%lwC}cb>y+O#X(4{w3(dX# ze_Q@yEi?Jrz3Z*--@fwYbr4^Op#TWp>3OTAe17p?ul6dyO$Uf3lE_sg+*2Ws zCxX;VNe3Y2U`jp>{{w}~=5`=(?)Kc9a*&w;0IlSy-we{69DZv);rFIv5i~jJpMEEv zoenzvhz}U${-@a-FYFD^&;7MQ1(ER}-i^ajnv1hhm(^?oT{j_Ma8+y&>IcS@uogO6 zIC3}XaZg>De(QGOX4(@*;pB1}iTFWwW9!;t;cjCS1Rgq`LKhXY2~Y6qNw{z zK!zkSxsX1nSY67;qxp^XPmXtX@PStb&aXr%k*L(2->>DONC1fxw!1nTAP}yV>ORk< zgKoDEv{?|CT%S9u;IPG9rc@=6H}to4U0qoJc6n=U;>&M8+NmLYWUX;4p#*= ze!exanTsWIiR45wlg(t(Q%i-d+gUUa%BADWCugFc?`sx<*g-XxNW|BGC3R0YbopUJUV=^@j0_gF^$OMw>S=^GGJ*gWF&gRoH40gZs(#>Fm_X zaUqKYG7LnDfTzt}4qChpyTxFJGlk>IuCG2_%L60M>9z;ZaBf}8;L?C}Nd>@##fRie z3)53;`Sg4-u`(MEpb0qWMRFkjD28|fsZPD`k9BoNv`U=}5~?&B^}iNZi{W4_xAw!w zy<$bvtKS~H7x5=jK^XSBK#&Faii9lAm~?+-?^Td&`EaOCLzM|FQ){_Ps#hJ68#C!Iu#UERw!HJW|h3KosRW;3K+ z>gM(6wXP$t+&Z>AIgiAa=MEnERwLD(d8_fI^_8aX$s?@`U!>4nrdzCgLDn`CaH6qz zXmTZ$DqNXZlyNx}CRf_>!a1WJ{n{qABi81UJ=K3^nW z=;VP^E{Rds+%!3rLP4rAyLa!Yu3NuZUR_(LZ~AMORIKgkR-av(*gSae-4pGt*M8gd z`tom1KRVc0SFbsA=XNf=kSZ)Lw)OUchA9%YXzQ9c5!ee9aFFLeQiJVJv!0#g_6Tph{OuT{+`y3yA!jsaU>M*dAx2Pj1+FJ zu77i8>$R3o3Lka9(ckk^gG9_`)lk_S28pK>D%Ab+`9v}RCjoDW#iL04)nC7wpFMba zYWB;GaQI3wI&(}1L0m8frAm>wu2rYfYMS;P=(=@6sebvx6JI=DnwkO(DHw@(z5Y-b z4TsUl#JgK(r4%X$pb`R!O6Rnl?%O=v|K;JiAR2%Z$yhE9h+}agmw0+m<|b#hUO!Xc zbP8ne`5d)Ca-zNS$lB_aWHJ|-x%*XX_ul@^mDU&T)C*-2E|XtZ*VeINT}_38e=##lop# zHXe;d5-TYBn`kIIHRpAQ;6N~(xO=}%B;@ef9Ebt%3mA=DP#_Jxrtalc+Dd*bQ-LBr=IeV{^q%n>tsZ-dZcz* zKh|Bp|FiEuU0=#aLh(!xDP-eQfB10mW^ZekS|SAmfde89093#K$Ky+2WCsFa*zFB~ znGZlsB!BX69gR<)9gD@_aew3~aKP=d1Hl6h#ZqgJKi~JKl^X{R9#)G* zDwR^K=;=Ax+p@2#6cr&Unq!%R}UO(S1DCeNj;YhaUm{8 zrR&RFDJ0{55CBD^8Fc2=7aMzTzS4JjIyteG|NXJkfVTk4;OgHuzHQV>gj$92%t2kx z_Q%_g|9k1y%7Z(ZP%H}v;_<@F#=pM&{Io`*()N9N?D^S^V?8}hpD!)_?(mPtA1p2| z&F;VbMw>z;7YJ2qWzWk;d)n4!esMQhxI33yUYK1guKnrl*E?F;+uQHw@6Lq^GYAY8 zef|2Q(^{TP2U>(crqpWdpLF!}XkL3|@AE4sJ3n2$*>dLdcb**neqpf~iUd92;*~!( zeY{x&@tI5xm%-CCsXMNI`1*;T9;|)w`qJVG*!|+n%<|Rc#nr9lOyTk7_a~OVyZiXm z{Zpsgo0_$C^;%thqek7`(Y^F()01Bw*?#4pN7b6{dd=Zu_ZAY7iX*CQc19TEPN1{@8zIJ~RybKr>a3Y_HO-^LjHom)mrcSMri$yY-^1YdC zelnK|7w6+>W_BVoS=^Xgz4N9}Udv?zhl(Xo_V+x=fG=CWKfCfq>({s6{NnJb?fJEh z;=+73kxIu?F*LLKq(j%h7sw!WLw$oxBvy8G_ULqvS3t)BS0rMYg{kSOTy|>d-tS+$ zdE@GW!t87=Gch~&s~`W?+R>psLrH$3ud~PP6S-7$C@!o?EuCEj_$!u!jXlJ8L0I}FW zn_vpW5~Z?9_ffGpnL?8QUV^3hfsmV+TwB`iuG7e*P%U_ksIFD5?SA#O7q*{#aqCdm z{_X>fjqSR|L;Je^@pN;G#Y}NNlUiRd6qbIPFRZ+Ed+xLK>9vPH-F@$y_xiiKfBC0B ze)aF~ym`DwtCsP(oToqm5~$?r`rb3wbJ>vZ>A3<^-0P1fQgaJ;wl9Boyjv^dLtLH& z;tLdVNTF-2t84D;ZEHKeHZfaB6#%EqPfyOSP0mcG=RRDVE@TTgUf=w~$-d^cM{fZp zqt(jP60uq(2K8Il+JE-Tg>*C*3MIm+SR|aBC={0aUjCK3slBDEsjKg|`#M*auH9Hz z|L^@ea71crH30i*8(V(AG?h+H%;uN2@61hHIo@~jWLL|ztFN6n)c^On+$5+qBtMaz zzWvSS-iEhZbp1z<_O@!;TNF}VvrMYgHMJi&a_ARdt*pPjFuU>S^5VwYd;*kQF@5uI z3oAb!|J`qnyl_-^;$O`zFFyKX|CQps*A})OpMCGjqib_BKlHx(q~q{gZ5DC zZSC)E?Cv>!tgY?SufT69`0>E2i<@t*J$U@P>oY4e;1X#XgyFN<*@f3%{B_rFZuI`* z!?$m*ZXIcA->+2Zq!4I#pqDEeI$m5|n4ey{y07QMM=KxCr4R&my1YJDAQVaD W z4ojqvD!Q6_UaZsA>(tsNFmAy;k^UE6`E>pL#YAy3kt=2v9(}R0`NQJU>xcK9nVZ|Z zJh8T!T)8px#*Ky32R9BVby`JzM`Lq?vZ1%Gu|cEKbsYU_ZE~TQh=s$+L~3$n^`9sA zfu^G7^A);|_tp#XWCTg(QpJVb%qOq)@9%8u1W=LBX7Km|b=OM^g?JSFZislgur{}P z^2y1rgMT`8VC(u1v-5Xuy!YnXtwYZr+uNk=JkZ|t#qyu-tQ|S=&Z%SjI$pTGIlHov ziOrn&{M7blN0X+tO#+~>xUqNd{=XITaWsNP3WZqq{)cy8Z9e#3M^n$fqc^|r>h91r zH|szJG`H9Na{k1@mD!0;HZQ;U%I9~k=OU4GGMb%U`Dp2CTW4#Nwz;jPTP0H}70Ql% zTWfb07bnt%#Tz$Y`_~We9_?;xX*u@a``fzude7XrapUT2cIo!xUp@cw*Q>eQL_WKA zZT0$*_7;s?`)(7UP|1ApOr{8avdg#)gA`oSxoTezE)5 z!3Ssh^T`Y#BB4lfadUBXX>D=#?(eRBxG|qE-1~nkxYF*lwI%y+dabv5y}RCh-TjiA z*h!qkc5Gv?F&KjY*~}mzG0)(i)P3jN40hsqz+fAL83bZRNJz}{;MV)fl2oNSwRi1P zDo!l^{`vD4EYJMM-+uVdzy1By+%l+F-h4eh_PNZ|MJ@}|M&B!gM*`shqY%v z{^K7%{A+1#T>uFD-@cp$Q>Sb(y$J=c&qC!5-ZG2O7eBpxx5}3XkG>xs9;g>Yyw^Yd zYwp$3qBSnL{QUj!BP$;M_s>ti9UUKBW39E9&;IuJ7eD^+;?>L7OPtZV{{HUZ8b3S; ze*G4|I6Szi&J17$k!2@L?CM(`bc4wWl@t(umy^CI*KVY;*wXH3QWy#YNdUO_8 zS(snm6uNorUVHwhH@mXv_3>Z7|N6_XKY#rE@yq$~?G{JGpPPI2-~aP`?!COy3t@bY zfV0TUfp53AftpB+0e6RIe||c>I=kqkFOM(c^})_M0_4*Y0fg>Wk$pYSp3h4H(o2hojl%t{c`mA*N+G1q3fh{ zWq$7Evu7{gJ%7Pvp|SP)J(r`2u$#fp$KNk9MQxx@OGT5!C<={3RIypN! zE)O%noB6rdY}512^Z(k=e^_IHHSp?~j9mw9o`TwT`Zduyy)Mdjd5XAPZa6=GI6VCN z`QY&IHV5uV#Yp&SrocDX-@JJK<4@1nz3b9)B?Cl)5V*~io}b@*`}*bkO&S$*C5oOf z5RM#uWq&w2ig+T$O&LQbsqrW}{A8<{ovF(r&$l}tHHFGG>Li?iU_>A~lV za3+)yEx+RO-o5(i*~0Qq&)=*py??(Ti_qn#-~agI_m9V4zZFMj z!RpGUlFQ@qly+&)kqEhYtE(S4YfCE|x;~M_vUw{gQ<^A-2i!iCkxU%*)2Ao5r(Z*t zCpFkIg}CCSMbXOZ)elSauRpw)e>P9##gpLq;qO2H^2eXQehfxJ->vly zSz|x&{gdrGyng#?O9O1IZ2}&_rp2P!MhHB0b#QX@`OE3i@zuenlau2Z4QwpW&n_Sr^k`p^<5}F$YkJAQX^6- zKD=F7SXFFrS2tRPI9tC@FYX_5_)Q{po9!Yd)%w;3hqt=PU0LSvAiP(K1g}F;(mIt% z+&C5vUtWZ6?-Q^qQBvqSkQ$N61*@DL(He*IVGU4Jn;K{=&0JM8Rhh1*97Ztru;T9- zna3onpuYU|$JeXN`*7MN0d`jA=NI3xs%!D({M@To^Y50$S^~!}zMotMBeA;>k-d#x zT$Ue#vCuU;{d;krq%z4!BnSF-1-wnpTXxX=#k(cW2C!$+Hlpd!Z8n;3Jfw1|3N@m! zbfw!OkQSC~b~5Qqxsal_d162eDgb2{Zbaj?Oa!MNZi4Knj9zChGD&i`fvOR*F60Zh zmKNT!osqd$Zx=T~zKjgU?~lG;d}lGqLiN+9&tDG@kMHbOIaem;t*)){xKfDA<1eyr z@n(K$WnpU{+!pe7#Be4S4d2EdLf2Pk=ZD{d;q!YU9KF5>pI%4f1=1oD10uoucbs>x zme|6_5pH}~Szp)@xWYdjpjy1Zl~5ey~o?#C97-fI-uGKo|rHC-2QmzUQSfSkXw z#@}Ay+h8<&b{#%Df4Dlidc3_Zq_J)TwYoHJkk3AMWr-&dBI#tBzyo{!iCe@2HR25^ zAOaLd$X$(wqxaV*-_OpEFHVB#NP1Vt^us`FRZ*I6VBdE6~Uxuh?W5(5f9;du5T6g)Y(xwyIu-`qaNFgpnDDm0)N zgkik|0C?|Szgb*a;Ru8%frTCtp@(p+U9L1?aGw~KG1#8X(*?HMa&>n0{W6;LNJQ&= z;VLkZ0Q!1BAdzozIqV*hxcp5}zA4-W1X~I(GVEys11cE}Uz{C(KRFLq zJ5|Nb`r;aQ6HtLB!?@N3(TYwXK*D#)SS%i8dBQ8z*hCT@Un0~D^~zF)@KTgUrW_g| zE91A)G?pmTsG41eIGQaYSF4nX!ak@mnaK=6^|9M@B9g$|N^pI7WrgL!ZLNpM){Atm z(xYG7AmPupP43Wj<+D@e&9@B|rMGvX~p>TuC<*u_1OLl}HVyqOs zmUfwH5y^BU9FE*yg|G}(v00`jtx>5*_LM4vO5tL;6*SxSj3vJYl&~vm=-0ADI>NGb z0gK|Ps;-u9TFVp&Kw6a+g!C?lt5+Kk~?MJX69SGsSr5 zJ|0hIh(bLusdgd6wEu1F{nig)(x3?7Y!Z(^*$32Ltp6rQ>dhQcu{ z*Ve+i&GpR<9$yCT8U|CpTZKRdn@2muVW?wrAZ$ed^?M3nLxNJkq?-5HHBxQ_Ybj~ zo77v}hbJ6zVO5M6$!@ z@`T$vLV-{umgo>KoyQCL6qZV+5?QiPt}tXepUMZVBlg%m%UmjkX53bCkebvcc%!_95`)WtJz|7Ih)m58L#9pJcZ!} z#^bW>0iad}$Uzw(V~+q7h-6ZUews}rV_1Rg5Bpu}CcK2jzrQYs9t*H#1VGZC^I#DIDa;sjmuo=Ue&>^mIYkxr3 z=_v}^28|IzG@E3dDO4GntlB3^K*~l#ER)&w2G^`j)%xk^LpT&oq!Otj*;graGC;B| z0;Hf+DhEB|eX3F=YE+48Po^%TyVDqwIV@kuQgq7$Jxxq7YSgnu0x>u`YG0@IG#~?B zn??GHT;to!Q?Pj5EvIck**mWU)vt*Han$TW~{S0V$YGL^H}&0z(GXt>&A zr$^^=Yi&+FYOPl(oWSz6Vx?5={ku9jU^T2WC{%KV4wQk2qsK4=Ri(;QgJs!#E{owr zfud)&sRMO*Mpm;8QEK%{XctBHbP(&1)#UIwA;=6{9VS1KEn+MHGkK~^JfSQDLY`hT zpDX4o1kE&@471-3I9V5EVhI~CKq}icj2)wTquXjX3uUT2r1LepJLq+p230GUYQH18Q{bqwuut8?;ajtW)l3V3WVr z>5bb=x6$b^wN{^=xnPagJDWB4_eqBC)X7|yrprv(Kb*KcuwJd#Xu)0eu3Douv%ktdCanJki|)YoCQpX$?r253_879hrmXavD2y78M5E( z+v&Ey1>3A1uM05-945Wz$={~RExO*RQq_^!s1vbu z>oulI`aJI^p9uvo}t(m1>AWmB<2R;yI2?lnM&0z#A;r9!EJQ4=!g&zkioN3Y}Zw)%dW zBhM3t=fYh91oVulcv&Si$|CX>lEW_@Y2y1nkSTlTxXllFeQ$B-4eN|0o;IkH+1 z#Abvo2nrdjkY2AdLI%Cly3aHSs$66 zm|B%?SINe-Ik7sPTzUkBb+ArvbB=pdt9dxHtzt`lPd7dn+Z=R>#sL^aPBt=(SJ!ZO(7*SSaz&b0! zW)3UxA(sUmOu8gZk_DnxqN~jsQExPB!~V=S>rW>>j|pXA2WeDl1&dC-LW7!ZPG8sE zp=(SzT`uL>xZ_kM-zFP0?e9J9JMDId$7MqPeVZPFbt<*is8hox#OZU}2g3$aCx~)6 zpReSL6^6CbnR@MZpTlHA5SJ4%S=l?S4%9Up_D8;P+i!K*b?%vCzuRlmHL_l7)$0S# zbTae!?T#m}f8um_-DqGI==+CulN~iX94z0^twGl}=#7VsacB56YWjT>3*yk~jCv2^ vcLj#@z**}tLweX@p4c;T{jA!U4Ts&n-Q{!5+z!9Z)I}#Amv88Rrq=%lFS1yV diff --git a/xemacs-packages/gnus/etc/sounds/flush.au b/xemacs-packages/gnus/etc/sounds/flush.au deleted file mode 100644 index 372f3e52fc0e268d4f3c339388652b1a49c5ad3a..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 44182 zcmX84cYG9AmM=c)#*rU$}VogQGncufBgCy8qSo?#{;Y%HrC$IltTEa0R15pV#Sd zf&OSJn_0_0m=C*ME_Wmzj>LUluixc#I()IYaKPiT+bkA~$>{Ls8~UV-sq<$!G+$O4Y>p_=HlU*F&Rq8Wl85tx~Hs zTJ_}E$jJEX2YS^cG-P4|y3y&hn#qaD@ku2#Mx|6uj*UW-q2bE$@$s>-vC+}7*Ndqp zC&z|Ipm%7sS~WBZdNwkyQfpM>LxY1uqZ5-8DxFq2F*-anJg(AcbnHW1}OZ&}8U!ua}xo zLi5x*EhG$R6tuK*Or=$6HUGmNL^<^5apk01{rYuUoq7V|K?_L;;vTwx&CJAv3L2$? z7}h}oom9Sl1pQY*e^pMZ)LKXmYUp}>3yDGt-9y7)v#ZtWwa`+K1pa68>sP*(saB`c z>vhm0jRum#|IC2aRcmy505AZrpZw2K(8?NUEsYl15dbh6p!?UWL7YO&LCfd?liA|* zxLgj4K@UlHa$TN!rKQES2k|Md$K~+b4eBunixUts0awHy zpUbt?RyQ}FTVD?vG?Sx4kZw$90C)JH=H33b1(( zx;Uu@%npx#^Wf)Zxu~(_WN+8m-lm4M1JFzi4SezW=U;qrcU&E)LY^o*bofX?DgLQL zHF*28PyhPq-##Bu+R}V9qP!f2K;xK_i?iG7>ucF5(C4xmRb!Asj;H{4>Q#U~`y_I>2VLyWPP|6m;7R5NK^ySNta# z6NkoD5(SG6{p8TVmtTDG<-nlYxk!VTo;Y^mLg~bxP7alT!&9id-r11LWO%J}5Ox8Z)0bGkck{y= zA9QZaMchuG+cy2nvuA*u!(Xms>j23q)&q9EW^!x@vR312vv;9QK&MhkG_Fus#S_$=Uk|yA+SjHD zg1+AFihdxXRv_Ro7y?P;cP304)oZH*VFWNkAoI+1@rV^jG@d}B$quF<3_=zLQrU4e z;8|!FvWX-Di2`lKgG?kE4hB7t2qA(YJ-3)$(HS`f4J$2$A&KI9K8tp8WO(rI;PBX_ z&XsKwa%c<&jZ7jCsBFcoMF-jSk)gqnakVWatt>xQaHQ}!j2!|dM+OH5?%cjTs5CFq z&}F4C6s^x^HyMm3D`XZt!E`;f5{V`@M9exhT9p#gQ4}+LklVHkN~s z+n9W9pS2KOVB#FT5&=hI=`G7Ma|e$eE(C1a@!{cdjV-+XOXrzyFV|O*D$x}L-nV`$ zpob(iF+QQOrn%U%!ouU_SbFse=ysU36C)5OK=3q;Kp>LIB${HuY0*y(4-VcPR$3bg zh_aHRqN0*g6wj*~zVpQwcZNn)I=yqYm5eMdJoL^xhmXN&Gx~|)+Yq+y+`coUb*<6L zjvqg9`0aNJiZKcGozMRE*H8Zr@vZahUnZj9g-70b^Nqu0%!J1PSvVzRA0aoS(-{m7 zPeO=A!pkvTVBq27AFj{&jCPArr-8sVO(`opa-;;!OuM~K$Pno@x=Ecg&|gI$;MjFP z_^l9gljADA7KmM7Adeq;`|Y>hI(!t)bPj+1=l}X6bp7Rvi7?{uzyDw8`j>Z(Bd=Qr zKmW@g|M-VL{q+k?26GJJ0-_a3;xjse0OZKbNiLqns9p+L^{-tM060U*YC0NKT2?{% z-lv;@6!bMD^}goHV~5`S?K=esQOqzoG&pek&WLu3QFiq3p(918X6M-L&;I(CzkK@l zFGsz!<8S@TKmX%D{?o7DJWlsc41D^hKm7jpzyHIZZ%^h?MTg(`mtX(pU*34T07eVw zM(=(JUAJ%FzB4$k2ft-i!b*!vP$(q4{^^f@`rDoHL`A_H|N5JM z{kOLYiYufMn|f^I?%jdAgJXazlguPQuL*!mT)dBqEpUi0&R|LssY6CA(u_rLttAOG;5fB4hi z?*gxg#f66<2^1bJE-5W3M^oFAPOWly;5Nk7;K;7Yi#se!Q^Y@Zo~vC{X}VDIsUA*FoOk&VOTU+=)B<>;L~B{^9@p z)4v=-PEUUMmp?+H{NtbhJ}~K#po)(b79J}pIbLw+?Y9q~Kna8DL1^hu|MKTgKZ77> zJ&QU1=CA+xpZ@8efAdBGTxJ~l{ICD@r~mrP-#))RFsydeqmCbW>y0wWx>|M>lX{^_&HcZ=Wr z=l}D+|G$6u$KSkD-enmZ`26pm{`IdA^1m3=`YutCB?a%i@$bKV^PPec6yu^};?Cdx z@@EJcx1rbO@_!UzVYTehYMk7 zj!&zE_W923FCk4-+UHvtL`-=J1mU;dc>5@#(XJkYLO<=~7-XPERHjfH9aU0RTzK>- zWQUHG($-Al5WZf|9T*r?I>m^Bw|@KEH{LpO0?Akd&C0RY?r(TxLaDPjqd6HB4J(26 z5QV3R>)Ovge~|Rsb;{Aln)dg|d2+C!AWm_l%84mqSWZ1S2+NJqF0LjgCUnaO9a4u;LTNkPg<&fNm!g zNqYR*txN4q&8N=aNco`n)fY}*tQE5u6f%J#eUc0X!hU}=k>{&R;CA=oA9EqW~uLf*pgASs}Xm1_G^sNZX|nk}xW^xEF)^u{+$3_KE6R*oP@)_hhy6o0=y zXIN8W0z?-ARt~v($^DsRz~_KM6RSI%{z@U@FnGQBl+W$)#P_9a8kta8QAw>`2)N98 z=v<(8X6C+r^sr6Fq0*o*g-T`D&4v6>KxeYKroyq=)eqacPRXknRHnGL?dkS%Jd=)2 z#nSOaG~|yjK9LD|!n!&Mi$-UNTR*(N4BB54JG-#mEfaEuqAH$H+PsmCMeo;1MNB4F zaDFZsO)sqFr^9}q%kJQX%b@F>hnZ?ys);C^fq6o#Y-*a4MF3)sW!9WtJ445<1_*?im7Nw5mqDjfNhA_g)E{v<9UiZHD)qRhLDt;T+SPgayPa%y zX8z&x?h8w~+)kUEFRATX3OMa9Fmb(3*7)OE$Qzlt&ZSa_)T(n?pEr@+?BAaW`MhA} z(fuxYQ^!}?@Ko}Kh|Olw=^PO>do>nxL&q75)f3&Wk+G>HEE=*R{EfKZ>rZA<>ko5V zxo9{w_eut-1C>$5W=X5tHqwd6>yv}a>x<7W=ht@Im=qEgOQtcTP5CL0!)~!VoZk3a z1BXH+&>$UAbUd6*MSLFU9Og?ts^xI21QJ<&wXFTc#{K1NIu;3o!R)gSALKXBcbsaL z2qDTY-pfXOZs?2=Ot0+JbE~)vj+Dn>F=)KzQx9XlsgT!hwgnd#H@ZY(8H>hbvISCU z=kl~4ni5LRF3hiPJ*j0fXiUDirlWT!?oZ}k{CM^3nG5UD$n4|Ob&A?rS^brrmASP! z=-d{KXYyY)3+ozdpska>7l#Z;HlCeb+S)m2;0WbaRRU?-FKdg*sQ~D9`TUW@wnD^Z zv0jUj!I5|NZAL(^+v#+Nw=Tc?UY&@~rgPh$KV3t{OhRIR(Q)!ZUtf!&{`&eSeK#+kzi{ryl}vVi<;CR-Cr_Tf(D(f> z=gxhyxiY`};8I&_duv^NTW5X4FRPik{ZB6ToN8)nkt-B3Nz>E4ha1b8RCZ=zbMJR8 zbq)10kyIv?$XXAcoVp$Ymsk9$om8%I=LuKR-hNFgtmleXSMsU!axC^>cYo_t*WAsz z?bh0tmo{?Q)VnMeW7hqg*B( z^k-+|q0GW&Q(bL)OLcASdk6QY7Z=l8(804)-c-|cTHbVJcPX7%zH+ujCKp#Xb?2`A z?m=(ona0*17qYp%lXAKI>|!Q8H$AuAf8#>6qPDrVrGYP!OI!OMt?jR@cmI$`Ya+&A^jXZ99izCbh{jmJ~7YfY{7vf7#^nYbrE zyL_wvn}tyF!3U>1WL&oF{T>-l(6G05&|KZz@x#h$CY9@y^+!Ema=rKKx$G+mi_Vmt zY-(t(Vv2g^p>ub`&D>H7vW)k()>6|C8><8Yd3%doERyzbtgUaY&&D9ICYN4)0_|9? zTS%rg-OuOxPrZBc<-^?OgSpvMIJ?$g*ZX2MyDMXHI(F8VcY3;CzQ{+yvt4KQ)6vZ1 z`nF5my9;ZdbV%iW_ZRQA$e*TTo87lM8ZNEJV(WbhMdxlNny;^IJ;={3ZoF6D(;@1< zcIv`+ndyg5+GI87*3yfQPuAT?2Lh?Qgx~di`^<~?=wBMURX|rBkY^ z6=HEq|120=n9l{hUSD#d;hV+%xwTsz?H3!`o-0^Pe%mY%dJ>YLgdPM=jYU3mJk?b6Iz z&w2*JbbtHCN@lCSN!Zxl-qCV#bzyZWJH0r++}T@K-5_A_6m@kS^0xJFXX2~b&C}N( zw$(Mf+uptYI2{NrFC-qFy4llo>6_NBW<}k##ao-%)t9HYcI!KOuI6V}_SerfzF17< z&%C>LvF-eN|K%Tl`sur!-3Rkcb)6SyPH#tdK<{P0OObchb;dbWX|eE@=;R}zB9N10 zAF=bDw3C}Py}|hXL_TJVY)@af(bjZ>FJtrHU1^ile*CJlUew#52xPLM@N6WS>O6V5 zIn&%Ep)jOEmPpXhe}8H2Tw7)>l8G#zeQ>e2X@BEUYo?7Ir-g-?GfiOHHto3?KQrIC z59L8vP$Gu&9l1Wau^COpz@XTjT@MFRt83rSY&>}JXsw?kQ`BGU{djG&e^ut$aNnPq z-CmXd#8S|t%#NBS&vfo#e$}%aUYeheB%7A%YG!hCimg-G^`-N)94pqdDQasHwN}xo zJbK5YmCHTP;_>;!{Lj8A&*kOm*vsA?;w7enSIz0}?EL82vNt=&JNRlXUwhDYYv${l zY#E=Y5OP{u1ljYRxF<8avl3TyGtbIIS6g=D?q#<^K9h~k0zMlUU9T3&PSU7SW|y2r z=hiV-H#}ae!wJSce&^!(+A0dXqzsO0koe7J$i?eykPF*uRkV|t3hMX5AJeA}I1m)97m`Wz5@4~Y zmX5pNWz{6vsaYb<3jnIIOS^VERZd0VD=bme@4|?6Z}5kQ_oR*UDOMA^)ab&V@kofe z$ACTWU1~U$L`v7UDut1&yWYzb5S+5x1utZ%)LK{1>U&|e&-W9DR8v+(M3Qf9DmDzPG+g)jb%W|jn^t9PmdK8wJvJ^XUsRao=R_R6|83uuk*BFoFeEYx8bI@$*g1x#tT=6i6w zwVZZ9F0FV)3judE+Hv6%{!9)IHU}_S@?pHS-;$6RhfaG}5@e_z4ukh~#iK<84Ki`>h#M?_T zrG-UoWMp*x&fw(juyU_V-h9G&Oz1l9EqQv*!+iMnz|UquTcL3zu(H>L4d zT?CD-^d}YrOfD`|g@E{>2f6~W2Mvy~7z^d=6FrkazsWoILm5!_B#55ES5_j9!FDy= zK~=l=P9@w#bL|y)=|*}%_5^ao(5sz5nLjPH0YtXD5Rmb2pE#~9Cb+SWDG9LMZ{X0v zG9p@|UY;~vM_L##WeLrO(+^c@t{-Z|RVX|x`3Uidy1e|3K{Ws@*sO20Y{A^C6sPiP zMH3n+vnnq!K}2}X<0{?K7Z;k0q*p;A?28E8SwQEBRJywpe!IQM5zaA+g6TQ|_5=!U zcTapmp2p&?ud9cmD$7BCM`i>42ouqq@U=`(2FOyP6ub?ro zL*rIuf;!+o1ndazFO9ir#kA!TgznaP53Y4X17iKtM&gE5k2w-z61T)krqE7vO*rv^ zXoI4Sg0vO7bZ>c==um2GRI2qIW1c*W5S;eLRQcO*ybb+}t>hb^hz6p3_PE@nL|&TY z6&O*K<0PtG$V8=tC+BVZptr;1vuKbjYDY!6w4}Wbri;%PE%?~!cD>z;@=j`sXc>fn zxwou~VEgVAEn4HNk`yY5ErZPqdj{riKR`{P=SZH+X`QS1^NqKSClG)f9n$v~PFUcB z!Ah&~kU+40|>p@pn=|X|pJ-&sGS7e%uuIsV6;l?1Yh4 zFzPQ*tGxmbXUfSJ^>Tp*#0_+5P^i+N2R+65BV`lF7j>o_I3|}M;hsm&2h#|><}mT| zL+r7t`kAXmWauCYl@#=9X{5ct@XhzO>=RA!r~rwoTpW8ae>YVy$SKg>VJFM=VqIC-1qo*3?$WK;9s3g*Omm!~#!)+>l$|Gl{PjSFpCo}t8PeoZ!2qz$O zt16hv(&C8=rHTn`o6=L%V!)-enzNWW8y23@A<=9sUr9#YB~Uf0<`yNa&(l~rrG^(3 zwb16=yCYfs-7q7DfW<9b*jg;WDc|jualkl6JbJlPhvM1#=THKmlgd)RsI|KzrEv|t z6@XR5W$M-*g9Du!Yp=nT)6qLxzi28=c4cSisMSWQ8>+!<5;#~)JWwbYrST?xMHNmK z8c-WtX*Z&4vrgKw_}-eQt{08-{f?{y=Cus$d;v;cCS?ZnYc7pXs-Iy!)v?)gEE?N# z0RbvXz9CZ7aVS4*CG|H|FUaz7S3Ti0ri@Qaj@nft{V53=1t+ghx>VkyU)?KjJ0pDN z3oU-jBD~+#+7^XsODwrht2?MaT>_6&a92E4*@QLlBMHQ-qD2Z_JDwm_ zH2Q$yyZ6v&Y-tuCL@W$q&KIDUp~6exZEis&=@4;HYadhTHN3BkB_}YYD_5d5WrTWe zKslgaR;fY5RPty+!4Vjy5QX|4(A*i(=tn~;b*dgkI95`KryXy2$Q@F}wO8uA9@Sl) zmy-9<#+>AeQ>9UjPFUtl zei8$D46EA@{7;kcQ}Z6q8SgvQ}C!> zCR8v`Ywcg$wptA8{cOjH;^RO+f)G~ubF3)>l`$h@2EW!YVgBGAlmaV2m6UKPG<#YUc9~tn11i5} zghiNQvMONYN*J|6#$VuUOh#5*T9ZpVs+GgaOOF&m2|pxTmd$l*@7Vy)@Gw*-y}*1@ zC&d?)6UeA8TT~806@0yhIqRXUm{_!H*fJanJtv{LW|!U0e3dAg%xmmD3w;O8|tF1Al7 zP5v0ZtP(+0ggl@RS4P8&L-Fx1_3B|75{D*os-v#13=PS{;K6_^){+&|DGP=zm&xR) zVo}*lYRp{|b#XcVgYJN}zZTqDuI+WMX(uxgJhJRiA+i+iv|6Bq@z~f9pfy9=_RgV0 zhbzgKAv%>G>Br1NM#Ct8gb{xG@5P0r2FHYXa?+|B){pC?_KK3yBZrQZll(4+mm?5X zZh3&AyJLfsK0Fm$46A&IsgzJUoEa9Fi%=(>v1vSTnZ=+fS~YYiAdSish*x9+R=%TXtaj~&O+B|Vp>j0?)~ z^r+?sBcqCR1PPUk*7QqS{iIfJ$Ug-6C@QS51T9#6JZDf_RS||Y%k)~B#aXDrQ*sQS zVBOdDErB)hP6c+{jhIwVfwSu2i{|#kl+K9zZdS}>?MZ~hidlOCxDBk& zRUAi3(Kn%lttiedLvTzQ?H704!REK#ftN#BQP90Kt6#^e@2Dn+z!SxX-z*lUuIgO^ zJ~|ng28QqGjbKT^krVJ0V+SbUid%A1jt-M@Ih-Sk=*z>pgb7zzP{tN`p^89~#V&`T zF_%0OI#-x<0uynm)nmGg-~CQ@@$^4bF^&A4Vx-in%|QG;$W4W~wlaQx5LO0nCIqH%LDZTA|7l~t5T zEvFWTKvv+GOV|3D-`a2Ny4Uu=X>vyA^Ew_^8@VJS170pur5Q=PklNkiU1&^4XE2DW z3u1m7Fsz+2Xr&}>4HFGxZ`2@R2O>n36&TWbM#p;hTnrYrV$Dt=$`xH?g|xMv!kWp$ zm;Jpa-RK}NsX3cvS0G_<6r!kvPDU}9DXVUB^$`yQbQiOpK4GFaUq+4Lsae22?8sxx&UNmW=xV+an%RS23$ zbnoTJkYzB2s**U}qw2b9Hr$aYJAoyWS5|8*Se#t0zpEP`r6Ax^kc|B>H|o1=+2?a_`X+JPxY!(0B@&{gY`>t=1(f6hOcNxPPMK&PW(S7B)6jhL#{;?Me06q-_d);@$BHFz7L^ zQt9-vQiixDkEyIdlo3@>VM*UkWKt!}=Vx~PX3wk$)Aym&tkf~e%gfLV@s_)lmi2aB z)2b(+QlU+H6!K+A5~8w>dEXvRs>ak4BL?rn6MW^WRb}NO;qapcN6RWsxhHJSP+a4( z4-BY592_dmP!dw+T#$yj>;_$ik%8eQRN1leO1ZzefwmhiDxcZ}N1%dG6&h7gzU*Ff zO+ER!A!%KLaxj)~ExQ7CtYl@MC1x7(u8$l(w^wzb+yENOgNc~ zqV{qhXOkAse4CWU^s1E>je}D`fLGFyvNmQ@uJK+g!T-9ZJ?XiX%Wp7=6{YZFmBO4i zp7h>r|TzqXr+CN5U(SqI20yB~pHp8}&|kz@MLRfLs9R zr{D81GnbDMJ*1NsBNHK0IG58eWvloPG^Su!>$JuyuHp+1qaq7y8;LlMmPkEW(wi2C z#)*mH(gKZ+K9ed&mZ9Ah)Zo_KAP~~U>if@0dZMs0O8M0}TP7B6)vlXejD1b=(iEQ1 zP)4n$8|4PoJ0c~+8L5)^rhq=Uq^x*YRqM=F=Fl+X6iP|SjM}`&^$1+3)d}z<90`d7 z=+}CMn#pFW`y-trrb<#u30!7*v){GKy<%O32a30J5&PNIBtkHrAgYNy=HhZA^M(tq zRiQGPqTksF8W&pD0?Wz~IbbCOSXyaQ>?$3NtIA@8iV6~10va;SbGVSO&G@4RG!E{6 z!=u$zVC7O8qwF}6-VbWcfF`Ll9e90)DfD>(x}+3C!15NFlT$grS`X+9N@usRl}<*& zs3`Q&BJ_#2ad1fOoB%wtZimwdP@zAaC@91yLdrq=g5c|<%cvYTDU;~y5UL6o6p{r) zoF@UM(AcEbppS>-NSq9FB3yx}fGIk>P|Kbbur;Z4ZSx8wnkl6e7gyp5Mqk&WwddZb zbws?>1e+-@Dxrwmp;jagBQ>Y>-lc^D*-I|p^s4H{LtZ^Lwqf=YZ(LMTNS zAtZR0-2)Yh)H=&U|{ImaL3Wd5*zRaxer_0U~sYo>PC|*RNc#Ya2sO2)c*@%Hz;|TYaGIUvm z7`8qb(kXqQGnH>^);lF+`LRP7u2|~QL4|N2bP_yYq1ABlbi@e+KN}>r+eC8rQ@=LV zk=RARgCp$Y`<{M?2rxK_hUCAT6oQf*QA} zsa)7q+azhHGG`UotcUfj+ZqyqT&CmldH)SMEt_j25}lbyCa)0SvtVslgOv%2A-(RtD4z`8x;a5!Awf~U~nZ0;v1 zhRu@-fm5sAuG1bnjoO0kB`{(FMQkoXJPF7iSx=MoIznufQN_W7LR>J*UH4z$w8hqB zR$$N5u+>G0F!4OE>>D3rjfja}W!uzMF&mF7&d8W6`?+N9BO3FUMtR!d?)Eg*MO#t{ zahnXRMR#+_wNZsH#9K>&8*X1>fjQek5s+!gRMaiQc`uTr^6)7Kcyc+mQ|IhB2sAW5 zCs4wVuwCoYsbuclx@^t0`(!E0cfG<;msnlln;o-GszAwysbUyQ3r|@Gb0qj-l-qIG zYb|p(GarBK>XYl7wEBf?kRSuGQt)(Lz?WN2d1+E}CsrZMKjOyi&8af(kJSgoRHry$Yru+z6=<&_l2E(g}O}7hbyW-LhL2pni**hb=erqz{Cx z?+SAbA>ZY!FD?+bIu|OhEE1UU#ow)SRy7|BjAD$5PPe@;iCmTN5Hk_sdhp`1RU&vM zmf0VlGF@iYh$a|7$#)Ysi4}43dPVI7%j78vHI$~q~g{GDGq3tg-u&)XNkOp zSAjJInkiHylxe0q**=G*ts>voQ2NH_%D3-fIO}TDOtdE4L4AoPp1+c|dCu`W!tKq> z^z2#xkBV*vnN1EkVh+_by@Sz3m=1cJ(5x~U?%UFEwl zkHvD6B&!_<7(P~1LpI^Gc}1bVTpcE!jy9!DjPJ5EN?#J!w#e_hKiw`4$NesE>r8|O zCeTe^50V6&n7#a`%`hus)%i-*00kPZLRZ( zx}{xLC=upv37FpGfn$Ltz9i1pJ&kSp)= zu`6}-bE|An*KP)$*aBPz1&_eIY6`}eJvpcGtM4002h^GrjU&*EORx#J&pNzoKqoubJitPL?5+^r!`+tvnI@qiS43c5d* zKkL9h<@N?<1KF81YCWG23ZC?vVgfn25|2x_HQZIXfh2KHO!3@%(8h$EO>rIAqL~;_ zfo@`10ivDJ02PXvigeBz)eRWmO;#ch$Yp|i2rbnh**1}F+!XV0jzgs$e9x43Y#`0I z((pQ+J1ylv9a%@QT=&2Tr~z8fzlz@K1znZI%EIH!#RoS1h$S_RLN#Z+cAvw*-1Xy8 z-z(K)jBsM;5_kY8!N8#fr78_1PFv1%96x27Px9e|G@D+-BJo*`pkk~S+d9w!e z13lCzviP_j6)uO7i-8Tvs1Hq-G69VhsJeK$T#?5#yRW)ec@8p+K+{jU)YB*mm88&3 zZyGZDv+W!dlIqs`g5%Q3+lVg{0tHjSIJfTJIW6L%3xS!dmVX?ptGs)%(uP(^M)QkL4A9F8lROH>OJ zwRG^nH4}lun=5#I)lrYtVS$trkEft0yiOryWm09)c!R$F7C8z*tfULuL$Ro+1yK7N z=9w@IgBZwhtznTl+#X?~WngexevwHFTWyb7GH1eJZ(~6%VK7Q&H3EG{pw~KoE~#X~ z95TF*iQQ{=4=bxZzr&(YlmbRFHD&|i4V!0#q)7nTia^rn_EF7(dJ6vvew^LV>DB5& zG7_!`)!Cs{`OI#w3@S58NVB>6dU);i4wrFElLe-V#mu9RTb81YCIyY z5`4V%*?QEZvaCM)7)d2!d*s|~dM~U8nSLSLyOd&5Y%+>&ojOGjx#aT(J}KNmOaZJ4 zX&pm69~04Cj}uyz{a&U^SixyS;6>NJ^ZLb|B61|;p437uNZs?Sl42O4b|$5$W-u4+ zD#wIcJQtPE1{3`a0V436n_+CI#|!I*kG+$~sd&FIrbzYJZ|+~%m7+@I}s)N7>;y! zp#F@;GPX~y8w7_{EL^J43_G!2x_-)(w`;hPE2Vqx^SYn_tSm$)Sqnp!Z!{_%o`9q=4+gzhJMD-gNgRl@ zsmRpM;-hRHb;fKIg+_g$yM}3fd70=ijCGiiVGn672Q4gcaOIGulZc&I67<}qh(wq}aVZO8s$7uNIqZMA&)Qo-{v`^9TRhyM% z&wV_XxfTTYk36JT35+}eM}jk0P={kX#C$`j!=jxsYM~rSQ3VMh^qYbBnhwZ%z72qM zX)CUhh-L&sHn(C1M{+Y+75Ooub%k2^v-5ha!EO#u)b2!H{HpbB`>*fw#EZoyw@A_nfwtM?p)(EAa+$_94Nm zjjP>q#&OL1u$eT+F>4slhO-FtN~mLwSOwX=pw+psavqIppis_IsV=ou?;%Z3MLe|> zBmpV6@@^!9Y0x*b%)rZVXKf;1JuMfrYNOxzYw_R?xf5MJMH1a*A&d;GYF&2@4e~40 z@}eLbZB{tUxWzLHBTr(2Gvhn-AZ})&)V6^SN|!_>nn}U}fCk;HDOi1^092*& znZ@@udsQ?Hc#NdauA9-TrouiYhxS2Lc-lVTIszQLV@~4SMN~aZGqBs>?uT8p!cbK5 zy;S(lNU_FNUK#)jDY)iUa3sEN;bL9M3NC_cU$=pVP=Ror6p3G)HN)e&UMUUbkUU4+cCu$({3+G5-VAWWU167 z9~)z|wTp{&286PqQje7y%W79pv3d6>E3GXZ@ZS`Zd36p0xP_;NZco1o{?q~I+S zhtEjpRGC^pFCz&keJ7sX%cH64Jq1_`l1m)z}gj5zhN9$%%&$*pV?H>0} zRA~~#_>FL2N2Fkod9@#zufoDQai7OO7m#_IYNo4C(i9@xUY0=exvpg$H^S-0GZIgN zym7JhD^_wAOYROw(()ZBQ0{y32P152ORO{R*Gl5;vbo0(LW=}J^4wuH7xXAyecr& z;*tuV(0jk_iN@3MSSN!jTz&Aw{q!10BTG2_&VVl}UAn3`Ae=Nt>GPC{9Ymg0uBYsor3uY3E^cq_!izmVbPf&wICFJ<;~j!uze~dAxH6kG7)O zX!P5w;#*g1PPg>cU!88g(s~`d-}7;9sbTTFqILD>svV)AnR}^W*%1d%Er&N2FZBs` zXQl5oR5dlpAHS@>mwEWX^5({)8<|w*WX^Q|A(uC6}Yk$kjpVR!qJ zmAU1mzSAFxWqnYmdgk8F?5UZ{O}UmXUR}0kdueU;$359WJfo0hBH>55rRtqlsSHOJ z;6=7*gUNGX3JdI0@7m)GG6T(|BiJ`>D&V_WS?GH3oRu3`CSweoynK&c%8mXYMw4ooC!ib z%n3S;Nhjfj4KWuOJ-C*cTYMOb_g2wxRH$#rV)ui=7CHhBefhVa*^{sMoF=`>K&~dz zqGfV2Z|~YHpN_vd1%1e+v29hB5GvWr-}oD1YppGumG}KRqb)@vmmxk0K%W;r>}{u4 zqOrA6)1-b{`fYcu{9|{Q{4vx9E|?0~4a?CKn}Ei4E9MM9u!T+O+4~Cmdc)$AN)d=k z{JnE2yLI(ppCS-g^?R0b=}Q!J1-5Ga^gbd=j2LsDoQ1lYDcpU@%-S62U#{z6$bNh#2YvJ4MRK2* zlBrF4+^#5(L?>1;m$7JTGta(1-*!q!zqNKYHPv1J{Mr*Xf301Saeyf~jVZ}2m+x_v{{cWUAR27QYw!ZJ#0%Sn{t544&w@in=M`dAoRnBT0}+`PAGG zSL1WBfE?cXE#2aoU6RDgnla0I zxV~~-+Fe6$ZDrhxwL2nRwTu48Jk}!Zo_onY%VnOtS1x#JIS8B* zu1K)rZ{#g!x0mx9aP$4VnCf4wVYVh#xa&W!CQfo?wVhMm&MqlFztuSVsD3(l{yX2P z){dS!`OLwipPJfh7kn&kdWn0*v*>w`bLm`k>!3q%h2!%uzsh%X)pl|h#NBy?>&!3y zOAWo-Y2QBkyRL7OwLPudLhjT|$9`M$Ir-JZ^Y(moz}wruwlte73*1Z(ja5B;$}`JL zM!%}ND5;bF@b!iC{i(gWPozEfcHa|Sb4xFF*M5K9yPIm|WWN!3nL@9)V?B9q<>`U< zytJWN@*wi;ae~G7pBG;2e3opf%hWBUC1-;*d+v+X?G0UzTlzUqGaFf9EV0y-4l_iw z)h1cwAe!1&yvkI!HpF857qX_GYa&g?UxIA>=Z#|jh!z=(`S&Y8%OIg6x{ zWl5Ig+f&7FWC37ztxEO;oMTRBelO>738e?6XljioOnMqQ|^R@-i_ifnO*a z!dqTmxJ2__r<%*~*d8~QH-oqK7;g^8+X&z;p)0BEyF+`q`DNN^iqr9O+ZWhq6uapV z1dCWfc`v=gPyb51(Gm5~)wX#5w%|=3M@kH`6272Bvct0mky3G{f{VJ^n10K~POPJ% zq6S~Ak2Psh6H-}ZjX&i6`Q8b4IC>yZ`Jz0&Furm%q}+ zQ2^45C`M`W#6t!Tok%40jnI|LwwS$dgV#(F_X&ia<)PQUK^|T3LR{R{#O;Ohu=BVj zegzkhbD{TC%lAZre9~@APxKRLxP4$<`g&4f!ndffnk3lKSzT0CfofP1w|;gGIy|XA4?_-5 zJ^1#18v<8f-$FMTmLBEN*k+2$zBFZWAK{Ou2x!ZMVhAgGPZZNy!zW3n^)vRx zGEmoyrEY?Tb;~dV&gKq55Q%R7)e?q=JBaM+Z>V`(UTkn7ngfZ5rf%+-&uVZO*&RSD z<7LKaTX}{-F@G*EhTK+5pcU8JjPA9Wya_i+#leLg(ae)r#~>F~;-{_dfQJYOfq2}g z_iv&otfmg>meFa8X|QB`=bM7fZ{?tgoJ3E_m0XQSD`Z-a25QGhJA%;s3y`_Wu*Bz8d72~^sNEH*?Do#{GLXWHulf zOj-Q?a++{O+_@nP<-dFpIvMKXUXG;_7iDj`J+#9<{;TZ+)s_+5{DrJ&zq~FxW^~`$ zJnX3Cq8ag~TO(?}-J#r#^~-Ww8`*I1=|v%cC%^qdv+-*x7%1*`v>!(DnJ|N`rm%V| z(O4+-W_5!r!2=qZKUDILWkZtdaT!&%Q!Vr5T|hb&v1tmGjzJk~J37$I?Y}MvxPD7} z?GY9Mi{(`JeaT{4{$^A)a&0r23Kr#jE?E{0KV7Zl##rLv)Ri91P{-YsXilISE5}8G z=Zc%J%BfwxtgElEb#SpuGrsj)B;Mcm`uE=tMABED@Yut9yBB{Y)03~ix-FEh`P}I; zhe(hla;cavbK_Zdo6XB^-}8?P?sh^us-sXYp8ZY0OvMDdAEdt?ti*~kmL`8awb#i# z%HQ_JhWgc)i=EOZw=2O&uKGd76Z5E?TgfH5?&RV3i_!>9IQrP0}qm@vRcsURg^#ib+MV!$GR4G^&$o*a5M8_<0rW zsUD6Id2#L&>#Ktg_^bsO;C2~AY@f^LB%WAV1DV4nfl4q-|iBH#Nhg?F|iJSOkSj+?--xZbxBO?y%wx-=c zA9Yi`;lcMzI%r2ELfl=ZYA}`W+Pt$!#u@2x2G_3YB(|@ajd+S)Pml+`aKj1n0`y>} z%@RXe@?-&JP6ub(ha==?cJjzcvsnix`2Cfq)OWLFik8Swv~mL1kl3IT!8K?>r6ZsZ zVb)sT3X!f*1&soikQBePxItdFaXI*sTdc4;eG_drV|8A zFc#|Sy;dv1ki&n6RE2Oc|1X(*|63e*=IJcoHVS2s4lEBG3et`*HRq^sSbP4eN!Az zcA&0DSpC80#DJfFsCwCg4erq`Zf}(1vhkcC8^b2FbTAoh zF)IskIgGPsqB8~q$d3W&RZbMcGg7f_E-u_i#M=rEpVLODT6-15&=OhLc~c5lL=>x; zNwyLw;fC8~jCHOWjHn7;K#-nr3ZbVDCCrxasxaW&QdX08HJGv+`aM~GpL_z3Ceqqe zv~_}d3ND|+=?&31W;*S6l9pjRP7;86E{Dq^fZTMorQ0~3S$6pBzQ+>8&jEP75r!$O z6k9X%SfXi*5VrfQS&##iOBjh`JB2L=Vb{B;DxPVhSJ&Z#%9jN3?e#TgOnlkdMdgCh zoGWxlRD_vu&7I$ZcLi4mV~Xw6_Qn^Uq$~a`PrR6AcQ{_4SSiH_J0If@t6rxyN!yBO zhvN)&?2=9Gl&Gz6cLJ4RVB-W|m|(SwuGlO{1I#7G zZrlJVp_d6@Ze1Yds_HGb!}Z?WZd_o(ETVh~x+#SzC@%2?wk^2tH$V{ZbsU4wRsq zw|3WubI^Y^Q1haa16F18pR}9(0cWm4YGa_Ipg>$%vhxVRFgI?9%Xi6Cbmazn@mD`9 zki!D|BmSa1aM8&Ru2TZ^CnpQ*7(a!`EOCR*cPmFi;ZQl0w7o!qrp8^Ul?Lt7R|eTB zCTka{BodK#`y+T>;MSpIU|PyBp-5h3hZdpqo{bN*CSKdU(M2zn58$5D?Q(|s9u9x` zZc=W3g!azXM=6a@r2g41yp{`-go%nFoKd=F!p0V{fk}1->M+M62m>>1KU#SYV1D+X zf~3rnP_ZUbgmrChYBs#U$CW;BgQNR%I?A-vZuje3%sU|fPd$6w2*35!wDr-fPrfQf zN0Ds>u2IP?aY#ZRt=M1f=>BCmBGJWSwh!V9IYN!rCkJ~-CbTjH7+^^VVSVzIFux$PSbtwLhj=+cAci4j5r9A^@lp(;oK zz`}5Co=nwpHMo%T#aE3L?tUYZ10T2-h5nf0gYEX6d)N&ASk3tmgp-;85vFs+4A=ei z@J4iAL*?ON;~hYLzLZ%a#XN-6V-(qoP!QP!vRwe$tMp{k#72t&JeK~*^ThpOSncWo^Q%b>kvN+ z_}9_9W`BH;*sdA@cma<n(u^TA69FFg z4Tv*?bvp^yT*s6h?O1}*gP7F1)v}<+(VNEQIBNUgV~B14I=>jdW_zpNR0+Q(4`2xPdg=r zD_a?FfVVf+V3GJ(Ks%+kx0SSyr$JSpqyat3uB(-u@L7wlwr=IVX~E=98U1%1!MkT` zBLq4ZChlr=>n10og@VXpk;DV=W`f{GExZWFTCUH{wkKk7?ZZX4p3p>VLVWf)4?rHf zIMWuM$Gc#Dv}~KE$ij7>pRcV$BVOos7Hln!=>lIH41a%##=pQ0BC00d3cm&W84gVh zy!!4t?e{sJ7mEToL?nllw<&fu9XAR5LjqZnTAW%kT1(U>DU%xmIwCz-WFx+>SNjcw zn!&>`jhv^%kes-RMCY$U0eon2WZF!dUvUj3%ymhGs$ ztpVs~@@vmC@OdyY^=RscS*F2+PXe|5wKb^U*JikuNeKGqUS`3@QoW$-y4ywWY^W9E z^A~M4bcx-94=+R1wE3xk9p9j?XEdKB)V3_VEY3}SJ85w3qvWsZF^%;tP5AnDvrPxx zrk|Ga%(JMyhA){cI^2c<9z<+Y;=Y*RBCJNn4$Upu7Vcc}HseCj5hJ`!Kr@LY_T{DM z!3kgE)rYy3SPKf)*etMHM?4k>U#>%?<_|+pS54eDe_k+f1fW`47*yiY!s2}$XfZp3 zC^VrCYK1|xt!RL?o-V1*TOrPAdT$N$ad(U5nHXZwg=z z(zx=)NZfYp1-Twi8$De#uf$m>VM{&t_M%g5RM4}dYC+Pfoy|XMttBCmBI{zT6WSuu zQtALix0|%!o9deJEv$$sOT>jd8-~SY_tj@m(Y>h^OoqJ?4+7T-P6f1j;X03qs%@gg zX7s^Be3p-W5*c2dI|;f~&j2<7?u+rW>K&8m*C&@Kj23b{=`lECt2p2;nw%@l&wE%c z`TAPhp6*AGPrlGVYfR{0Km2}f=}parnhOYxbw1;J#r6nNASRv>&dzZ!^56(!C-vwW zeqljx$oQJ;8H||wWgxywfIZ9Lyo>e+I`Saw)6YNm&C0Zs%gZBZHXuD>E=-M)+gs1U zxMpY8Gh{J($x1`}@r|GXz+n?S1ZBfrhkGebZ7(hu_32H=Jt2;*7Z7u|IOnm%D~1uX z%&bFwHD^Ii*fDXeAjf*y&@;tuDz*{U;`Zy$)?KoxpQe&= zfZA3``kC2^jZqJ#4M4`p``T-w&`AQW>u3Xye?xj_i(}SyyrThg+%Rt@RZ~(1fT(La z8hOg%z7XpcjI##2+fS!AV@U8WIx*fufwqYM4d4bA+XHl4XtiQ8|*~EVKoSWx(a&OcF(hr9va;}TzqpYs)feA z79kcn8KA{1cK)C}=GzaeuNve=?fosdElg(BO%K*s>o?v)_Wp7G&%y;D7g|c3>qErH~mBywu6OR z2UqN|RZ}_d6iGNNCcy8yx%dzPKS*+U84P$UwC zj?)eug=2184+*8p29hPSMW`Yx{j_m`IV*9uTHe*zX82^Iq*DTK1Y;aqvZQTBSP&@3 zc6ccv^g1!L3db!%n^>$%FEa#p0&6L4F~)TmlzF}FX`(X;zSCIbZ@Q2Mc71Mjhp|Ox z&QmK(;evY61mc_Gt*lk}QCiCPKBD4XgT9W7NsE0uEWolFaT{XB*qqj;3mXJy1OS@j zxReePT-k~jC$KNB^bV;+P25o4=1z8N7#O4qA_X2Y8vbR!(|+!>V^tb@K)E*F95 z@jxV88?6ZqCA-#kqDxDLuphwUsrh}~Y$q1g(7@x3nV0RlNuQjC>k}y!0&D;dZ$&c< zrntkfXcEy8t$AL^SR&yt05~qtYr!JxD1b(!DzPO^#7&@5?ehVLlp}71wGx_}S4_I4 zm|>ypwLo}NY!d`igHy#Qj2+_HE4~q|FlMw;iHo*u4Dx1m}iLcvr5WHDyNDZK%&k0q?sc3fZj>8(T zn(c0rd$lq+BI|Bz#i4P+oXhMl_c8cgGQEQ+(dq&j9&a-qh(mBQs7J8{bJY?G`5cBN zBN(=)-Z-VTpM6$OIW7%n!d7b-bPU)QL6?Blj;Mn%2cKJVL_D5nTZnn}hPepTkqd{8 zGkK(-5sa(#j~;8;EltfBDjq+q3R_7GV8Uv=|4{3uUpV#o=gleYta0kG&Q>gK(s^kQ ztM0;ih~*i!Em|JW7)!(BMz;*W9iD)k`I z@~9a)X3aC<5F8+zu+KSoIW7vIT4uH0cnSlrhh=^lv^iIj0#2Stb3i3;{srs=K@fnr zpG&1G0@(^D6V*$06rq_AnXpekm|W83G=iq)CIlKUlEdKS@a*CuL|}Feu$rOeA@?Hx zuE!_FJ{j})Y58FMIxx<`r%JB`{U$SnXN%fHZ}BayZ6wS{JKeox@sH<%I|AVy>5xB8 z{rZH+MIuP!CBJKVMmKHyT8(I}sjX>*4jf(Hh$$%8-^_W#KDUA`AYxGn_U4h-7>EXV z%wTZ;awgZKA+SpP%Pvo}?{$_*$c~}PHV6j5|IO{nuW$-@B~h8A#yzk+7H}1n>QqU($U%s zYd~=onfyjjuXk8M&>HE5-j57z0~q~%?EpZ1bI_NHZi9Ng-ku0`5=cZeQ!SM8nUX;U zPcA5%?G{@&;165VSOO9ST{V`3cefCQ_G%_u5?mK;(QqgvUzW3)t7N6T|90-qyZqW# z$f}m}B(7?DgEDrcEXEG_%#kNY`71m&-Dg>QF|uCd;0e@Hs9<&by-Aaypr&>G+z2O< zc#@dWWA;j4aAowi5O~;sS1InASbBcV2IW z+MoS$r_E83Hq4#%Lc?1$ z!qSp890_f6IYa8oih#ypLkH-XkA=hx8U z8(!C6h%UwCQX$hDGtM{{qZ|wbpv0^i=jOm;7Lm}cj?K=`-9dM^*4M#R=_MT~ATfw{ z!}=+6D1*l%Te0XKh>dMi5dZ|!?zj5lQT_y*-*Y=x-mVIG+gEd`B3LHE>+6YI4rmOV zi^MoQ)-Mj5x6%o5FzXPnZA-=l|L}l}G;Fml8Jw$)aCiekYMNTMMi_%cw2B>Gwm1&S z1R_F^bsCI|UXqeQlgi5ByL2AvnQBa5s7BpRmOM0a6qFIU7uo2pH0PN`XOs0-07jA3 zz5D{rZsSpN)3aba-`UxYCf(=&q_I~t94A(Z+l<;6R6;~iM3q!7XH8RE>(Fs9?KZ~+ z0V@}cP&uj*zseqH#Iv}@m1}|5{YPWD@h%Z$b;z-qFK@^u`lsCaJQ+M^IJCs+O6fv(lS>-N3#3{ zl#Cg22zVkgBCC%}Qu1(22x=HjD_;3m7&rW7dERofx+f;!*j)n2O8zhpL3TocS7kM~ zG_1*{qx}RP9!Vq>yf&j5Tvf7|v`)4ru)jiO@#y7%A!!P{A7(N-F1D?DeP3&cOge8E z3V(T>aS>0E?)_Ok#61>@BM>j!rj{cSEm+3*verGp86Tk>zY3UrnOKBc-@+QRS>|ml zcmozm6fZoU)msBepaqSubSXT;Bs|X^S30ecP9Bd>qou4~vwuG>fx%b9;W8MM+%Bl- zv~_?`;&*pPtTErxqFn-@QB<}n3Z@hl#|;`)$im8;mI_In45eQAclkY877wakhW&S= zfd~bUW~wA^>$algh_bqr{`LN`QhP@iD2&elCaxl20?ov0`WYXsSwH$^o=tx z00b)ZdE*=a>gtnMqVsdsi~UM?j;K`#|ZS{b6miy;aC0lK4JbvJy>;=oG;2WU>+-CdqALA}?DUZ0^q!Xv~S(9HaC6$#%Iv zaySyuEAeP77Dq13F4>a9J`E5XlTr7U3LUp_G;zWLalEUSZ%oZZJ~ddL4bg zK%_DP`$l?;@g@{aR2JtukT^0KLrmH1#gNeyq@c+tglKlIQ<$+zc&p<)QLbx1!6J}* zRy3jIC6B7=KM-D4Qn3US@gxP}Z zhofu4p`t$u5p%A|3Vb4(6S>+&o9HB_Jrg#Q>Wg1B#r{h^ZhtYIq_$8~gQITm$sUW% zR;@>@!RRXMOJcKVADr{}Z9Nzifi$e#(wobQ%W^UG`NGnwKuK?CC*wTiNhPbTy(`jgoUhYN!f8AL9-?F4-r_iX^EzHO zOyOTp&%xl+4vj7e&NZ|UnJ&VUc?CN6)#~FWgq|(s_C^5C`kHnrDge3o8d$7)s5ENz zrD+YPsiy3aJ%Erv*j@Q`7eGBGsF!@w?A*)rc@pZ7A9oS(8Q#ul1cE)F((cH1wMp zwuOlP4nKs60q_wk_F$4?9j*5|u#!E2qtD1iVhIffZ=&^vMC2rfNta?$7beD%M%h3yUj<(!sPXv8YwlsU$X^}7P zAn4NYIA)iE()N;16s+Ekf(v@6Ss2g36Q3qhM=E|Ub8`a9%SWts(*TOg#zXm&31-#< zYAwnx3JNd3#gzmh0(U}5;BlJ!k{hA5vRlY6uM^vzgwpcl5PSSm#%YR3$mo{#i4%8G zlV9?xImFh%lV=b}#3rOsnFlYS^d9-w=%&56XLbKlpyTMGggurC_3@z){@&gpXir66 zvB)HhFy;+J^W8FKWmn!szI128>MX@9saPD^sW#v*MHfv0mWm6EQMePF9ONU445}h* zwfjpUwh5ywhagE!o<%2NaYTz>t(&*-kf>%nzuUGLN_%{}mvHQMT+yK<_6eyKv(ppX z96*=D+(VB)bnx{AACJ;-yPRMw*53YH6wXkF?UZ&0SEI5o?3i3?3LGQF`{tm-oDKvk za@=5vIDZVhzJ$TTnc+bEAnfYK@+|L5n&FxF#R5Wthc8=-eCeTt+Lm&gQn~nXUP>>J z(J!pl)i)e5A-~GESg4GzB7wF_Hx!=sYS3-CirMd74y*{9)Ka2q{7uBR5q#Ck9)a+}To&-n~6Exc6qTTYibjS1L}9vx(SI*PeualI8V8 zGNYMndX(;2CAg#b8+R|2nZtHT)lcB&sr-$;i_lhD8g)?VelcfMsNq%3UvOg`)Oca_ z8ms(5QUJlNqucp+l+H4d5M3Q|hbki%Xd=l#+60HNRUOzPJ|; z9>~=jFBrnyZkOOffGqc^9 z*cLo_vJ=b-2NZ&n%21-%y{(j03JU&uH44qa z&$lXH?3H@g;ysGBn@MjxxvqZQ%aE<^7t8Y7{Zje(i%3+Z+Dtr`37A~f@KIPb7||%d zKFG(S2Ys&#rEH@2O+lu9HP9vH3ZS^X0!lcGUk{BH_J#*9KMf}LdU^cayPC3GkiDyT zSv+1Zl*SYT66HWKeRz=UU=MAq=QQ_**0WD{Ua3Zo1{Bga)xJTc^dP@-&^4C--bKdmelb4+esIVk&7qp9V?xM0|K&^Q(bW=fQSKKA_dORxXa;8l%sD;9d(cEs2o$?X#LYmoc<{XF zdya40@`d(}<>dC2^of!)zBlo1a6+Qq?tdGwZ&IkLVCIV^S99q6UE@iM-=NI3DnoZPN#9IK^ox4)jKu4&%h`%QW>a;4hd z$^R;qcc-2gH1D}R$s01!;nU=aX1I4q))}j6y4b>ljnef?<>Qg|?yFBWPConw!FD@I zq+bGIHLE*U>3^~I<(NoxxZO+tZESD#u+mjNJ{jTi$|pWlUa(=QmVq@re$ec<}N>F*|x&Dv}8mP>@=c2HoAv@lb$;p@o(sh$iWh zlTVP_9dxA3Y=CmIX^UM+pq{LhX>CKHl#ZSAdGe*^%Ienh zo%NG}&d$wPJW`m*AG4U^;k}8Wqtb5Wx#C6USbcFsP4C?LFuoN^7vue1n(oo=?QCXb zthh0jj9+9igwV)%g?lR;(cHME%9pv_p+KNe5~~vLH~2t1w{oD`PFDxgo9p~`$q^X1 zfp5kawDbHX%oUq4ijdoV+nt-xzL}2bh#6CSEWl3{)t$7;txbR-`K1tB%{s#A0}gOp z-RILZ+h%j63r`fQD^Xwc5R2s67p;*&HW2_={nc`HLcVKVACwZfg+MG29xeTV#QSRY=5E55jQRx^$;B(Y{Z%~PVaWmzodrn4Kw}G+wzRtRykyiE_Lzo*1mGDOS9S2q+lz3feBIE?!v~ z?;H?w;tD{Pk|mABP^zceKX&P$U9u^WWj6cY6(TJDPGSsjMiiMqRd{J1(lU&`pxamI zIa#MhC38o&Bvkd2bd0YlTnk34-eByG|4ZHh)Zbd^p#y|A4Xs_Ow8ytI@n9-Da4Dsr zv*fAlN+jM%Wbvi)d#U8=_Pw!~JrcXb6m_i}K8w5uSbf|3Sq%v~2lS-gb@Z)26FiH& zxYS)K(FPMir<_R>^stBC%HM|V2QlwzxsdIkcQAiT2CB>t`NB&{<}H;(!?*jwVMpw3 zEHu{nLQP^RM#!iYE9B2Y*O6ilz1?K!A!3OuW^<;wi8%7ax}@T%_jiX~Z~qpmaGJ`j zwjO&#K<9Aj63MF3HLuF6S$C1cxcxIv^5WMW&@Z~^O9|Sj*#=b_Gl}1>kfM$%3Jx-4@G0-7@T7!a=ibkIvySdZiQ$Q*dp!XEPFfEsq(N z{dcK^OB|NLL0&DO1>vT;h(#SMGF(O>OC_<{#Tc?TX*cr)Nz(~NC=z=P2sBw|X<<=A z2dEt$7mjJ3?-?q#@U_F(JP%Y$w?&aP;rq>Ns$23FjluIJkSZIWkeE{8;DuV8Y~fqQOE3I zjfz3{gC0*wECMis+c9JQr4)&$XZ@fZgiiGK_dh7_u_;8(s<&8{F)FdU@s&gGSF3}> zJ`PVcQoVe<#qZSo7L7r@ea>7qDxmSi#f$(CkT`?sSNYINe6X{>9B|r`Dl&Iyr6Q2+ zOGktRKlzigc3_8E9tG64p~2&fVbfi3KNpjik|uKJDU7!Sv3Bk;>#T+6yg zDTI*-xMVGJkKOSDHJQK|DM}a=K$R|@tPBP1fvXC>Fk*=bt_*e$^kT?lO3|DxJGW!$ zjjZzuAXaU1IK_7fyX!S11d%e)@QGx^>gVz0#en_#9=IaL(NMUs$=ZLIE5Ey%Qheor z`j6|d$_luw#zjna#qqO_a)OII_D;mgN?t;5aB*>saB?v`2Oc;av7xIRG@%udb(>An z7STaFFAuqaqM?F*QG={I^C_Z#;rkyZi#4Y|$7dEE+@IAOzCb{J!t>Yz$HN~VhhU$4 zbgJgoci(>V(3VES0ZbD;WCG{)A+X$b<}(;26f}XQ=#!O_&66kND0jjJZRYF7PcF2& zA3gkWmeUM}p@eROP1EruT_Y8CqVe}+i50hQY1#fnCh`U1^ zDOL`V(Ws$=cyV<(j9q<3#=%+}iN$<$abd=+W}?u09?g>5B1zrnBVpZGE_O7+dxSdaoQ;Qa@UhH+_Fid2#q&mnR z6T(nj6wR|@*MoX9XjyWn>}?11eW3m&8hP$K zyt#&V9G{$-(VKiYX$RDL>sEmoMit`g5g0+2qKGE|=&m5RtcOb9kR?|ej$AUrA%EfD z|5IJF2a;cY_pQ#dm{QL@(&j^qb7&~Qf-b)wBP+=?0+O3vdLZL{i~iw51){pq6Q$lFF^G%<+qrg{WD zyWK78u-Q(0kd+q_RMG0sehw2r?a2gU#}ZU$Uvw;Jy>64kW~3oe^>s)hKrKJz;~^HH zz&7*n`$v!j)1snaHSyRl99Uh=`BSHnfyw(?yU7&{RV~vGrj|-*$Zgj^%O*FtVgUgS zBR*Ty&*>G_7DxbaG?Qva=c@U1&rLu?hVq@FHo5yzS$fe*DWqBjoM7K;)Uf|Ih#WPRFbL!^fXB zSf+k_G`Y}z`ky~*5*0(B$?Qs8i!RSYU{w}G;iPjU75IZ&(-7bGO7|Z>+GG)s9G5RP233inIXp>5#NeJFrO>b z>Q!qI2}iOLc|{P)BTmoG%oz>O@HL-bIDd{PZ-H1wq~Jumnxgybj1|HV{rQLR4(#&= zIuhOdF+2tth#H6naBfOBd*4qt-w;}seLno@v!9-UU8td$ZL^kUoIg1A&7;SEg`!&U z3y3&#qr|)$1v!^~+*fJ1)1#vf34lF(XVfq*f zDX#5)IyP;gip6u;xeK-8W$2d=cBZq}5q4r#||)wM!34oTv2( zE;RgMIVB%hEg_p5RoaJtowN`jIVag=x96~Rt+>NQy$Pc7eANfF7Jr4ITg-bHh{)K4 z2F7Q8dOSVn#@Av7{Ohj@C{$d4TNP6WT>dENj{=y!VJO&g0}X3}6T0kHaLy8omwH-; z1Pw4O_I)^zeR>62HF<3}mD7->*L&_CfA{;-O-D;w>oO7byaYb};ipGNC#~TeBow|i z{nKA(lV|__cYiz+`I|KH(b0tq&8>$^OS6xDn)K`x@3N=>WSp#p9FDo5om2_fT0y4zrkc&ioUZ?|Mk0v^S$Rj`rSW%^cj10^84?mXXl*YRrNB4vFR2rhokA`x)NZKm6{a zGbn+Y5syGS;R)@J5GYui!XWV&fC9kkVKwyxzix6d;fe2@>^$*+b{QWku4|3993GCG z$Sf>cTu%22x8dw(kmj?d2IGGC-T(Z@zx~Hw=CS8bee}_%jlwQv7?QGCBcprAOcX{E zG3y{lw&5~B=@l0i%u;0S=|7&XClpr9)AI|aI5_?AyKf$tFsJ|NcaYKZJfR#L?JB3B zO#bx${D1%Y@83lFA~6r`^xywK|LgDm;dGn+$N&0|Zyy+d2I$hseUpFrc6xMYY4V5Z z5%{@3{^8WAQ>V|=)M5*cDaeBPpMQdUqRUI*HN^STA3=AD3hCRYY%(ky&!@wY%7E1# z&_cdJNXI+he)jaKk3Vfh5Vv3driP5XGtiy94~aO<6da`KJ$(U1Yi;g;DygV0c~Zah z_yOe1otd{AwYF{a`O{~c@M2^wtnDrj1*1tXK{ont{`~!)znPqN((6zC0kW8W+R(;2 zw$0C(bw(Q`bueWx02RTJg!Has68jPq3q~|Es2k9p#$Y3z|MXMz!+-zR|9njR1N4!b z*XO3Ez&G9mn^617X|&;+KTn}+knTs{+~2A{3uAS`TI@zVtfrRaE1sCFCSxFwTlntJ z_h$>|&exLc(188v@BiteQ)dvX;Owk%Zf40eGX+f?-_J{0TQ7WGi*4I+G3!40_>)>} zM+o}LXtm${`@j6le=VH-=YN16HCRi(T}DTq`}`cNo(Sq5{OAAqfB(;agQx%LAOGR^ zXPS4x7^x!p@!k_>y*< zU(-qyUeBmMd-lRP*q{i7TeS$0R78^#@_m2z?O&(-zX}d|*znUI|FJ&%=>CEXe&*wv zu9$cE(RV*Uws{*C`VIW1#W_7~{+WPo#Q~!tnHb>WMA64TLab^wj2^IrL+mDbpo*sf zI5-TBMiG3oKg~xGKsg%dfm}07bFo$w4Aai?%qsBuEA=QOtiwu%N3|P$#+P`n)<6H_ zqh)V5425Ipp_%8O|JUFB-A9Xm{Dj{pmk{ z8bv`$M}hJ2{n?liA~mE*wMZtB0EwM2u=+D~a4h7#{q|4)@vr~=jja`S`jgYpl+$?b z!lxH-T~6bp?|*vm{lf=8P3l69Jz49g(DkZqK;j8%4!#Z1<#x_a-T!G?YXr3iG2POv zW$WA@A#-p&9MKAIYDB_&AOFw4{rjK(^27bbc?0AX{{0^zH^ez=ZrN~|*`~B=|N89@ z-~4Eyv|#BOqf1s>_u0p_was|hCgo(+I|D5ymhDqN{q-k%3-r)`e(oF;4s^~yrsHqt zIRF|a+E#KPh3VOI^&AtVr8h0;Y|{_^^rwf;GynYi)90EZvybf;{_y)VDcyJf_b=b; z>8M)3%ZXTD_A_v>T9jJ-q>5|g43;KzQ}fgJ^?P5&A1qCq@VLg$|LKo^{ODu+c(Y~l z;iLclpUK(cE~pE2hK}oNPoHY0*Py+qBE(L9{MQU*4!?jYhNm9+bJDVTa>`_m`)H`& z|L)^c&4j~6-Q47(d3VZb1(%I!!`xyHb>`IP^%#gfIArn}jlV_~pbV_0t_d9Ida~JSszrmuNSzNFbomRu*j4rQe_yig)kmOJx9J;t3pZ@9L)Kd7;h0|xw z!$scks86pqCD|Y(oLF>^Vr$M^fa6tV*Rj0dG0x6dO}Una`i5qHPYSeV-x-3UaU3Kc zR}Gi4FAoJ>%#+z~zy0Bd8T+eFBD5y|?6Xfk{p36plI73-`0al~Zs!N?=300|1MWGc z;qy;VorhuNmBRbwsUQF6+aG?MveMh&kSesf3B}r?VW}8=77~h2Tg9!Am=>#jFgdxD zrgN1QE#y_GJ>E(K0g)VS%{}Rx4x=uBAjw5VlUMjlvr+ z*nY8KH|z0&$G)g!kbqH_{PBD!KN4{VEMP>!W(fflRLF0ICOy_yfu*ULrA6(mew>bl z5$%tEnvsA0``@3V1k3?a3$1;?I;Wld?#E>trKaW_M40O=F3!$D5k|eK9bVr6V|%zr z>{u&7s@k%dJf`XUwn`Uau<#YMOn{>W{3q8TT(SP0oG!L6gU02>+g*e+HRtOwU8$jc z`?Ag94aIW~$AV#AYh%@Z^63SlV}44PrNZl58xgb(r*X+Rt96t#OcD`#T}UWe;S*bb^MaN|3$OWnO+C>!_0x}! zqm)+qd&bJDT7bde7}wS?fZym!#X|n9&l$;NOFR~fgTNP^(W7nvDtt27j)f(tdgv-v z<50A3U?>yw`Kv@If7a3ngchczm;B+2Q18U3Bn`z!X%q^6Fjnx+&gxa%y7M?VoWEf- zhi`G;x_q%@MmMz(;~xhF*!l|)4ErLDqu{k$9^9W^e66&_;HN%Ezp>2wG&aKozVYno z3p~UBU(tDXwUupa`Y+rux^MTr_k@Zzn4Fa*giuZhgmM5x7QqDDnBemtdW`OK&pB1) z3a%=f90kfClq1SnA|sJ)Y{0o!ed7y^&E9*hJ?FdT`@GM72D#F6#J_w|g_&6TdB%eI z=C5BullB+i{rzd@w}1U}0R;ZyU*G?>LCpEnH|UDpIZ)>=(~6;ZRCT=uWH6WtbBc3| z+Kn?)$;!gJm3qzm(;uG2iod#plp7W_dKa3EE~nCKz~tFy+v4-t(9qiSoOZORp!C~& zG`Au_clYpXN(gHUPS(50AASp$6r)t@sJuIOiixTDUw@v|1keRv{j}Z)kpD%< zlzw^!VCKpB_lhCKP``FcdxoZ>gJwI}xUH}mxWHGWD~S61$7of6T`buAuNPQxdRhet4UYFW9qS>rY-m$kYeA5jje#3WOk zSc*mmmn(Itm3pNv=};~!5B);YAO>*{603DO0(0s%WHA(00KuM_W`FqM_cbrNqAres zS3nDx-l4%ei~!i@ViepcdpLa*t-7{W=X$ zmqo=yoWSjizx21scoOE2Zfk`1fCQ~JFN4~}4yaeuov>mxVpDYtVbU6H9inC-7hP5f77G$X@vKa~m|fjvq4J7JqV<_Mg}V$=4l5~oyZXb^=Yqm} zIr+4O-=6*adls1sQr*9fP5$tY?|zw5BXe@^!a7}-k{GtMxCqgv|K;h^U#GN}L}*@4 zZsF+0{Jb&=vQCN$i_7ZQ7pCWDmRHn0SXgF5wFU-8eYoQMZ|~+-r8Hol)}ZnWq58?G zm1KD?d`qRUdmvDJ{=GtoZ|c{7{`W7_NjhSTWnjb(?M)v^Y1X0P9yw&w@Xs@4j&PZt)cuCXFlHFzIjoZYdZIk!%2L z|8ZJpt}Xud+fwYlVNJO~$jgn+Pfu%f*Hs0@ZAr@#1$FrXO{rewhn1%Uw z%W#+pHSj<7(Gi6?_h3}>+_UEv9}|K?Rs$GFaSnXyAOH7XtKbs8$iI31{g2a>oIn3p zZeeVGZc;fnuWKtVyjMU_f{X=sDF4f^3-@P#dNwty?Zjh?U}3sP^{P&T$SwWi&pD;7 zzdn2V-%r<;+{l21fMS+c=p8{TqY9GyZEnd`Vs1TYbBU=st8;$FBeTZRPGe(F8>FNd zpVFQK_mC4z;i#=U&Ah%Rb*Q48yLU@ys;S9&od5|V*p`0!aYnJ0!sUPQbzWYf$Tj=x z`q=`e$V2Rc5V5ni5i^z;TI*Yq67)ALhud~7wDY3B}mP*Qmvm~zNo{Ik}E4qOIjy9 zH}76y4f6;{u~cXs$)Y1a(9KV;C_t|oMV0=Mo1PCRV;(;6tj*8Ps+Scm*QQxgUrVkN zG*p%$g{c}Wl9-9dCxDhV{p|VrAOltiDJ-tn%_^N31cG;&O`F!;=78@BqNucts+xW= zv!s1fd91aZ#KEkzB6&g!ZXiZ#HZ zks4y@uzz7z=Q;*R6eN8_Tjp2X+^CZuFNlh za1Evn9YE%xU~IsO)y*l@YMY3_rZ7D~Pl1uIY1mGyW?@#LvNT|kH9fpK8VQeupykF@ zt79vWZonY0eY3y(`0Fem5NwOe3-e$Z<+OrSR#fRdpJF((vyIrj3=^dfly&c*OYwyRbEBAUcG8Dy3P-P3&#)k0F{eTMRBd`dZJuC*TvaGtM92?dvKr?7sRcx?8oR=y5J;w3snzI>;g+3_ z!Jca}jD)c)=&lYvr5tXDX>HXhBo^JtEzB>w*)hDBGJJT*p+d=KyGyCqbV%6%qv_g; z9lA7%T?`yWVNxJaL?y9#%eV=w7wf*XFg`ysr^M!cn_JL2v!K1IFU*Ia8Hvg7{_)SJ z(>ee9-~R2c_m}6ut*epNCS)5S$l!o`_cp_!R} zKA%A46#%u(qgzeQ~!0{}D}T2xeq`@>Sg2mgH0y%MCste9B@UG*&v zMs{xKo9KHiL`5auyT0KNAb~(Sui_wK<;4Q^9Pkg%FR8p`c{usz!g2rug;kX1e3esj zJOf$?g(yECz4YRj@1D(`!?6Y5+{r1Z;BPEzOf)b_+K3kFfBWhA3q@ZYfkGuAN{VV) z!u_u~1?lnM^t3Nm|KTD23K54z!;yH%E%-=8ZKb4p-E z)EJb;?o=ls|88j&@^)=ud3JJEFE7ve=1vjRwfM`AFZ2W?3{iz&H=m^J<0!z&Y}6}O zm6jHvVU1aY781*fFzp{4!11JUHDKzkTBEb=FiQjxRkiL_rIT^$rBtJ^hs$efRUZWf zmG0rl6f{FOH8rnM>kQ7ZqJo;BYt@9I(Gc)@I5hIA+2_|TCrKz2QFIsqMxR(_O}jH{ z_c7XIMmb$h!`2|GDKxa?e%xkOgNtuwz{@$2P2;M<+UhxjltIxXzvT(*gi-}1aIZ8# z{9ct;-Oa0lasi0}QwxL=1jh3F6lh-;9e}}V23m5EiboZKz7m40-kYCS?Ir#C1=aH0 zqDr4|yurZWRW-zl3fdXHfmS24%r7ex2AxW+bEEPKYw7fEICjHu9vyFFOC2jyzs`rL zFnB3cVhgyeTD{B5ff0#l7y?bhkZTzBmFe&Q-#=$czxarm4IN1uZQrfHC_A<8h|nWZTl&mDAHRp;mz4EH6h{H7mN_ z^4zlKs`ng^=$2IGCu9tY{`Q0|w6Chx z){-cMpg|gkmr8=_7nAEO$k$($h>SBo{ya6UA26;k?tqODZ@Q_!KvmKJT=XFXxwA4m z`P-~V5KSmmbP^79Se4bip4W`D%j>a!xOAPmRjVtjOUnUP@i$+7eWxrM;+!Zaf164H ziR^F&ly8a#3=|D5DzAcJFr59cFs_(i0P>xu{9c}XRi%psy4)DBvRORCO0pV4sgLPq zCMW0F2oxQKMjflytO8(<%DY=?oqhUrZYeG(y8}W97ZhQ-G~~L7b)`Kw7$gQOCXs59 z^0i-nnX*;h{pK!n7LeG;RAB6flKepw6h%2*p11jZ_PNQevfP4d5|0)0$Yc%t8cD*n zHlxsox=(gBt_1aA5=}2Jqq_#_BKr8}7C1`cQ>Ya)0E_>ajwvmxrJh^~D@x1I>+^Fe zt-E!2T)&~U4s{IZSIp?bJ2{1f1KrBJa+p$8)u{nU9OZ^}8wnZLmf2^hC^e~Y@OL~YSaoqSQ~;2 ztYFjNoJ;GGRFz@C0ET@VkVMNWDD2I(X`@Fkg;b#{;Xb9#di<&5Lx_kWq1rSca%%Oj*`Kua-Vs1{Ww`eu}h+?e71C(kfyeu!D>;f0B5t0E}qPQ62 zn)~@DP$mPdw+NqDo}68GKSZNokXjUmXq*21#q>I=Fy~G_Rj*lFSTO{JXaJ$BBBa#Q z&nIV8ePj$83PZrF!AMO@a-u!K=SGw>FMgX|^C9o$m67aP-R2gr5~wWI4PO1KMzv(` zU?O1<-kZ>x%9d=!Rf6465;UtQQjHidEHCBMJ&BN8xby*$uCfne5J! zxQHfvqb#4QI`6W&*W>X}X2)ScY8o8GKDJ$h+5!C~NZg=R^ zzV1JWHB#|d%x9}+X;JTNMnWnptK{Hkm77tGsiFI{v(J8=7ngneRc?jYso1<`3q}Qz zPt2W2RKF44kuez;XFhA{5eJVTFouGC);&RM>mUGHEvYP2uvAbdIv+^t)wAiP&~hXr zrqOD`3?vjq1F?^bVGInQcdN=P8YM!Jdu`#xi=RMvVs+`aU*G$-$N>^#7cL45@^gyN z>Z!@a01XC3b^`aSQ?-%7)gWtlT^E^j`ZTGs0r;LOp3YXIQvD(8;|v;sMxe;OTRw+N zK&`EYGh*&_jcXKx!&RZNB#F#o(#_4zD^=%A4waP@P+xkCc4JR1=;c{4_nuL|3LwYj zl`t$A3|SvI8)np^iR_e+|4ys2e85V2>Q{eTwgikMR8y*t~ zu1M$hWD?1GEWWjbxJ0WoR;Pqs?s} zJplCFTeni9iyxE9p(t5kkbIdrV#2*@2Z%kLoB=lVlAOB*RT$oe)`hMqEv8RU_+S;P z^j2VGz0&DSZoNYD4$DJAVB~rradjVclNnKmWp>4pY@^no>s}hyZ7Ea%SO#c8a0A$= zH^ZtIzt7r{xnF!;>IR<-ZGcczSkb6kSqbCnL`3oDj8bh{bJG|o1cMFYbz+%r?=JqW zfRf2rb&FFo%N`1zSXp(r(Wegr3k?1ful0eV8JUS4+s5A?3 zm2lu^_1ZlWDyxymV6^yNdDKQ5c#vD|JU)2d7(7|p&|$W0=wognfkBC}E$%CVS-C`3En$sUhbl^Ek0;$oDttx?$I8HEpMY|YYiYVwGzbr;RqtLN@4A;Dl0~%*QWkBYL`=Ch?<5op%`$(aI|9+IQ;dq zNaBr!HG|O>=At2goN3@1SyaYo#Ix^BTzgX6F86-lP$FqgctXf346^*lKoF~wWUFF~ z8Vt!3dTlBgMwL|3H>}P$s*1c5dI?<48-_C)suFR&Zrljtp+xzW(_q=rnuQW3zOKow zk5KEREQT-}(5t`!9UqIYCeVel!|lhyqi`x_wZ&<*oxa48<#=oJghDvSP_@@MdN}G0 zAW?yjZS8Hlu3H$Q9;AOP8LDxpa!St-m}1HZ(zYAtiOcXheXtYj5Rg&OAv#eCC&X@C zVTRbTvS6;OLAmr{qx-?(OA_LbhiG2k<`P66o6|b%Ha&=Cs6_szW7yri?-U@5N@^Wy zgT>r!-5i(J4M&ypo@yMj_B<=S4~V}B387YgY}ek1B#F%omUfidh(*E_avi6)o!u|w z(<({sgh^?M##<=d)FqkMP4_1{`Z`X<^@4q?*%Tu|;KHu1hi!s{qmxdo6Lm!#KBwDh z&m41*Xy%F6Vor9o(1j>@>d^I9xv^O&}L@zjy9jxM<6aRg!>iA-X+&CUZRh0F`MY|buGUp&>- zBj>%^1&+(GkjvyXGFVwpAZT^PFOQn3RBGFmv`g?dY&~Goq}&1j)?;B*y6@fb4mNkN zTjJ+e>2x=%p4Qms+d1D)4{Rs)GGUL$!6T5{+4VyM+|PcO&mZexFex>Rmwuzc9&$sAG2VUKQsSixpw8Jxg<$CC_*dha(fFG7C1CzQSnMuXdUG!p;LV*n=S z{YGFK9du|MJ6!QaI_a?(3`sEqkL4d9?`;Q9I|1Z5HF%hIuDg8kPhGegI*}>O$_bPP zU;^lSczd=VHb<`yvyWT*pTxTQ8-Yi??PkkiwE+qHb(iqX{nn;FKEG?2i^E_rjI?LV zmmW;;Pm)f()#_`c37Unx!yTb4wfCW|yNN078{2jpHa5(`6CStc@FSJPAdQh-3Uz`2L>36|b(76b0v|NG zS@*6pv*p+_m{Wd>D-nth;E)h7!$azdZ#koW*U?$xR(xz-o12AYfk_kB zi}nuKcp?fd*gvqZ1Cx_O)-bvsGw4hm6jTKQOJ+*?B@>-Y`Xi4{r?ZDQmCFk49{3Fg zoj@SrYpOADI0ny@hrvw2rq<|jM54PB_2e1?k=%6u;l+@&iznzGwSk>SuhwWb&Gt?a zuYaf-UW1`h82H*cM)Sp%!*%G=YgJmCBlbWdU|=yYOk=W}j3ZG=OsXicuFsGxh z&K=+G3iRQycnp@xtA-JHbpC(^R4-bC&A9Hcnr!>xt}X!(QP31}E$hiE8I#lPRxiy@ zfo^zZi&bk1R|~)jiEG3 zFM5RFRB(D$-$$-RBWf|^6Swc^6@vg~gDLH9{o(=u39Kp98_qgZX=w!zNvQl*2?l~} zaIdc_Ru-4$*9?(sb{(p+s0>9U;+f;y4jmwtB+0Z9!@~5OgIblFQ;1^Sm)FTb0E$kz z;^eR-bxlsMNp!#bUMO>eOoOo8Ad5~QjMR)5yNb2M?4-gISR589({ z%ZAA)EzYkb`z&<`2&Bd6X%S~F%DGjKKf&fWw2odXqPPSB!R~Et9f41Aw~z`YI93-o zJYos6216FK2fZR3b3`ieuiJe_PdagS`6(O>rla2ex+lE?Zv7t(G*xOg+pO+wad#_V zn*&RR)nVP@Qs`1Qzda~|$z?DeaHXGG*eoU*0ysBdYPDGIb$(97!gl_82BC{p*~~=IW6Z;ghT|4_V%WafkhKKBgT!*b(3qK$LqRH2K|W- z4Ma2w0j=h48#eTMkKG);5cggsQWHa`U0l9I*uWNd3uTXZAP(U$WQ%QCtoBgEABgO? z^5|eq@wlvJ9_@bAX3^`+-Y1g!!K}+1cr$wNlEh%~+R)^2y+If=k z#C=gI1%OI`W0S<|Joe~yfUIKo`V+%aaSIiRp|dy*6nb5o+hDc1LV(9|B^-))Pg{8e zEVZV#;p4lv6P%{ko!Ksa(!F85*v*FD5BFb-_zZBb1sA^XR+i8HIGznyERNtoBZbMV zYh*KoLZ z7B-iLqf*Fy&aH!Z`tiU`!s`x+o4R(q9W}sZ?ivU1=XDLRYFsIl7j?c3Ly|!j#wCPy zcY=T;0p9zQpvz^}XPQq#Hp52vGTtk#BQZ|A(e?&lY9ru90gK6O&LsRh?PPNMrFUJq zIs_>K4fMXp?XU+MN9>x}S>13|eqoJnReOLZQpxoqUL98+SzlXGnE?TUYf&o0H30ch zSWd~TPClPpOH--UNL-74bG?_4DW-T)>G^(ksiUH{l+(wiFYXx$6(D0Hf*kuH&R z0a8rL2;N4E=XJlNsr!M`eA+;-6LVNx=|t+3S?|)UDmP++iJtoU`<@sX0fjY!Ltd>h zz@Z6yJ0o^SqN$!k6OfQFIMb$7>eCW|h)$}ZN9-=oBXJ^p)G72joX&$zN&}xyC6Wmp zZj*g0=njUr?BRW(?7dhn5z#0V0-7Q?vZz(Yt>8yNPZR_Ud3J7z)qvbU;>d)OZpjr` zYG6sm>L}P+ncb0OkU$d*p>*74!91yYGkN5;hl2*K`|<$*W6&6647sy=AmVm7Jn>jM z=ylsYo_Gt3N~$4}2#irraKEjAL7{#2Y${c*gMW;28&Y zo7rS_MqQf*gYz8;2?gpKwSmQC(i)`W!Keuws_56japX$|Thi1vcFV+Ih*UcBb!01e z5luM2XyyiRmn0tao&=-qD3GUITi^A*{nTr=#{6Ie-4_je!>?GiC|EU_$05~FKJFUz zw&2a-(Zq%9HWU+9qww)zctcrUs?Ht^x| z(SVRjkv7O8;7&N0kTL`-?R2>9t_fN#`J>ylFF7+C-8)n$w1y>4T0Q#`3Onl1XibsU zTH=)}DxqU*CH{SxY`jZ6vSrY&>9ci>ac{^Ld_6?Llj(x~o8IPx&FOo@=3Wj`r&AQ&e}h z+r@6X+}l69VNj}(_{U+F%i(gn&R+`q#v-5|+17( zas(;hj!KE>G_YT?L}FHF>n=`@TuiT}ocFzwKY7jl=(9Qe z$!JPK$B~#U`Q<^1O`T(`*biGe{JUgjfJ{_!*gJX`QPw?@U&U(`#J@s8O_cu1| zzSFZCRX?5z{G=ROlRtGJ=JoiTHcxs` zJapPCOC_#F3@Uq~wT{jmK2N6hhTmWKw*CkTa9Xw`Bm$Y;z#wt1LvN`aY*EM+ie)cd zTiztQGZi@c+(4#a81j~VpG_AYJOAX{IthoP!5EK7p)oD@Wn z7V(eJg=CONCN+wgz~{UV zB!f(RFYZmJ5(fw3PBwqErKcmfE95jb_Ur_GsrXSm{f5hGllA(2lIFMm?nZ3x%jVX;^8}cA32#To$kl|#t0&E(s3-P8An%U2ho#-evBPj6 zakU%e*U=kNsP`{^Q+dDL`umfb$hWOh?KFQp>B@G#pZ?Ca|Oba{GzH*%1bpSRQa50ApJ zSbFeHzqI9A(mCGK*Cb|(4zGIM)^zvafOyZ7?BJiB_jHKsIQ^g6dTs)dp8n?ZP&Alq zq)HCYPCWiYS+iUyV$fP!pWGk0ZM{8=$0H|+a58-Q=^(v#6MHNc3YbhLzyJPzA{6W3 z^91dOsZsgSVP+zeI6VG1-p(TOTRx{V$HPhgXkolMx|!D?JPtY!`s-=(!Tr|{{MlHaq_1aKb~tns ziN8uqL375a8$9+)9sCbC2d6XQZK3WDaP~bMb|BQ(9$1F3>hC*08IX#(O!4t{+Pi;x){-6*bEF^6;=XjN zJi7n4$LWLZa5Qz^(J}t^`hB-R%7Jez8UN&>jmd9szkhLhD{mTl zb#&@aUyXOk<)3(b?z@+-Zf;+HeAxGJ_}%sU+x8X#NANir5AJ;E9eMd~WVdJF>^gNc zC~lS=ouxC`bmmOjy1Umd7t5Re7E4d`KH;9HAMiTlosX_R_l;#fHoqM{d3$nvF7N0Y xc+h`%o_)1_czMvDI*6tBZqE~!1G4M*?)x_nda|Rv?VUr3^oX=&@Z{k1{{uUzp1S}5 diff --git a/xemacs-packages/gnus/etc/sounds/kiss.wav b/xemacs-packages/gnus/etc/sounds/kiss.wav deleted file mode 100644 index 50b22d2945ad711ee0eeccb60d8a727e872151d6..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 18934 zcmbVzVQAz?mZq2EnB{&fx9pE)8Cdqm4fA7YdT5%a>7pna`-WOmXX7)zGRBx(_xX%T zUy>wACL&2xLI|Ni1VTt8LRg4IB$*^WV`Geelqrg$nxZJ09)@N)ZWxAv;TVQFhWoYq ztM2<=C|$1ZUYNb8v=s5;#fuj&-h1&PLiL~j{%1e?KYzcp^!W4t@*n@(fA9X?zh7Ef z`ZN6dAOC4d{{C#~&zJt|KXm`$HE`6woB~z_cuM9LFIXhhu~uFSSl~;}JdyPS9|>1GfJSFP~<=WhK3G)c%LozO2o{KDArWP5L00Nw~e%eYc zM@x(GXgYAZ@=|J+o|8qkCutasV?UJV^)a&iB=1<)Y^+fPvu#cn846yB>_Z zfEj2I?Ww>8E{Fge1fEAhN!CbFsp;cU;A)Vi3?XShP+kzS47sC_W?L6M6(Yxf#6q5R z{DrfdRp<$njA%8r*Pr{Ha-bp+l_&HxT1RTu-#OE*(iYyrz{5Dn30uuNhm)vP*z5u` zAYFN6T}PAM%+sqM;bb23o zhy==H^}0JqZCk@Ak)#$wQ4@dVWou9keaII>WMZ{C?QCAQDKwNx3EE6Mj>o&&v!fx{ z7Bi$Zx=_4o-;Rf&1CfcTvJFO{Pj{`+02nYU2o8p>As`i0_SU5pD9n$TJNbnBfM(6M zBF}*o6kP`<0tlEORGl^tr+p~0I28C4&Jtc;7>~DLSttQSXM#U;5t89~qn|$k#P}Yx z2_Zwe4L{8`X1zc=kTHcM0v8Plf+*iA(Gkp_|2PO%Qx2X#9yBiD+|U630IKUrKPcV3 z%MLWz)R1M&2-#tjf%#B<^-TgpmKkIHi$6O02wq^fEX|YhP+ZIHmp2SkU319 zwe(!@h=Kz;poYPPak+ts6ZmJmz>QRYF`$@}p2Y-_5>BFTUVSdy;rl;N?!B)v!_){<&%3Q=>)qz!5EkMdhkFc}eL zO%tdjO{yxKuDl$25pvQF+<_G4$jks*y`uvlf1Jg7Vx&?{S6}uZ0C2%cCjr9)H9$}o zeb*%}g6vt%AKVO}Ds|VGeQJv7&oHA@ZVxr)9UKcS5e_@J!vTeG)x%07!a-kXi`4`I z1usA(x(ZJ$I|>+60AMBtM2u!iL(B^_V0+r5`id}tht{wlGDt#b03+GjdFm6|D8@C2S;RP88|G;pFHbU?3Zwpz+H9!3Y6)e7r~Nv0ixfwmP(dt zs`6sB{Go)DwTq4yaV4R16&b)c*WDRv>{D`VA+%5}v{B+X1(v9eqco|Q)}UQ`Ng%xA zL59H=-zG!=Xocm<6co(B00GEEfl@ESCp{wHJ|%H>Rbf9w7ABXaH@2TFBf;iyEC>5enKWoPYGHkG>d+5RNvOPrRfVBG&cO zZV+?fS^(ix`4erE7pRaOJeX(_PWBAJ7c07G&KT=%Js_uprpVj&5YHw zQbv|oyv`X$2?8;wvb6(6K~!E)Z)pe>f`lY!Oh0>LQ;EqGdqB;CftoOftyI<@byYS@ zJQw36o)}2Ym^22+(110q-VD9CpPB#zEK}qQHrWkWqd3WpQqZj^j9o0}@CZUfMq$P* zjIu*EV|QWo=*IGrZVYYY2&G$a%^yX81Y9;NzL!%pVU$$HB&P7#RIVE+LtZ2Xccwj zCUTg|Cvk^9b`~ImbruuGsiAFQZ60r2bbLhNoH_3HAXyU&(R64*gmQB? z-Z*Rd>A8)+xdQOwMM=k zVmmH_2N38+4z-Mc1Rp(FpR`p9)uN@aVPN(S?6gMYE2aliz!jtsLM zt*~m^ewZI+oHfEh7Ev?bg2E>!N=>)&o<2FusRDGAKtQyOnKBrHglt^id(~3@lPAzK zB7qzRB1{~Y9+F3wF(T>Cs zu&S+dFFTmp*oVL_5wFUgR@7f26L6wc`J{OgoqRFJ*kDz#dWN_WO$rGH1!y?w*eWfL z3+~6!1hEGUEy7-#l^~0tDx9`)Y%;Q9tpU{e)>2qG`udBWxkVh)ArAd>s=% z47E_gTTeRJhsMf_VuIl+A{-hu zPJu+}fgcd?v56->(eacYGMPG@Am$>7;)T>PL0G3C)Vpci!u0BQOCxAshios#y1uj%Fe{|XNxN#Rc+?{%`WFSa+(a5kU zya*XxKD=sqa0tXSHj8E;jBdzOl&@dF4WeALharngCVTbh$s$s1R}h}bXLe^~_MtQ+ zzyd5DJ?IVF)gT^pAWMKCfI6pzxD>C<1E#Xt8(S*Do?7A@Aj{$i#CjfO3ZZM&`gMn= zJm`cg32G%6LbYha;)yrt0~Agg*+3_do-BA=hrobYZ>5E4M$Id%-biz$B~k7+$R*eS zGNwB!w=dfg=aYXhK#l}8P)WLX)(3XY5D?gjppitJH0J$4v<~DrevxGTCiNO-z<4IQ zF&ly&We&-S>jUvPXs7VLizKRHrbx1AD4J#p=DE-{l#D9X-~|mo$Twa#ZMs(+@)-4~ ziO4bqygMpbucHPn9d>X8Co2*(hs%+4CLNFxf44Mzm2aK3y%1;)mt#RkGq||jF^;DV z2n!w=ljWEl*EDXKsQZwm&yXex8%Pu84S-bYBy21Sci(J;kg$tEP>Av)F(fWXC=+OE zBx`U4PF=pOq80~P)EJMGAP}cy~XIwNWABQpE(< z;7fZ05#>|G`g5KW@*o=zqjjc9q`T06(Mf`ZBvzxOmE3j)!u*HdEuSndlISrC;GIY^ zDAt)l@WtG>;5C#)7pcati(o2goKeK!%@7Bw;e64;yj7Gn@(?Cjb7x*;1yMc1E>vM) zEK4{W=KH5ZZoRn<0N03)Z)PO{vo6Wnv;g0E%Ti;?w^?QczlO+*0Q_S@tsb@K9UrS9 z9FxGghRVvPlBAWICAEeCU+Z%3+zPn(VNC|AX@q_d9Zjt;R*0EpVI`R$)9jGYNX^1(kVO8FD&-~O=Hq1hx`WN6i$mgi zMu zu&MYMhaNO^dE&LObAd>iUZC~{g2@_`%`b=#F55O&J#jwQj`z+izuKQ$ zUZGlvkCnZ2Tc^XKaoSHiQ^X^7kfev1E)ZeHadQ-B-N=jb#w<*CuAF=u%ng%a<_?l5 zwDc(1AG>ji(^+NZy;QezoYe=J*G)Z`=pkCpR<3%vYUVoIIt|K=^BykOa`!l)?xvep zgUoJc;dt%L9`96k+$rtqajG00RIUC<&33dG&sWZdUTYf6mgha}8z!w@q9+@LoyL2G zR)-nL%=?)eH7dJ39gZ5I6JlfLrRmn(DYoWTx>thZ&;ggqv#PLIPpl-(HwzoP!gEVc zR?eKEl}4lW!q!o_2NNx={UV${IK>{Xq^c`FTytzqHnEL$nvX!^5M4aezl_wpbZ zowRn(2Fdv2>*KWQcG6xo%o`AJT7EXQ^~8Ggtbv=rsJRf2^bMo-zKF;@?a`tGL z;L65{<6_s-b{;%Y@dP7rc)jGMlie<)&KNtdcKQ&kU=XdEUdWfcK+OWv{#( z;G{r>(A;#qUUi}qTxfa;wlUEsZ+i4z8kebY6|6qBd2ve*6@`4?grh%9CU(E^hrh)EijQz03e#B=*QYse zypur9l8=A8r?AINaV=j|E3ZM^4d8%O6)eBx!V7;IMqXHrSI>@;+{O94PNw~RXb#2> z*FH^u^oLy!*MW&0MHBtw|K0X+m#7^*nzRn`DE4^YuP5n`ez)sKb{G!hv^u~o6~)cV z%I^9c`w1Q+>a+Gng{Y3l6MBBoAEqhR9eg!VEWg+eQ|`^8v3u{UzKd&OtOMh%q@BdP z%#BL#)3166nvpN{y{{j`mVwO++s9#Q<1l7)vXvdA=+nnl@zw}go?@Nkk99vz9c)kY zlaqR#&KEK(*2H*GX)4}qq4#RTX zqCU!-I>F*+pS8Cxh9TljFH7#fYWOiOZiBOj<-X1aZv5o*pdDcc=!D*+yL*O%wISl- z@WJaN7#IXHUcTA&5*x;GwxPQmcIZxqTTeSm4Pi<1$L=5mo1vRbm(O;i1jOx8b?@eJ z1ncwYnyzLlch2oT-zIp87tS4~ON^p6wmrNgAZDS2} zd?%U0bw(7GtE(e96^6KVX*K3hYMjpnxq?*$IF0kYF)o#dbOt!J>NF-U6d1BNU!FIE z46<^@;p!Ff;CALXoP*TR_33VkV{BNJn~zqWVNb|wmibnB4Ee);(&_y#n+k4DyW?=< z)Q1YeG)lWM<-HG9?ldLu51Y}!mt?fKpF8D z)a-O?+QvQ?*JWDIS6;vi!NRbJO;&GOuw$C9o^G8V<2W4Ft5q@V>o`W2Fxhmv{JM() zx;Wa=xzjw6LnNGD>FMsYrBhGEFgG>bowfDIR}t;JI>Pq_8TKo%R=)_El}3z#paBLu zU47H?6HK@dr%3@SmiG{D zk=1G3n1f658R3Ac>_vklWr>8s+19hBpF&jR9HU=((|37;i9kIJQ^d(^$x)&~VZp_Y z81gVs38$NAil`t&Q~0du%BvxJU;}S{+Tn+)> zC|w@~5D_8=%s>_#kMQQeF}!H<`74;eY;FLYFTXm%xEShz``Lpx$Mm$J!=X+;e}&^G zslx$9zKRP!=nv*wg=HrkMD%goJ;l>|UpL{uu?|6;)9vXo6b+FX9C_KtEeqz6$t&H% z3{HZo8G2c`J;jS(4q$<_k8;ogeUKaB!w}w{;fJ9-ygc$@nlKUN7gj3{W2i26tKMWg z@4zwR%NLNCY-b%fW=~=NoLa3EqA(ocrk@Mnm*r)vm#&Ap|HNB3^% z5qQiJPVZkeVW+qTQCO&x9(mOGCTVuB*+h}id7gfuo1>rtJlo{82A`wvi#*iK(-LN zAL&6%%8=hET|47BAHUSmF>1d&#tCR7%MG+{_W7%Q51w4E zXQJsUYzrO?%wd$dWeFxvv7qLYm8U)KS!6SU4;=Q!+<{=;xyz{b@j+6|jS5^56mow5 zH5OdylDogc$LA0+0s`JkL8HsAhv37k^+1oxcIZN(pe%CL0N=FyWfM9}PPjD+qw(rB z>=Ql=p$IGu`-J5exDf?y=o5C4Q8?bXZ1Kzw>;jC>$gqnUM(`A91f?U|WEDeTC<8t@ z4nK|eGbkN*N@lAR6kTW@LJjar4~T!&2KTdYu#g$Hdb-%S9D)L*iLU5(nXtiQ&mhAW ze!5({gzj~~5Se1DXPK%&|uAkeOYS|qEi!i0oawx|`IJSj$umLZ`q#Jos zBiILis>BCVupBuO=0P)l+1|X(&(^3~0Lf<8&v)n8lOQiQKEN}&40YkZ#Zei6$jki{ z^$rBmW{wL6)I)1givX51`2=CCvHasPooOUR0HdM9kF|g)tyl{@q632ubJb;F(xLB< zwom)=!5MqHi%NV+(z4EzJ&uiu-E)-L_F3N?8)D!92nL^mEJe0?4=%L?8XO~Eh;||0 z(as4AJO(GUt}z9cIc2w#E*NHNIm7B??-U2_#U|f{ zi{oLrAtcm*X*%Rnht*-(;mN!7ADwLDQyTP#2C>G082Y7%>L%b9eNcJ?(9km*ACTgE zTP})-sJd}zJ|_i0>7q3nXa*G+B`?20B-C zmF>^5fEf=UBxT&}n2eepMA6v7bV{ho8qbexIDCE?0!O2Z_3MFrBPo6vLAEUiqojsJ z7ST+|0>UgIhOj_UPVD3e8zp!^suwGx(Kf~nZOB#qFVOksoL@wm%E(bzj^v_@r)eAr?T;)hnqy&J zfxh9gfnORKxHK1GW^H^sf`yN*r4K%&Yj%jWr`*rv>nl)}(LnC(2wh1F9%rpS?>LZl zeVxa~oE~$k4hKKpnI3Zsixp7G%;&l`NE0_F`O-46oS7~gxeL!5Gx zCH#zI!J*S})MJoOKVzP#)6w`S>(Wdan=^5*fhe{*$e}qx#DM9Y5N+@07B&$mus4#z zKis)n_6U(X3*<$DchJMuWQIu0ux78Uy6I3d%1D(P?XfwVjayNtt?9A|JOZ zd|Qh`jVw^pOm`s|W3BJC!KgjX(cLy21Oyl1NFFkgk`UnoVv4(*1WJ}7kg*_xoo_8; z3YImTw76GU=z@9DM1t&-{urZ^sSybAwYIQzhPDxba|%654{zM2sx@S+nHdGfh@E?cDx}@Hq6BEQviG|MYTaCnir2x z`wWkH@fRSV>magq<)kIZnpvOcpbW-T(!k*!gG;2?c3^%+yZmft-nJ1Ci>gI_7ZZhp zENrbpzm3?+Wgv^Nwym)fz^7Me<)5tK(gz1-q!y%`W5kXwj=_*W%sN<3_~jSALfZ8+!#qrC#xGUyQhjUutT+&3_K^}}Rs3W_*p!#Pm-@VaFyZ}>`uw|4@ZMk`Rgpu3eHOyD9`^a#282h_9)fZI!ycu>vg!wqx z4NkVsn-mnt#A4cYW0YvVP$5LAQTF&!z6gYl;gm5r9AiHYr3Oh|HO8GV<^Lston;EAYqi4T zD~^rpw%LlJa=ML=;Ob>7n0WL|Em-` z3TB5xd|N6GLaTYJn}ZyOrS<8fSu0GjU4$cog0ANEr>+W9Scm@WcqstB7jd2bH zHnaJIXZys*(stI`I|FsB54ue6e~kljWL1@Y@)b@QF?@Y8zjt{UW#B=NXP@5e$0LYU zUFe_u8mELfBN$zMa@NAp5mftn)AmweCdtKW(T(xpT{??C{KYX&_!QeVNT!%?V8=d! z7_S=pGcQ5(eX-lla8#)Bi&Y$WXISn|KYDf;;WmDne(;MUH3IkDm8Vu5CGpitZig8@ zdP_cjeH3RpyI94rM^RRK_g}W7QIcKW%Wydp6_eh|O+Sr`QT3CT$2jpX_7BdSqH;E` z`{Qcx=!I34-s(kre6H3aKRu0`hvV=p8!o?aCYAT`%`iI;cG{)B(7i_&YF@dYJazSz z+8QSMDj9zA+%KoW^2E)r>5AE?5Asn?r@exo+*X@c87t8pElPPTVO!{2_= zz6idq*0(R47azVDj-O99H>c`(bHklDuabj}H|@(GeAAh{8m#1DX#IBSk3WA_{oD2C zX_2JW=w3d^t5@#U=B4%X=hY9ldh=-Vyz%%nd^-Pk&8amDCjYqn`s!~E(*Du!Uf#Qz ztnGjJ^~vk}Z^N^h{}->5n`hbMCHp+MeCsW}bx&7Ui|Ebou9x06e*LEUn=O0w?fCHE z7e}+|QSxb?&yR0@G<;U>t-k%orKkDi##ws%*M~P*`1XUPDxFXN>2zuP5B96&t^LM7 zKRQ|Y)lJr0?>2icy>kEGoV_T1@lE{0Rp%s6*M51J9;N@(tUmgSUu_J(dj3B@{6PQa z*&p-2TzcjGAv^i2`@gMz@wdmnJM)(Q@5S4nE`9RNi|WUdzx>_Xi(f7+y?uH0=O3)U zecS!f-iL3W=RbJ7k1wIW`sMlM4|c0pzdq}%{B>*i`|#-Z)vNgaf5;sirFZUG-pw!H z&R1Ix#`!PzSAV#4(>ed<#XrA&JKx(&KXR9K@24O9Ros4MKmX0I-u`~lSpM;+jd?TA zZ`4iHcPHWeeEJkOMt}EdGuyYqjW|yG;gKF*L_^$wT?JK{$CcI5yF0tvpYB?nrpr^b zYV4n$;BIA}Op|#szN)e^$;MHbCmuf4#7UsW|7!~nV)2V17(LGVY@A2ozm!HJsC$+s zd5YVkywo~LNBHH%2#_R7!Wh?BxV(zeOpiusIs$Trr=UezXE39Lh%vGF$t0KXFh;_O zKaS~9K(xr90gF42z>%Ym;IfQAtOQ&ZaF_#c%~KXQW!oOwSk`PCRe>{foF{-d&QShr zCTqxK|fo=D!VUMMr)f-y|+(gcpCNggJ{MJdmPT-Vvrs zelaRc;_OA56UeemCLfDrKrGdjHBuZWf+8($YY7rKk!$+(%V4v$0YJ~{L?)TQrLbzU zbzZpVIFJ!eiERcWP&SmN=Eb2BPIQdwHZQoW;^)kUg&Gwv=0K9IOiP1J@NHLuRX<1^ zseYNlcgki87W0B?Y%G~DTk?13W#;qtc{{PPWXpp_B!)y)kZl1KgQ`Kb5H1CXSgj272}dlWrWn2}IFapp5?{=X%+#Ifs^?NB71NKR zWa}yCCW=X(=0OEQTIdq9V(_;*SZ9p#u|OpiYp82b=5LXtASlK#7gk%_f}qh*@4$`q z0PsG%wkpA;tuH9N>r067VK@?NGqvQ6jGDBt+eP_b^?o<D!5v@7dca-T?7YL@Fd`l_rs1mcLb^-hz6NMeizXi(TEyjHZ-&p&t6QEl~;k%BZ zh8x5?p0-A1BZ0oFy7et^Ik)ud%xy46cf_WQ&%Tok&G*0tL@MurK?CJ)0~aXY1HaS! zPWJmr{0pSNhpKe=9p1xngzTje+H>f!<_ZxAr))`b(Y0HW%hqcr%$ G_WvKQXk;@0 diff --git a/xemacs-packages/gnus/etc/sounds/laugh.au b/xemacs-packages/gnus/etc/sounds/laugh.au deleted file mode 100644 index 1435e18513762757942c4930f84f715481f89b65..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 10827 zcmY*z>jeAmmmM~&-nlT3qk%1@&xU_IigXFJ6t&adc7PEtLlQ?lBQLyBVr)gkE!pOh@v|vD5h9hnqiNR37o}w8Lmc4R#n&hz* z&Xe~W58ZK$M{&*~9kCP@5e|a_O))oQ%eA%hl<)xS}|HkHlz(yq^yz`pja{XeyDu zpQ-DWKA+iCESU}mPdpZ(` z^UOy)iQ|e-5GOQFFFzQDzS4N;)s0eUidn7*g1=%3A{j{T_k8N|IlqPJ9pieXRvV7k ztj=y*(rz|I&ScWJnS5UGQFq8B5(f;ihUkQU*B;#xgZ^D+h3 zQ5()5-qH?Bcuz66udg+A-JM{EqY;-o%CO{}yW!~ldODv8VIy6_dY#$38x^wexl-ed zYsA0*^>>lR(#`(czrE#}YqjWikwPg_90#L%=HLIGYjlS$g;Xi}+YgC7vC01HKXR33 zXRnw3?XQ1*mKjFHfB*YGviZ`<{^Oti=Rf`J$;{?6nYXw11|@y^+wV`}$Y(yA`Qwkw zASHeJ{ck^HRJUBny=6+6Mf~*p?_$Gp(5~j+3w@(fDi)dfQL_Q`{iIPU{{30bE=I+- zw?fBh(mwxCy68c(@JDtYLzLnlV(snlS@`3R7K50S&rkb_~}{in|DfoycbS!qwHB~@N9aS_xvGjRfwfJ=e%2bd+%O7 za`CfFN6wmWe`LBBqg*7G>DXcBE!(FeN{LveXNQ%yO#2X3h@Yhzd{TRdCR#5QJxf&g zQTFYhD5!P&6n?1rAQ>zhnt0LuDJE<#A1md)GFo*rDjAg z7E84VS;^&!wX;Vf5~+;Nk7_Pk9Bz|Rkw{}D*WFyM&|CTqGO&eIR zOa?sO7bfsG?f&>{AM;pE1|*PTPyKHHK+$*9>-DE`ZoAs9=bK9^5Dd8yZ;an>maFaYa6*F^ zNAV=HJH#WAcoZTm&z=_Z?VYEXlsA~*@6>*EI2>5NvR&X{*cZvlfUa=B}b$JypIsu$}VcTSk)I-6Bz zxK4+k{Ss{6bUa{DYISOzb=j*_D#dcwX||X&1`Fa0PCCtYx7GTHMu-EQR7zw@y^kIg zvV}_XW6hdnKc2-#7uG7kV%%LgETWJ~^)JEAs99^Suk6==@gc!fSf`J%SCm`S>x0qo z_Nr0AJR*y3tJ5ep&jy`ICDVuY{eC-NN?Y`1y-M#JcDv0|VG+<9^)k6}J!m&d#Wrg+ zYUMK5W!!D%3w5`_pjD`?WWUoa6b>%EUZ+qa^M0qC&yN#Yty-!u?MAIyu{20)^%{jb zwgE1MQs1Ih%4NpDq1~wF3ul*JC6g$TNf%ad{wu83sHH0FSHD>;lqXS@N+y-ZR=rv& zS7^U#RdR{O&UPBrTy7RIY1J~BVK?kn3)#j|r`E`%nhVTWsnEP=l}f3^7~XXn`CKV! z)@YR~bEMyHmU6YdOQ}@Ibmu`Em{!+1g;Fk6;?s7snlF7ARcaY*rhP{cX6-kqRZ`W< ztPevJJ2#D5Es@yx85ky4N|>}-nZy_w_S&!~4{oK<)w&q8s`+9+t=7mTGB-$5gRO^J zG-|M6blC5}_*2U?ue!AwtwL+(+O29K*CQ+{=&3&r zdyP`AveK)y3aL5$)$2C01s2g7bu!h;}DNHotf44SJ=@x*ZQ1#axrtD8b~)#D37JXY)0` zQKyzEO#aoVUdUADQJq#Qk$d@dr<%!@aGOC1;yKUrej!urTr7H}NQ%U+!+JiGU!)yc znMkHfFki*YdwJ-$>cO`eJ*#f{{XI8B^-8HoqVV#aQuZxdy1M1y>=Y*Yqm;|!N&~w_ zED|Y<{&55RVrf9CrQl5Uu3NMC2F{tcL9~)6LzfZs&K6H@Ej-E%?6{fF<%>1KssR6} zH1B)0LZMJR|4c0BFUntkwhm;li%hcZMxLPh2OT8@#(MTlG+v0;-4meag0lirC zERyNDPY^y^tZtJKlz;|7Tcun!R~THZdZk1nx5XiXHoK$k2@U&GkZ^L;6_13%K6fB- z-_J*#&TMlgVxCur%k9IN^M1Qn?jTRSLC@xMPkW2bC`Wh=EsN=+_xi;UVjdI-RU`L)@!xK&~4joRIBv` z7uKtkh8N;I2lq2xLkeiJyhhRee7f92Ns>;XEXA-ib&nv315(Q6WC(H|J!Y-OfRM*Q zr`75V35OC^z7y*=O6AJtG6cy&1$vQVgee4OsdewX;_z~>JUeLh~<7bGP}`?iiAT>1o6fR?l_)84nJNV zw@VIcg_IvbtcZ&{uKJz+Y(Vhd38FSZhEnt zkH%OS0s=GX)a&g|cSXEPVe+MNz5ip_spiY$D|hod1DD;h*J$^rT-vLJjUbh3tk-?F zoGTQI)gBhIsTB%)1Z9?!JsFQ0)f!ifn6wIcSb`n$RU(ne4NE1#yJA$>-O{;OmSBqalxn z+po9t{%}R46A*(PfkXn^t#+^*ptQYX=@itb-1U6it#^mRfloz4LBBr?RVck*u6E}u z?)UnmG4yttevC)s1E26ZZ7+^c0zYq88`z3Bs7KT3J3~Ree7fMN6l4&!YI(omp=<`&00Xg)$J616CQ+~#!CVRKN?+rV zB!;I6X0_X`*Bq7%hobQW!CiLy)rI0jFV2PU4npH9>fybym}Z>}6TMRzb33}7sjYnSs4 z+An09+N@9X=|Clu{5|PU(I=Lq)|aUJN=5wfuQeAX4h)W7w-kR_&F>fv&M%&Tqz_Be zS0b9k&`A8wUAEKVXgXUk1Yik1Z}^TSxN|(}ImTeNmD_%*2Tf#_wl{5qug2_YFWvGS2t<;o$9)^4TIp#6w&;f3nxxS)CFc-72gDx({?LWwf5 zX+zG@IvG_^PRW9MsPBp$#srz6Ji6&*h2#a%$e`}B-Kx1vz7{oWq!OtGZxphbLM?2P z0F^1(DrIuzv_)vrc)OMSd#1kiLkc94;U5i1F#04Umm;w=vMgrbv!$U$C6P!?$!RH{ zD^w!}g&2f%^vd~6wmM0wq~M}GR1fGX9j8VrmOy3QujZjToRBK1RBduCdev%mcu1M_ z3WWxsoB=puNKKAh+G#^|A4XU=Cco6L?7{?%_) zE4ALn^J3Mh&3^2(9yL1@obN_e0LTuo1bVzD7cBn@>1WH61T_r)xgXe_Q6xobAMP`6EaUm_K-g%Uxf z42j+Lqh>BwAD>?|GMOIKz~~e^R_#)uRPXkeQLRV>T%vO*^@^oZ z?K1=!uvp^VwM*rCv+O|@zt<=hK4XA;LFEuWj4HXeY&HC1 zkxTU9eWzK;75NwN49`;iW!5XazqeVFP9>2U4#Qe8Td41W%d^Om-gIi&Z1HZ>gE!K; zXFaH1Dzl^xz%{9lnN(rBmM}ZOOkxCGj5~tXCWTZY(|IRd0F6pR%wm#BRoG?>s9dRU z1;Ir!gKz)Y$-FfvkHxGvcn8f|F`ut*^a|_pu9M&@!G63@mrt@zX ztzx!8IfZ&tk=TtI1t=0zF1uc)u;QEbXQ?oanshpaSROyE2K8L77IFDaa+#Z%Ook;` z5>CBNE|MB<)TEiumM5=PlTvDmK~GCM*gH>S+T^9rJwjYEKKtG8# zMqI#$mxdvSSt2$D*G>TOr;#kXN>TA1M3n3%G4I2W!cS;!LVyVW)EWmA7 zCxlTA``#MAbSv+f{FL-TG*FnC#h{ogHdY9zCek_au@FUuycZg!I(!GkaJD*j8Pxy* zzM_*(1^oXhqLWJ`N(-|9kf7MwTQm?=%wf7)h4?n)-4Mhi8e%hqrBLcSbbvU@O`!=? z_ix26ZB)rb5*xnhHcHw2EMbO-BvGN;5iI#^iS`&}60zDbA9gE+Ty+Wy8C;AtHR?4X zKDIA<*k&@#ebMW{7A;+0Wm14{4cGOcS%RpTKr{-e%oyG*+JNlT7d8VhSA)Y{l(X-J z#=>QSVo>jhpGNujcOmquMZi3WeKg+z++GkyB~<6m*u7U4f;Mg!&;xad*jHiS7B}cC z1Ynsy#;?Jeg*xswftqS7fBFOy6{?pwBB+fd$Q{%)rRL2CQCX%%qW5J*2;fW7B@>C| zdVBcV5WM3WcYeA@&u(jeW>N%-gCWU6mVRT z>@|ArlwkgbbVwz60%!!HY7M~U`X_5vK0Q5aklFuXcGxG*0GUw7hKm8EPef*-5d(Y&$#}L5W;03)mC{Z(+ za_^#(iJqV32KQGNR$Qh~CGCKd0O*_Aj~W0A6*|YTLKp=|dJXtakS}+`Cdk16wZS*7 z3OLW=2MI{}vq)-9K?M)v7F#j1;_1f^i3VNwgw&)k;%#CO40^1p#XKzg*4hf%K1tQc zvRf-cxm(%9P2g6=GWYGXRw))BA{|VC(13-VP`y^mfYFR;vkI~wiNUdf1q6(Wy$ zZ0r|&HOc1k_2EUBglCDu$WF?6kRaEXIv|yOg6|dSH8{6yHdmi;u$7;lrD`)bZ5Q)} zLb1DsxDCNnuC?;>8id12eYAHQAwJ42-Ysm15+DNSghL~TOv~)Q^=beC!xM8sjXSS@C&BfOsu+s$T2D2-Dtof?o|sm4sMdmu-yP_FmUSG^F= z#44j}(aFBOW%I?xAPlC5`I2anWWQd7Wl?T^Q3>#35~)I^3$mSR5mJp>XG3FFa4ZtJ zO8XMN!jj76%gy1D4cm-Lwa#p|+Jl$X=b#6}FP4kt(PuT8%?7pRHO4@4St?fQ9l-Ow zM!7-->A%Jh<^=>Hn}uYeF+7`mZ^%O8^pz9^s=DZ0t&F z&v~snAqUr(5Z`Xts#Hpq+Gu@A2f;bXReGx}h@QJbs#>YF*A$m?`=q?p~NV5zi69Q`up#Y9qBE; zd0Uv}e6h0(+pT)QhNXI|D;UKmoifZ?rP}|(BW?(pVu{vlk6^Gafp@uD|2Vr}tR{eK zWqPY47$?W=@BV{1kqA4jLKbc?zr4Enb-P{xkg{A~F=?wt_!7uvk(A{ z;5(&SlLLy+eydUjRa>KF%8M9u8mOy`R`?t;=+-KwaIh^svj^O_A>wZ>qwdcxRx)NVHFjb{I2M{!XP6e>orkKG+jvZwW+*X{NO z!!eY&>8Se^F$-VF{E^h{O058P?+<|A;f5!JK9AF3x4Qz-B%ExZ4vWu^@nkmp+8k&+ z847sqwilZN8UaB$Zf2h!6Tl|c=j%Ng4FC%E^5XJ^Q9y`}tHsxJx)4-g2s9RrhWuWa zI~-5*tT0pfa2Ng<MXyc~AB{eFKq!Ql)z%n=Uxygq@JgwpD;+iteo z-F6Eg*cA?mB;yf3GzX%I^o`ywXX7EvEF3aOM+0^+ju~-yqbc^hn|_Q&qseq}V)%qW z;qkZw5fld%PrJ=V5OsICl2|$cAMC=BXdEDL;?A)E(d|K)!;xlrG#QNmtQ(HTgp(@Q z3jj-Vu)x=5&+u3z=yy5n4%mmuJA2qHKPThS2vBL3O!*vE3rvzLk_0eHpqQ<8CzdBt z$#^Up2OJN;aPkIt9pH8}oNzgVJ+HSr3CP@|@qS~k!r2l)AmJhbiep$#0QOK6?1kZQ z@CCp<^4A=LDX*@I6)X;5P|(&;Q4*Q-JeV!n*6f5z*68UNCN!8FkqL5 zz=E}zhaNmMeH-PW$itF9=iw)>$2{E0htU6Z%wM7iETKg(wIB(o^Gzz;2zT)NO)VJd zr@HW3xE|67)BinxASwuh!yl|Df#}Zxg{cD0Ktd1#zsJl9(mre;Gzm+FARmoD2d{zP zK>{yfReY-tpFWIQ?8o0+~Pz(mt5~Nh~mV2rh6IhW=02LoA{DgIM_aW-s)7@DVzE3k%fW zgpVGNr$-OreK`evTr@^pnFkj|Yc` zt`F`&_)D3`=s@^OF!JZkgPYLl=TZgd#h*Xl1`;~|QblO`#rbjncoy#95_o*y{m1XObdTpp<1cBy QdkC5c*H21;UU>EY0V?>K#Q*>R diff --git a/xemacs-packages/gnus/etc/sounds/shotgun.wav b/xemacs-packages/gnus/etc/sounds/shotgun.wav deleted file mode 100644 index 5f48898f9b18edef00a5e3576c0e3e7f0cb40ec3..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 13996 zcmbt*cYIV;+JAOG@9ygsU3){tMo|Qm-a`T*B!mRgdq`$7lT6L@+vfH*JySB1Od3pj zBcz9f-VqTO5kwFb6}#@bwztXe-01GQ?_a;q=lw!%Cg+~>oacGYbDn$W``nwEvSmyA zinzGEgxn;B*8Jq%adC0K0{{A+jGOuSRooqM@^W)I3HlHOK@xThv)eKBAHeK5L6Q{B z&@@evzW@aQ+86-vOF9P{W)9LB2|srRVt?j82!olB^9ZU^m6C{p-1{&vq01OB1IF2z0h2zpGoFOD1 zkOI(UW*kmn3@zyhTqNlTgrgJ&<^})lpbKlKCGi|d(lkc{MHm#w0j5YAfMGZc<^ood zJVFCSF_L6}90arxD2ag%jS0KCvTn5iJ54pTs1dCKPjWn?CkX?Mdl{gk0F$`Y1C+Ge zfk#P*AR%0o(?)?|Ntne*l)-485OE-lu(K@5VkikAEI~PWh_E9-N7hcFEJV;Y2Fy?5 zqFc|~;joP(Ep~?p5fI}*5d>o~ib5FFiSQ^!TR8$na2zZ?!O{$6W?+%P?38HXZ5R)X z0M>I_fqH{J=MLtrEpIOPVn^yeO~F33CYIDuhwZ7x zoekM+n^1IlRVSga3~z16O-?AB-{zFp8>^bFX0c*_R@XMZwH)h68&S|~V4J98!rKP) zSU`b!xdJ4hb%u8il)BiU(j>TXqq%`F`aM><(rvVOfK%WGmCMSrW&$CQkjhJ=Xr0At zwYf@yqFc1#Cc7Y+0@j*F{Z`;}QP4nyhhtgZX0rP%cGQoUseqP;7%_-4f(>G;MLXVT zrA!W&k+He`Dj-`$G0r;3MH5H`4~rg)8^#@#CL*M9vmDA}yxxcS5Dc=?gcBz4fE}`e zP-kqo*-6<5ry5MlLN>fb)t(zNag5bvszVuGN8k%*2*^2nxMxVK|LC?7vms#aOSiJ*wqP)xKu!u@G z4LS8RE{L!d<8U8J+Yy1b@DvAmAp~Zvkf5rw1t2x6^I7#a)T`l4sMT9#XY5F;#pXM- zwyk(jr_$4zBXC~bvS|J0*1@&tUMTaZ!Cc^*$W)_lA0iJ-7OD%JYBPk(hqvdCG+550 z3Na(@GP=BmiIq`ZtJAIbuj%JdQyrlXSy)AcF;;ivTLLDo!RdBZI;;_^TR>Qg++I~@ z3*7zy?jC_dj=8d@7-onj#k`7)yY z@+OPlE%#M;&04v7%4VTJi3>8`8^MkJ@)ZZRG_gYqLrmrP z+)o$0oRmNA3OG`P2~WC_s^|_By;2q^-fuPU94psxwn|@BTjKd;gAd-E8zLOBSAB7} ze|>wUsl4@eT;k_}%)qIn>p#X_LE`4$uIl`7e&?JY1Iz9gp1ytW?LP#QoyE6T&vPw% zd+^L{X!V@0;uf|YI+1*s$-AA7#C@2ZKb`!@(G?2E?FHX0mpy7cQ{w-0vEsj>d%k@l z`}3sR`hoc6d+?lUnSWSzTd!;>i&GR7zweMA{*~+4eZJwO>4Cz+FXLX%8C*IUN`JX5 z_h@j`;l2Nb0j(zMWZFf`7W&!o^#{7jmN_qb-eGg^zmVLYxo}u0>r1``%akCyRH`P% zl!2zY*;d+{Dh@4~D2BL$0kq*+*+=@KtZ-1-kkUktC_0OKc(rC59~_RaU*nro`tg=) z)^W%(o*hY4p}i+W4c2Q8KlPC2qTJb8(CSiGG+UWyv&?I?#xWlza;LL=9r--HsntDz zE6t+CWv!5p=8QM;bjM2E(z>KM4Vm!eoaWIUW0=yrE4;}KzFUUD`27YH8PyA{gJrYM<{vkDQ%QvgP`yG*Zu}awdLCOK4axqf5@@-soJY#%w z*UEt${o+&kqpt_s%92Nsr6(%eRuL@acb$3lykER+&CXn52jmhxXhu~vy}vYS?93+$<9nHaOHrjhZC>HFi=&EGqbt5$9g{n<2KixS zlW06yT_7Zsw1ww(2yK|ErT9>Od0~AX9ZT`LsVnP-j0PSzLGp}7)SG?MpbxY`K1IK> zxMRuS(nw~IeOqi?N0{Bkgn_U24QCtb+Kq(~rWBr5wpnRyVtdbq(e@X*_Gg7`m}>wr zF=ZMP8;JMz`D}a#wAQ9GPZv$LCR7(jb?6y@^^>WHeZ$%B%O`Ick*ZM5eM7b$F-T z3gww5bA8TIM&D00n_CK9u4;J`WLEvT${evR7Y7v_p;pUXEpUf9n|CV(ftHVZGp}bu zCVIR+3s-40^~Qmm7^M%C1?>8WxjAg1)KyJhR7VFiji_142BUl>y2orp+Tdua-W);RX7SFCPpRjfxnJIE?%u6j7hSKyWpHo<&ewrenhf}8XFS(Y;;^_Uo?4en3{%Vt&k ztVW;7S&x{a!Q9TYsNnKBMVZcO&#r5i*NLc;HjbACvn%Tv3`8*kfkBd&AwH;A^1k%RZO1;n5 zTm8=*#WO~B+Ro}cxtsoNUe)bJ=4RaIcLV|#<4TwKZq+^e;kTx{zK?5b=R)&umpxCP z%Uw8~_uhX-i;W#|+puU$f9Zo79Oe*$!lP`uF6AsK9t90<^ zDhipm@`8ycpYK1oAl|9LG5)QzVBGE0hKx6SqjdAhoX4~mkIwD>vCeAgS~IyfJH=|V zUCB48HD%EEn-x*@i42?O{=wcYAJ2b#$uXW#PN)@y&|c^+QkO>1V&Gi9w;a8e$K{4P*ptH=d zUhSdyk<8wpqjM!s1g94%Y3RaMZ`*V(`t!dJv6XYh!gc@3)$QdPzh3-9{bU3xOY%o4N|Co9*cUbR{3o<=q zYIf`~wlDA767;bp;{k0J+v=AaM|us-i+x1}^{&wC>)%S{%c^Nt*|xWqUdz6o(OVFJ z4`kzxK22zTyFTj88!ryPn`2gIvB&4_O}ABs_XL_Kp$fB9c}pg-Oc7k)jiwF}T`{1* z+7vh~_lBlspIW1CJ+}6C)0Q&*BeSocS@Yf~c7a*9RVZEzd(uDpz^aafbC0cQ@f98Y z?K|f#$3byF7GAhLJv%O^G>*QV{o}xL-6IS4`fuOE>50Vx8(d-YU|h0XK$aG z+ur!3!+rxZ{V*xX-;8Jb>IX8jx>tnz z`U_i`l;sVh^(V`O=&HWV%^w+;jdyHd2gQ55Wn%E`(4a4hF5Z%v%y*w?YGe8Q#KqmQ z*ooJ{MUcJ67xJVi-k=6UxtkQ$r7hNQZ(X5tT^O=f9Q7XVTwbVmW!MaaCFl=3m`EtG zEYQvwIvIY-QfRKDTU+9};nXc=X0mX=X8DX#7J|%O;>aE2P-BRVW4d;e!guWy{P&L}n63Eas zS7vvkzI=C77A$c(V`yPjdy~vky{$uG?9;V|OjteSs1DHb?$HG>L}WIF>j+v+Saftr zxR+^SiHg0|l|n@$)6rT{ZgrJ<3EUqu8Yv%DC(wFWAL1L#no2R!zJ=a)NS{NXgF2Bf zLWw%F+uG-|TdEaQpxeS^b+{6t_Q;0el;H{d5SZUL_8CW@( z>EO-Iw5~7}G-^81>=-9&s8hKr+e^#X2<`KjL{}DTFLCd!ZVhQF>=AWQr)*qnCNO14 z8Ro+lv;mRF%n1!b5H&WbO?6mSgs1f_u+3>R>jOpY-aOdH1=%JIo#t?hPE{i>Q+Paz zR>m@}vB=EwZkTnMF+oLDD-m}CjyPGjo<-#l#`UQ7$oo}UE|#?gXjJ1837JZF%#|CW zpY6J&M`-!sLS)}n~ilX4o)MgIZ-SRl(%c3n9*T0F^CU#yHRU(pmaQIsF1Nj zEwXA=(CBt^4MC&GD#emL74;DaK@r%f5p`C8rAwfBPi{Re7df{TMJvNlL#5TB3NkF@!&$vYLvU`dRToqTZQv`i zO625_U!W;hVc2Ll2?zu77s@CAzhfGkWSvzgFS_#1%qIreRsRy)ymm>77xJz$y zoAsPv@v#gSF=|v6kv5wIp{%Le;jnu+T}Xl3Jr&?o(B`dz+^*6V70n0i%7C7z44AAQ z%!$z&l)+gO&e!R@sF?!a8Bv=DLJ7MF1=X+_3b`1&nk8qg7CJRMbnymJK9`UPTh^q|f1E{`H>!v6@LxhYDor*B=7M#bU8i9aO zmpNQrPXJQDp#nkX2yqAtVMYSN>|$96*Reco=j^aU9e`~(ZWds>m(hr>h*mK2n1L5X zH*Iqv0^-t#7!w3|14>}4oS4hzBy3G`kIseBUYl2E@|et4j^l8*1+v6|vy1>She_Kn+F= z$5^|whI61i30v%ql};N6s2@S=pkRBThIOMgRE-NI1=tTbNt#i6O14ut=I{ z0fi_`&thIHkC6<$x*6F6gGXtSMyIgB7tSg;EOg5q`<&DiVA>>!#EP- zEs!9Xc*IRYfGYzuA6N+|@Eb-UC}WFS+!$#`eF(*&fJkHjJ2OKw0w&LHqaeT!QWVeI zDZ3q}a0~)Wq=mL{kPE|5j7ICSe!_T_8pvZHx`}@_=roMS_6{0mBgnu~UrQ z1NyUoqXFzE#S?@LFp4||Xh;Xjf`NbtVG-8O5Io|70LKOVLfU{87(sKSgSO(d9V1W% z_25nzMPZy_fE^?Zh)LSb1ICdt0b-KHS<)==t}tLG1q{PzgusD+fei>Hv62i8@qjNy z0NDuSiGWB$NQR{mTm;-KX(cHZcUwtPasgmGC3;gDXa`gy4A@P;!@>-(laq*BF!juD z5%6*(26HHwzzOJI(18b>EKrWa0KEgqML_8SN*4SFe~=VsXHh^JlQafsPKp34O(P@@ z{7T>`Fb2@BEa*=Fb{7Q}14bFdik+Z9@GuktMA>OT?&36HC1*HoU>wE*(`evWl%Qxk z;3sLE1%xS}f@i2&z@BnAa6ITQvBVOOj1z#m1q3pUOUy5zZzUBaW)~<%0B#igK>`*V zaL)qMHD|NMBpG3Qr{L;pQg@T+_qCz~1BMuYUGF60Q!gC6E4kp=<6voANa_+F94w(lszXb>!I5gHyx(QNbe1N_hUM zSr6R#rw1N;Y~BkmE?c`fEu&CrAw_>M)DZNzJi*4^gBNam{N*>_|HprQ_m_`vyngJ! zXm?XUWMCM!)>M_`q^57%l9aG^*}NwodEm}Fe*15C-1G3GPd>M1OMwbz-F2~^@rkLE zuf2Zd>PO#y`Qgn^|Le>5KY0I(|NPI--u>pUUw!k+v5A51_C_yZl9kG`lh!U-w(^|3vfBwg% zbKvmhnaK->z;(6twZlgydL|;ew1W6YfA`ond*^#+i!=2@M@?K?54Zf@s#?XON7p9h zYnfp7Hnq^UTPOSNle=n4XZ`lK4`?)h`0eA^G`sZQA5&nu&X0b0*Rz29{D(tjY0=ky z_~GCWKYTK#{L2q7$8vjKpX>;cHR*qPp!(Rm`W0mNXFq&B-ngXn$i->ftbfj)Zc9p78ypqQ@vQy^cTb07nJq8&yFlf(;&Y3zVjDe=@zy5>Fbxj@aXS; zx3D#!&z<{+)y(JL^(oQ@cNh5@N3XOGpLp&1*WZ5o?HA*&gx@a}-h`g{eR}(iIyn8F z->?X+J!COPFNrQeFpdLDNW@oY}W6y4q4{?KBN6TZrvgalw$TwxyZ=W z*WX-;EM4V%|5$CsAO4^?ycgQ~hx?(6d#Jp7{*XCw$T0We9ZJX8H{S@kuYK8NTJ%hY zh7RuT85kTpa{iNVzIp$63#%_oS~2JDKmIZEkAM8*dNtkBKY8NVv2$mR9q5VmAG@l7 z2hMkz3lo<-{n#UqKJfTc^A|5#I6r>vAD@)_$6ou}-@g9ad&7VG+sC~X+aOPLcYpUl zZ&$1}6!1sJzdlH9n{(ftciwroth;LKb7@QG-FfGVc6G^`JIk)N`!#bij(q*e$=x-( z!q>j;KXC5N8@E3D?5|&c{q-&KukX4ocix#$bLg6wa@Soe43lju?}8>h%C&dh6>QgS zzw55W4HxX0ICAQhS1(>ZcI~f!{kV2}W^A!6tKchA!tmaQ^3zk0dv zL~ClUaNw)2_FC_Gsxo$Clq-GUiQNslolEa|vWuMmK)&PLmwR>wr@s91%gZ8HdzNt^YJd^2o=gWPLin;eZ%DeN|-E)t!Zr7%J@2y$%K;kZ#_eKY% zu3Q~$*f)LQi!X%P-0KHjhSKyEFV3HJ@4fdv1nn$OlGl!Y@kP+O|Gh81xZzKRdcXLh zwS0X}v~N2X`{;&lburuj#TVn=;`{D1UTPt#Hs5z&!Rhd(`{Gs6k3OG{HTgKBGACu} zeb1=08}GX>!xB2xy?gY?=~u6P{`r_|`o`y<>({HIpG;QIyYG=L`lE-*!uuCCRU|)s z|NVwBw0z$EaxHq}vjZ_F7euSKt*+X*#uz#C*=PIc*8M|AUb+0~XP;3ut*1YGrKKb9 z{`*&?WR#O*r}O5vIxEsv&42U(39FpvoW+kPitpUwlGNVzLl-Z7`st@{AKD{U?|SKh zdFfTSujl1YKfS)!^3a2&{qHpzS3FR3suy1Kz$)_NBZdc_QwBeMr_V>0FMV)@k6T%W zhr(T>CqMbbjW$hw@(HsxK{xbnD_Q>HgE?&3#s?pqTipwR8QPi?e&@8W{Gq3+`#N~l&gWmOT=>xA36&JaPev%at7+)k30q+I#Ep+X zm-u?LXp7%dK8!;w5tg70y z_~C~iewNif^YFt9^XZ|FI?Q7q#jr&D){tfP_PUSWZY_R-qjNRgRSq_@`{uRjt~y4sa_*w?@hfa% z4po2r!w)~4w6Dp*{8X^(%!eONv{Abj%$j8&o|v^>KYYqx6F+MZwI4s)ck28H9~_Tj zWgC}1wqS>C>YZjrHG5g}?xe?e8bg=fA1mE;{^nH7Yt>Zm+8O`YV^8crFT8)Io!q`o zRwlO!^|9W;>C5lG-&dHdTvZ?^N9*~T^6YI1%O8LI@n=(1T+8&$n>R1V%Hfupi#I#% z<%`S6mOtOD&vLx_N+YF8O?a+g+2aea6VpER@@MgzXQR3Wg{`j&c1PEdn>R=FRLlOG zH^-|BkdmFc@QFUMGHvtvCG(zm;)!Q9nq^OHGc~^b-r+85Qh~kk?0b9cdyc*L-g{HE zxdmv`$v%%J;fam*qt^ypvZrUKY4^Q_rpSosk+>3erfkw&&&dgmzqe9iE?XByPA6Iu_|S~8!U%MuHo zOoC3oUaQ$sZr-M48?U@G^y&~(oWC){W)EC`XQDy%)OuCR6)^XL%t%0+@U+pq>d7Zl zaGTmY_RdMoE@ASWH@cC2$!`&n2-v;Sb)_!?1 z3}vU8QdjKQwSI2G236sT?RqxUKhfL$_S=V|tU6&`@-xqFC?;FFubuA+z&T0ky`KDM zw(q&VmstOjruNnAw1x}q8=1a-{f$ANY3qWW=~mf`&pZ>a3REfa(7^TU6V-|3)v%}U z`t_FbHNn#@Xwi~633xlBSo3Tu(d9Fj=`dLy=PpVt*OWW=9KLq#+F(tZ)fpX`_O%a; zU%WPAsJr+|lWp^y?FK{1mc?`CEL^!cbr-V%zz*_LeTzjg4{z zbLVRMJ=)B9bLVbU^jsRL$7P#$$hPFM?N_f}9;Oqj#!s;sx!lCnri@&??c&w(CbDe# z+_`DwkwC?|r73Dsqd+1ju69=@%K~T4x7c&$%}X)vuCv*kd*3|Oj3jTidHm3(7m`fF z=RD~vikSm%P6rk1q2V6$>P>;^VEM{)JmP3LIDG6_6F+^R&az`iVp^qz3-`V9=F5SN zS=PvF`wjCGi0MvRm6M#2pR#QJ{NJ*S^&Rjyc3O2#HGTo{Oe zM-8aztYyN+?&+*aFu^p&Hnf+Of=HQP58$Q5R@ zqFRTAPwy>Qkf7S#LssXfE?cmmh|-khr^hdNaqUZaXzbFZ*BUBy!LGwc4;?>$Nx~kJ zW2o6K+qlJqL0YZ0Z2OBZEGjTq*kIT3OCA1b$Ka7mmtJl*?Se^7;tQ(^6}!?Gzwp8u zY&=XTHZOW974PnAcWJkz*Km=(y`3#ho#U^*{`$oMZpVwcFj>86Q>ndWD*eQu_1?A3E^ZDVKt zeBsPQTbQu9Lp51T7A;z|wy+vD>xvYV*x3lBEm~B-44)iewydh8yI(%u6?2sD63731 zpvkU)c(i2EqBZi`SC2+y%L|#obJGz;azRaPXV~2qHRYDV!O52gh2o5IRl%0{Ok4Em zNRtCCU%xa}?H+sWwE>TMdydM2I_vvRzV_Ng*q*m|h05pLv8uonzHlK@yfhtYY(!Mb z8ZxwRY9CqS8END6xi7w$9oZ`y(qDX0*${K8a!U=o2Q_kgq6}bZJPonVzTwfn-oDO# zr%vq)SV~j2DokYwOP0uaQoVgis;8UXxk*=h_|@|xO<_)!Sz2NC9y&iF?p&IoqI%9_ zsYX6_K9+~zLc`GMmxm*SzC3^XmV^y!H*8qBbm_8XSvn@PyKi**=;_m^PQ83)a_`>B zGv|)CP=?CF9m$D_@f+8zNz5rL-&IkToueW-Hq_PCGjaUv%QHBAaB_4qwx_En=9X_x zElXSe53E>WZmlIXJ6EI_U0ugO=d)7>51crA_Uys#T2uB;4Ou@q7RCyav&lw>E@frn zE+a11HTN7mdv>rfz;Kkcs&vQ3RRDR~YPkyK{SAA%2KG&jbnKlvbLK>+(^gfqBPo8} zy49;ztp~j{E=``%*>&j1F<{2glfaZyrw&a_PMth8?l)#;XpH4qDGBi#H^#4zPfE?o zFD@%9N?RSTAVVEPV`B%7o&-2N+Sk6jxv{aKuC~_i^C0^|(Dg z&ZNjsS-(!g`t|EKWR$2OlJ|Im%{^md9kt-QzD=vvXlu+yt-89hv`}tDajRK~9g{HC z>~0<%ZRR=fBussGU;o%p6e~&1(K=)OQM@=|qO$vTH*zRW@t%fgz(JyrrKYktB|ghi+qZu_7Ha4@boj{r zCWo_We8`LFOa$Ps%r=Z-XjX96bqt0~B^5@BG^xr8GqxoqBqVIhE37D!RWjkA%jMt& zzn=kg6yc8bwD0L3nLKpp(CEHcB-&I5!TwtaG9yt_5lJ9OZn-yew$_c4HvRhQWK ztg^~rFc=LwH6ThFx(4?jnEn|<)6;znOwp{ft|=C@m89k+{emFM0uOk?PF$-e_6s!NvC&o^k6Wtq z(n_jIw`Hjf7*0891l%xI=&hva4c12+o0?l%ni`uU0e`KZDpoq&7WvLJ2}OF$203^4 zwlvlG9Dv4y%tio{#RdWDk7hX@)MQwiW-bp`g#_tM&1`lhl>& z_yuwbiwkz{EHSac-MxeVitebF!HjCfu3cpS<+2JzB}k333Kdyf*RZ>*Z(#2Xdi(b7 z?eoGlMhMo+@-ijlmsJ^HKmyX>d9y$yz#&Gn&S22!v`Sf7K}kiWLZPg#(t^|=ie8V~ z>+#eE>%05^7n+^8p`su=yQo4|sWDb7tF#7_1*KTp>!EDQ;@s?iqF|R?X<_^=Gcx*S z(AnPJ*%t9STyB@gUl;X|kQO9{;=)p3O}R`iuR;J{%nL4;%UkRB`@oL`uNyF91OjRS zyvtt~X^1v~bqt4mE|Dd11c6P83Yn}ZZw3W<#pM<9T|fOH9g9lKWU_KS9d7Ri==wX_ zc87gVrvqpbXpD7At$?CzYj1CB356P(np{v-S;4=e%7Pec3^3^q@7dEB;<&n&dY>H^ z++HVxnN*d)9R`yb#(7UL9Bpc8*%RBdr@f=2qmDz(+Nz4O(vo7Z9f|;CHH5P^(%Swr zn(IL>#O#QrMx#>hl4)v;2+4{rFR;GW7l_o?1pLxNNKfo9)~v) zbZ{Kc0vZ>`5ZGcc)M)fJ+7*tr#sC_kyLUHwDcFKSHJTa-Jo^o(a$a;eojhh#$x2J* z)zvB;sNgv{5;9bQcv4w$Mid-we-JRJO+n6D1Cfj?)X>^e@8<~cthUW!tkG*#TB8-x ztIU)KtP*%~8thkqNElpj0uIDv!z8jDaLoW1;8|6ARYj%NVl#tuS*0?A+NZU~Lnw;oK z#nU8avzS04uv)AL!Mc0_pV#B7t#$FBd?Qs92ylG>R5qZ;?U2O^0}dPqbyz!rBQ}%K zSff>GYD`uLMlp)zIML-41cB$k)5{p3&uP)^_SE{pYWQp24uJ!84vDh|g$6qW1JWJ_ z7XzKXMx(5%s@7<9Mj+4vAqa3e!-{UN4+OCTFwzatXtcgA=npnDG}Hm}Sg9665s1wO zikn~-mScHdkkYr$D_LC)QV0+!K~-Y~k8gvkA@GT$3D_7S&<;Z&=`vylPXO7##o-WGmZ9uM zwOXswfxC5$dIlPO4G1?56vA-n%>?QF1fZX^N}#Gla}JPzfRw*Oav)d@7NmEO3@iq% z<|k-%H5L?N=`2BpfGcn0Mh1hUg22-JVT?*^4S;7<@tpgaVd zjo?aT18V|uzGdc;1VTl!X{M|qtuW1Sq6360C?TR4SU<3GHV6ieoOvlj3ecGsGk^;~ z^!@`rj|AthJ)1Rb~>DH4+sGOX%&EB(n|>#Y%v?b z-HRClb4vv~u(46A!2q-dwJ@NWz)B%6=?iQkC?4bs2CUQHD@@=dBn6suT5>f9YGgB; z;U@=yw<%s1ukqdU$3>+L-2^6-0 z0&EcSunrdFv;@U?a>VC9t2Q%A@om&rGaIc|wvQ z0r*=A10WadVW5rV3n})6pEe@!Er>_(-~d5^hXg<#FJ2i2n0NnK4IF0e}Vlf6mE2uL2MSbOb+=*}#0T)Dr%=Ml-o)rs zq*2lcp!p1b`Yau#Sc$ecMyV*#X| eGnncAcLn|_>F4JE!>_+j@Uuq$2TA|mL;oM6BScpK diff --git a/xemacs-packages/gnus/etc/sounds/snore.wav b/xemacs-packages/gnus/etc/sounds/snore.wav deleted file mode 100644 index bda1665b292de0065b3ede5bfd77b83d784e09aa..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 51326 zcmb@v30PG5neU&ucQP|sCUa+!OqR)XZql8k)9JS3zUy_v9U25g);~M4hJ7olnp&W$ zSc-jL9uaXvxFR9~!XqLABK*Y-72#2lc58XGZQJfn(*MtU3heG=?tSj_pZf!fQ|FvI z=ltH^yMEvI_bZ3ZHa2m6-}uJPHO?CX!eajWfBVKazVSEwG;IHd^7l92_=j)!dB=D= zaE{4jHk&i}ooSg$%TikQf6y$lPkH$d4rW_Fmz5YPCj9OG#1jOG~!4B>p8SEio}Mf#0vUcv@Us953?E z`XU=~v9DfaLpdlLubO-!KAwxo6_m#2t80JdHp*QS6Rpo+eURC0o=ka2>#Mx6ZmE)` z1G6ppYwuE|gLF~)$g4EzHf{F5^_}`Fq;5Q zB#ey=kaf5+GGzRe!DLvKUj|tjdrP)ursd>VEIGNkx$>9y)t1kj{Cw+gK|ZaZK>ii* zBb)!J_8(nAZb4ISr5ykA4UeK6v%Xj#>#L9Y_3baaL6>s#QXhD z6qT@WJggr>i;jt<#R*Tt&9HiWY;1H?WMo7{M0hyAY(+*z#l(p4B*M6G<0}@NWkrof ztA*e68Cm8`b6T2SqfOQ5QnjXxjI1mRY*18~mjiJ`B}o7C3JMDfX$ASvOb7*CVT*q zU{Fv%z;3o8B0|HWVjxW{RE&da32~es6A=~~x;rSCGj|7vM?}QL#YD!Ul9E&@$%#p7 zwJIqoAuc8^7ODz~PK0cuE+{XiDeL zXfkIA?+Npz%OTm|&y<;+Vb08wzf3q;bVHV~GI}91BP+v%#xOJF=nv&+cCLkyl|Q6F zQ5-P7m;mFF)G>e4DVXFa=&zKP^1dEa9(?;%QG@9iv!-(9N zkS0z=_^cX?KJd`eq>pLo##t?Ak~b!FADtJgqllEe=yebWZW11Xk>p3VAhGo~6{0Ij zRe0@{O|lxJ8CA@`8QX-2h{6^HuDl2vS~WTU)yf-%JClff61(|;G*pQSWgvazAkQI2iWAjbi>p~RMT&5xM#u-lLOkWh zisq30imrkmVOb$B=W!qYwDK9DH-jM@j8=h{88aCdcJZV97f#kPZ0s;7ENu|gC`Js9 z;RSWXAae$c&zKr8cCs5*#G8Tb;71g+Fbc{<5f`}^%mfE=RQOhySNIS1LJW`)YlAx# z6(zPq7dwd-vsgvJdS^K(I*xtFNjCqvm1RaFTC#I6AiSa? z5udCX5yGBuEqSOM<-zEMm}4%Fmc$ZqGRm}|P_BZ+SWuGE7wNJhKzy20@(Zwoxtzr( z@^UPB+?Qv~$h7c?NLY4uesOtWPENk)<^0?%V;Y~%KyvhY5i659-H>MD`e+0MRh~LC zlWyc$ldQg(fs*^RYx023kyv}r7%NClqNn|6{F>1+2*VqGXo6! zs4*XU9y+g>C*qI+ji^#3B&BH7s3Y#ebLN$l6c^?dRaBG}F zvn7|#<>t^^-sk0tF_s>r!!9z;GScaoa=5}|N>4|Pm{21oI0wSM+EiLv3)Ng}SA z%z~V3lPRwxD?=S0pQ25|zC|RbMkXYnF>npS!ox!%g1rJlLn0zWBf?{nQ{rQy0|Weh zeY`z_gF=%M6Vypbn&kM{Q2*TlL196@e!&qjcnZ;x(Q%PM{y~2J0RchbQSr%)C3;qe z_DPD0!MtKj6OuGqo)gYYPt&4iuxcr(sd_9?whVZIa1vvZmafyK!C_dEyh1#zd_{z^ zbF*ra0A(|`NfYp?zC&9~ovd(OPMbLK8sv~a<~g^QQ1SiNEW`pw(6**dtm zy1BXSa`W`^^78ie3kVJkkHMu#(V#aKpAf5tDb3DBs!Pi&DypmZ)YR=ibfmt%p`oF% z>DaNRrk2*Wwv(qiyL-=HxHf+4+W4KRN6(&3fB5v%KPmnHPrQ75f9%rWnbyX->JkK4 zo0^gkgRc}E;OFn-zGLgA^{ZDbeCM}s{OtSR{rmqqOPK%E|G)X$zx&p=zWtr=K*jHT z_q*Q}V*bkyfAX`R|LU!G7c5!6dcDo2O`EoCvwhED#|{VEZ9Z}Su3n*8W13N z%DjYdjb4=$6CUIr8Ul+(M1=-=?(&UK7cVBSAiru)UYaQ_CdkLd*3o(Eie+mzY_xUW z>E!CSJ2WC5KQJaf5#KQ(88Sr&eKYaZ7$*s#b@7*06?&%r6a`D>TsoU2sk3V?M8L+UmJ-;({=gIW_8zUD- z`g?~)uZ;|JH@BYYIXlqT(|3O0+{nbljVtHR4fLLBZ9ZI`r%Q;54)b-{zHY_R1+d@S zZ~pSNpTF_uZ-4vdZ{Gav@8-;%_s;7-`KRyvCkF4oe)F5({CfuJ2S56^*M9l>8*lvP zcXQ^SYV&zPo7oiWSROtlhlb&T*%Qe`t7Um`bmXi%AIE9jA_rPK*x^ zkAu>v4GoTaQVIqi^^65lbhH76izbvOUWp8kjEap63-WgN@b-3haoOc$XS>5?r<0?D zt(~)r;|^CZ50_nDzCJzy{@&gJA!w=4@bJ)xxD-)l8m+;IPlzB{@=J<}O83<6Kh$`% zzP=G{+u70C)qSRKcw~6^{~ft9dh6Es_|5BMx5g*#PTsjaIW_fgTIm0Ox4rmqa$@Xq zf7h}7l?6C5nwTJOS7%2%Bx=Q?-@o(roVR}c%YXmz5B}w!zVi=%`=64hzxwch`Q|@- z_n*G?_uu&!l+*Wr@Z+EG^P```3~#ey?%?9)my}j;@0@& zL)!hR`%hnd^87hE?8!%;eD=w+Cl4P#d-3w)PhNid^2M{yke5F_|M>Gie?_+be+h!EE@q=+bO3O;iO3JG1>h{&`+k3F_SYu23@gq$w&8^*CEhpMrPj;R?*W1(CeyVq1 zps(*tPhWq}xr-xxU09OA{+_eE?HxSdck$A|xq;!q^Zh+N=LdRv&USbAobE(yIy>6i zI=i~MIy$;~+D_Jub-BB__v5ghdAX2KqTWI@;MeY+b*8lg-+->o(YI-n`Lf%eGA$ zR1#j#`7hph^UdGB_14?(&Y3fJ?%YL77A;z`V#U(sD_5>uy?V_m z4EEY}n>KFTvSs6@?b{g}+ii9`cGx*!i!dS%&Mr>7TwUC~z1%(h8K_`9Cx8YFiTG25 z<_5)%<6;tQGYQPWSc? z4h#+77`=F|uXp(RorznM)6*~iPY5f<=JOX%pMUbFmoGn>o_;=k|1L`H=GCjCqnC$! zJG*<%c6D{PpE%xhr1@yW!RqpYe2c}P(`XXoVgNq^yuI9Zx;WTv+hSw0X3gs5D;6x6 zJMXQxfAgz<|M%BlhemI{`PN(S%vmsZ&O3AFy#3BQ@4WTf-~8s+zxvg$-}w2@q`mg@ zfB)If{{6LIy#A{<-gx8nU;XCSzj^aFj0an9{POkx{@Tx9{}t!{n!SAd-FfpDELgMz z8?k!r+VvYZZN@S??{snZ^7ZoZ!_o8&2n-0_9k3ft4+#@cB|0%dV&4?JN(n_lQ*bc} znFV7ZJk_Ua^l2FcG3GQ&K}ktvb@kqc=H}yVuxfKh>-lr%dxkGg-hcG;i$DJ9&)C#I z{rUOJ=l7?lKbo4FeDdM*M~|O<{L%EYm!Ew6`KKREKY21eIez`d)k}Td-RF8*PqwtS zwjFQp=s0w#^X9%wn>%m*ym`=L{`>_?mMmGk zWcl(HE7zfNZ8mM&V(a4M`faPV+*%kj?E)|S>&r%(!~dpgec z^`0NOG&**Ba`N7zk3N3+r6UR1zWC#xKbd~|;o}EW_aEP%9KSI-diDC1DMV$$Z~j_%?akl(mN&os?b~xWFz4+#(Cgjb&zrko;o`;1SFBpK zVbjJ<+qQ4Dhig2%@D2O|LxY1uLePqlktU2mSu_8^8SdYd?DpY5KRH{`AK``q58* z@?-x0G%*lgXjX`Ahq zt+q}M?>X#rba2{*%jE3h;^?WpKXl>p=+ztd#_l}$`1z+VKS%dG|NKucrk_2Ze)^dNSzo%dpTGRm%jeS%?!XS0 zh6j7Q+D^2bAT+73KXmZWfdjSGRTX7K^-5rx0Z6Ay0ke$=58EB&>+R*~<>~I};p*bD z({YFWwoNwc)~s5IfGl3LVDZBF3l`2pGUojr5t%dZop<4n1q&A}Sh8&C$`#93tzEr( z?fP}=;h>G{*4x-1DjPR$-n4ns*6mw1+S(FcZQHWV;k_;P_O{z?u@(;799*27UEKZs z{eq!BJQ5KT9~~7Q7!?(ns5e-&c@@PawKY6&%gOc&BbP@f?tJ*-*@usx-o11C&iL5X z%R>VQ#n|<+v9XDXsYj0=J)FGv!PJAhcW#bey>jv5aNn8E69i<9jRy}L*tfT~cJH3* z>PoPT{5$~@3_7hwl^BmR8xkB4;77RaQ&2^ zE?vBM@sdSL7A&C0Y%W?jf8oM~iEzCc3 z`P|^p^=p?#uHGCUyF7gD&cx7-+wk>`YoilmbpFQF2NPp=rluywCnl#Rt_V4<4WA$C z>p6v1Y&uk1U0YkXr)KZ|Iyzrfvsb!b2 z`TF|%`TO~L!I^H(PEI?}51SZ9oAub-^=sFxS+i;dZTZUO%a_ThuV24m%Vt|!2mF6m zSKLwW0AEiZe;=Q~0O%Uv?;o@~C^R%UBs?x5CMr4#y-4q)W1?abQnWy)s`!K?unT>< zKEsl0Dyk}}+EYyVucsTYsI93PJJEQkp<#dRfdl*Z z*Y2&ZuCA%BsVb|e61`hqoR8TB2@Uka`1$#Hd%C*2yEr&F z*rF*>lrY9Be38{F`B{axzHa@xRcqF6+PVd<-@3)t-qFz+o8#o}72xjX6X1oP7#tK7 z5(J_UL*geaI-Xd_kd~Tm$;wK%fQXqh3$ji6^sHPGXrChZ9qGZeP82YvS6)bLWPJ&YnKmajLWV zNMq~CV@K+b;==$GJ+s)*<=GP)?rH5h|hoquvx!)?S{2$Y_`~J zz!uorIXGf>9UWag-Q2vqJ-vcLLUxCfuE9bkCd9?1#3v@I;^Oej1mD)Ds`bEofQSOS zW~8O5k~BCG7SPk$0|y&BPj;T^J>A#W-**#{e?0l@6!U%*`|!QZ-3&B!q~?gM-6EFi-)$zFuyw zo~}FX?d@#wC~Y=wTt|OI^Q~MCqpw^J->+V~dOiEsi$XxTFJFdxuyDzWWs4UqTfSr& z9I%!^VGY`T&Dsq%n{3vg0c|#I-n`ktev7T+Hb-ZBJW{t^sQRE_G(9=1KSYrri;coG zMrnZ6EZMnP1*O$h`zk96^9l|euB@v+Qr}R2@?=Nj@xuoXcXl+jb{y;KJ$wH8y$Q6z zjXU?ou3R7K@9sO@DGp>$*I@to-rm#QT_;arpJ9?tEqwVbo|umk^Wv)u}(Z`ropR-&>En>KIRwoP>Yc848~&IpQ=i|bC;T|4X@cDj4e+}z#0 z{KMd{kkBYpeLP44S|F8dMq;8?o0gVmF&T2Ri>oRtOKWTD4>UEm6V9CO?d=;H7#ncgJtsyar-$W$1i= zZ_l~*_Rfyu1i1bEXV09!I6ORjdEf%}@YKl@O@|NS?pGHV7350BL7%2iNtRTII+-Vn zfePWl{=U9G9*F$*_iVRr-3&Kx-mo5nwq*;JoPf~ImXO2V&K|6QjUDd+A39*-?6yIW zEnBy5hcx!~7<@-JcPxOHKdL{3aVOVHA~P;7It8Z?5d>UR>oZLH)bxVl((h9?oy?XP;==hzx568z)^LIwCOpJ|R8yTCpId<&|I&k93kWP8sQ+wNcUN~$J7FQp4-H#vF=vqLB@dvad-Qq$ zpLihSXq*5)>9?o5t26$xlaqsky{+wbJBJ;J`_@g{K`lcY}48AJye zNr>cC73AcV6jdK;sIRWCt#3VcqOJE--ko(&Z}`hI%{NPj#H>;>4B{$B#E31vah0@u@B+^Gy=f zoT=BU5~4{BhX#e9;C;OP{5;*!?=CKIu00*yiuJcyy%G!>**+srwrim4%*nRaj^iz;y86R=>uUE^SC^IK z72sKyR}@p3ke!wbpBwdBNg5_a?hXwM3h?vsBRX>T;xRovJ=|Q~b~-!SBjsBeQT#sC z+{)!k7vb@|`+I_+xxdH#oBQ^B;P`jv{vP;}i1F=tctN0xOO~xbW3E}h&SnEcZ?|DR zEaKpRljpd7hqFBw-suSx7!VvB6&m)3@bHA_kjSVo5X9hk;dt^b9Zw?{n3Mm54Rj)v>EU6>WX5rZ3NU=M*KaMMuo-&GY?@LLUHy3{7JR= z2oYRScMLn=(%LnQ_fp`7Mf2zWe%?DE5bx6CdGqGXUAzbi%%|sX&w1zVH{W{ucW+?> z7T^UfS+O2{xP9w}EjzYt-eJGV)^6)&XM6nHZT3!1J3Tz{0RjTTBSUd)V-sRylM-U1 zqQl}t!*=fuju6CEr`D>q`9;OK6$Se$>g$elj`nu<^85%c2oFPuAf zK0Lo<`4ZwgaDi1TS1embw7huUf`v;KEnl`|*~%3t{%v-4TepM$x??rmT|8VpoLya< zcX>GMaNo7d*L|nY?hrtju*ihSi1-ARCMlMu&}dZA#LARz03rFf2FAnu)yU@Ij<)vU z%N@<9&$VB$-;Td35`~)Ucbi1X3Kj{ z_E=4y-98@v!2uzW0e%soz9CWg_7VOO@evV8anW(f2?=^^O}akQV$3ec%PuamWEW-U z6qHo&-(PjGrK4-;!qEAPeHU(Azc@8<`O4_c`%fR=yZ`jw7tl831(CPS`Ij*AWr z^c4rz$zF*~Jb^}lEOCHBgJ1$*P-KVgTepJV(P;^E781wO!=)=$;@b)uWV3$V>h&Ae zu7o+jrk5;RwPyM1wJTR_+PoG7ZkwHhvy+>rr@NbPP=tV?{=q?kK@m}bgtZYk{J7LA zttvHxavH5VEz^>gW};ZYn42XDORe6RgXrf~@2_j>2C_JJZS?lklc&#~ek8c%=PzGA zf65;Tnfp@@A3k~hV*1Gw-oE_vAHVqYDd#-BfB(VwwJR4d4D=72IY~yS@yP!D74Ed6! z%TV_#R| zKY#M!&ASipKcth>cSwCaefH>svGLmvKAe8`@e`n)rwRo0_}(YaCm(W`9`vnI2qL>MM zT^)BgJ2}3$Wizgwjm^d_Hek7%w_?yYQti40!VtgX_t@Fl+S(J_xH>tzd%1e}_;`8+ z2Ka>pdJ)4%M}`DPMu!52herj#Rgp1l$0x+3B&6t56E$F9V1zo8J|i7BKQ%3*prB%J zRr!Ivdk-Hy)Y8>{^6bUFOA~kQJ%9P)`SYibryn5pw{MSK$G~4D8S(hV;|GtP0G~c1 zpLhS>2Tz_onHs%(>C%nTdn*Ra1ylLG!n~fXR3YM{P!`7{U z7mkiVHoN$&ufIQVsE;oYBXNy~mxsj4?k-+F-rjy5p5A@|L1YGk$z)R8Mv+?xIf97b z;6N{6!T>+-KnzcCOjL4QvMR$;S|y(T{v*db@!5KZ#%|o1xcBh+)5-hKp5A}{^uhE; zPp0ln-MI&k-x&uOoq8&r2k^K*^#Ic_dUfRL<-v1UKgIIzt12yl;d8Sx47yavtyZfN zVnMx$uwtSjLZxIbz-!k|nBC5HD*^qQRci#HpF4ly{CD4eN7CW|d!!=g%vrQ}K7cS_ z&!S~;{hBpvH*Vi<=i=%jvf}0M4Ga=|0n8L&z{l0y(>Ea4&o3w}AP9;j$6*~b=7NHfy5o)Y?PvNg-@Y|* z=l-LQr|&)f_@n!iwB%-Z zOxx|7)~{KKil2}1m)z_dfP23K^!y!g=lr*SH+MeR*Mdch77_ie-axFkWy>a8N5}2r z6>qn*+rG`-Vf%Ig&YeJi+|V-K^q9auoS-5C!!MyHpbtnFxgwY{Iyw{;85S8u4Pq3P zkYVAXHIk^y$}T9YtZQgF-rm|Zh!otKdhqb!;}?H^{(Sn$!|9J+KH}~D2h*hFo;{uz zzdJ?R?&j$A>!UYsT)s4Nv43Fr^2MIB=XyGN2@ktkj~#D44i<((L`E%5uZoWh3kd`E z0gu85!a-%c0vR3fY%e#Loy6>n=4Kn50f~3T*5T{SpFbD)Z{Ct6^XD%H3M5O0e*osW za@lgSl0-#z5ObFYsYuXY7Y`2?XV6VgG8jIAyZu9UhtSKY2(n|uo2ryl6;&(R_f^RW zi2y-~u~cp*3mBxuM@`hG#KjR90TyeGS>}SOx;^!$`pylH-k!KW`S8P!rk{WIDarj$ zKl}KzPd|J5^vUBV(;t6C27&z_Ph%oJn7lJKJ~n!Bct8>?Kme^RCp+4jySqEuNVc5n zXa*A}7AVNnsuQBaNaXprGgN*-@F&Ko^`{y!|}g5Di~H zU;ltWpTMBqROuv8%@dnMc|%-GQe1dg6aYCfQoJf54#7=`illf}MP#NWPoRH46NCUz zoDOtfx;}Ad?AE;}51u^z_}TL(4{;TyA5V>qPY?r=Hor4Ldg{Z+ACeWAf;A{j=syi3 zpe7m{4;?-Xws83H!J3+ys`3)N5VMJ*Oigl3SWqBc_EJ)uC^QlTj!vF#Ff)LU12G@I zA>iNgB@5@17g6M39_hJxzej1j{SI#OTkp&zTv)Ue=zKM$A$B4TM8!J<_qN+=>u6`c z!$DBeo$kBD`i4b?izkL|N>Bkkh2t)TgoXG8M+rs%C>jZ6U#M~}8%8X3JjHu>S>yAw}7e)7rF>FF0wpWS;z?;qWNHvR0QkEdUL z{^|77=|_(r-@OHOhA)s1=sDHeezLjY@X?lIO>ONht?kDT*EbvzyHQYJrns3(O`w?& zfML*3(qB|rq460v90;Hh0m5wY71pjrQ7k4Qhq5FCN02}cjU?Lq#mg2iT(*2AfcW|i zl5WC;ZrrqGtH1->?VaqQh?66n;pXZN(CSU@7+py?92^}%nj~~LXn1I7NMuA%P$&cn z3ynymR5Ug=Sw(GlsyYG8C_x=Zg+@G4vpUV3RZ?8OzvX0G|E=*`cke%VGX2>Xq(NRj z$5uXn{%B(I;pF7hov~}AkUk*8P8G$+XwK>Tr1{4uZd@AdZf!Y!yyeLLJym5TG02N7(Oh^4#SF8tCKYzdIzz+n20Mc!)n)BEg>G<0KxU zoADI>B&Qmv9!%95vWy&GnU)4}l9Ec9otAPeOHomI^@06I8r$2tdV2e> z;Vayqy#M&4>5u>TlESMgN(v^&$1c%^DbpDq9K3k(^61U++jl3aCi&>;^c2MoqgSpD z^qp>RZfa;CSSTy6EH5puuB;NUps=Wf3d2mJIV0Ves!EIly2h*p`rtr&q1fCAoJpBr z6>)!wp``@F9xrM8w#_ym2;{+0p`gWUH*DUr70ieTd#A5I48_ofgyVsu5di`tsd$P{ ziUt`Dm$@>;!_@2=fM@h(BekBHChEN?xF>b3O{Q9y${Y=8G$~RynzO)1D{7mL9cnl? zG(2!+;{MbJxDC%pH9vX$_}SyTV|ONC`k~>Wb7#&B40Lx%m3=Mz)Yy*|p14k_41IhD8R3Mni#!@Mt7I zGJyaoj_Cr?)O#grG%0D;0_XIcEJJ2$W^P^?IgHwU^$ktUEoV-)boO?i>7xc>0F?K9 z|IonM(>+}j50U6=?>yCdqO*|FD)u9A|YKO^{SMq z5|HUB*2Y6t<|)DI=znq`xH#^+U~+ou>fy1AWStu>0*V}*#Bm484U|ig$pFUSqsTaz z(RQT3&Jlme!IAUaaSm}T;1!<$zu+J*Fqh!Sgs3R&eLQ>~ui?g-m9-VMjVC*MhsfVt zpO}2`;Qqtu`?n@0KOn7fWvIXBOfTl^L<>Of$@bRP&Qon&puF9uPf_&I(%N#Yp5#td zMQMJHC6n4}WCRQ|MI#A$nX&P{_<)p;N}?w?(4QF41>|1%69kiiLJQGFPZ_;kKp>*m zw!*cN=UKaU1-gC}T5R>|4Qn=l15*dHZ5zO@v$N9<+-EmeCnx9s$K45E0jSs0Cm45E zWzH!pEUT$+ZtXhPH%v}u^1+iw#OPBW+?~94=g##jWT;`f%fpvPhDR=wq8XIXrLV7# zPEy0t()>RU?W?P;t*Wdj$)iz0olR;)W=t`sB2`WGDv1geGfNVZVV0kRTefe5 z0>IX!W(g8O#@szIe>>mXg(=+S7aplj%PQMb*>LPcSMSvuV-p{Ifa`@b_IT=p+Y`5M zTpzuB@zT&`Q0B`cBNs1Uy*7H|8qn?NHQo-MKil2e-gcZaw}Z7cHKd@+N=nPhN{X3^ zQ(9V#mMNrQnTlK~aL#}s5jT}gVNp=h2&xP4-2L#lci~3t1XOZ%q5c4N#CH|;lw6~` z>rO`(SEn6LjsUZE+c#6P1TtfbQ%aQTcrQqbqq`dt2v?Ky^DkLqj7IsWh*y zK6L1KYgb$Uz~JD8OII(Ajot!ezIN#PVRB27S1zQwI)ixEfL;P%Hk&EXMu9WYCLtEERoqLzzyL1@?CuTF z?Cs&U6W(*%>G+W8YiK4`xcBJIRR`$>V_Rx|snwGX&rSbBhc~NFtY>l9N|nb*TCH(UYgTsEN8War4&X!zYhF z#YB8C_2GvPF%hE|1_wv33{%MrkaXqh6^3o(!r;(APv^V2S8i^GRq{%2{)IKIa;(_ ztm8^Bmi24at=+tJ)7EX&ibX0b8GBC;jE*}szX5)`1A?Jw z7_-WvQq*at%)+vA0FS*#JJAgN10y3>uHX4!YW(KiJ9noZkR$lu-uNwm@`mD{G*SaeRyx;((o_^A-(kV z)TyrSJ~BjSx=(jdLj>YpQ(2myo0(4CRZ^ld3ynJc@ZF>bcat8cEJO*IM_Q9 zZ92P4DIqD6-J~H%y+uSsN0KB6i;0X3`vYl`Sak|hb_|($)ZS<1mhY?DTUUSh*wJI{ z-CZ50PP74ipQBK4cxdp-IK^Zm!&lI)*REY7A2cz67j)u5RJaA1E;d2vy;k=lM$QerfQK45ns@+mlp#Q7ecUS0tb zBL?rr4fgRO@JFXQ*zd5jx3?E_XHT*SJ3#Yr^~4t<0>oN6*gFsdi0fl3;i03$4rlV9 z_imIA@hYlYkdEb2W1Sn_wDbk(i zhlVZ;qOHgbUK_bUBH-%iwQE-{oFBe8Nc|*UKsPDT)2GP)ojy$#NNOZcb+orMH%V(~ zIJ}R_{pzYc)fE+0=ReDdV6=H}*O zEv?6!apPOt2m{*N+B#0Q(>mH(Pn>9JJPaaua9_<{3=fcKWmQFaC7H0wa+IQBJEUmt9b!ieL82i;S_-IHOcbpYoJRZB*Scn~Yz@+hC%nOv__#6HS-;zBrBI zeyFAQ@=Jyuoj^^suruA6Ep@Wo&%XB3wd9#?xL{)FPL4p-rM8(|z;r8*|rRePyc zXu&T(GjQ?h)vHs_Up#qE1pa3!$$J6x@bLcq+t;t)>z>8Zo@}f?(%9I*dl9DQl25ai- z>y=4eZD-C73}2A~G>|uOoyI9OyLI#Wl}i_ghKDIP>BE^|0t<@x7+IL6MqEb9$!qrR zsQ^Ym^jIB$DUbrpQ`v3pBEyV}!TrM{qEQ4e7KDfrYphQCh&ALm7x2m+K&38iA# z@Q%C%9uh!=z}nRf6alWofk5oQ#{m*#o+0TEN-z9<@u@(911JrOh?O#F%4AeP<7h}7 z8iu@~5iOHfR8UrgZ-OGPq^w~-zWUMQt)0vh!P)6Ke}3T7f8V)&AfNUVEzG$*DOvC1M;nhGt|Qe$QI{o)S+9oonWmo* zhx;N1D3Qr)OoviTHaR%@$dI@RrbBP&&Q4r(21l~P)T+4(m|nnlk3nMHyLP3V7K~Tz<~=0j@=LVj|ID%+i+H zH8E3|E&S7XmNOD>0BxFPl;u5;tF&}8^NN^pUPZm}(c_fe9cVn+*3#16(R!+@qx($9 zsqWJ~aJ7tW-#{O~z2`uP&WJubE!CW&i;h#zQGd7&ohs#;R4V47i_#4!qh!H`h!E^NlgQW&}Ao9Qd}CMP6xa9_~*P!_!!=Hc2KZd@e2sxcF1|M zTU-NocW-ZnUQC|~2=on<8B}2sno1I#;-x6=9-Ek=ikBHK0P=e3T0rS=DKpIYaz*7O z<<*ROP2HhGhYmKJY->Jt?8FJ;lVc~C-Ev%9rH;1Fp1!k8Y8&i@2hI|e!s4eoFrWnF z$C{*YzmZxt5e`rZ<}2QN%nYu>(VnTnlgdQp70Pcxv!q zSg?6iu1L95FFPxK1AYRf`PfLLSX48w!UtGP&?CY;_<;9r9&ih?!lflp6BjI8Ccj1_ z;Y`7gjuCH=fE6k*Z-WYt47^cuMjkN*F2wZIR0LL-qUjQPP5SEh&KvsLQ;p zoE$Teimc~Bu3v@EE@4U{ky=b7wM_xoRX|J_nU15p7+*j`;ca1l@CcCK9fa*$fo7=d z5QGhAgUVg7MR(i_FA3GCR3N$&?-$kzVvb5kI7C3`qfjucs-gkGW{Cll$;8qblrY2c zAb=%=9hH@Pm@s&_zVSrsiKeELC)?UO3CeqA`c^NPJW{~a#_k?wJD%?w7#7666#WmSC9`)66;+$U-y|(#YacPaGW$ zTQD?#K=DOIOGL^94@3eT=c6cgF~B=<1)+vyHI*2he{`JCoIt=4AOlH|<1oigNp4}q zF=`&D0YB&=JQhe%YXoI3l+wi|5euO77zENYEaXE3gAlNoLViI}A?r<);e%9B-*ey) zVd;@0SnZQ!pxZl6F>CWwduJDL2HrCMY$<3UzN;uH7U-fFN2REcnt4_V%OqjL!Wv2ltE|RCLkklL)YK4Q5MtoG5%(e~lD;bfU1xa} zxlNYf(X!MMOLVZ@(EEhkgrTxZ7czrL%feJL<%1?vQPdq#uGnU^ozLh0`_tS zU8Zwq_LYDYR*XbLz0K2z4J5}5$# zu)fNILDb(VYXZp&WR>g-Iwij#pGXaSi3NdJk50&)mv7xAn{0C)tE#b&y}5{7CM_!q zM$X8PKjjYGN^UAmvWrj^mb0#bMQ91g!mkeU@|bKYO?E4L1ykYSIjo$Z)iMO)PRU+r zq=Y#tTbv{R^h_6&KUuv=dEs94oV+FjI@@GjF*9o`@sK>MG{KYvR08x8LReQ9lua6H zL|KcE4$Go({6P!pzP0nhc*vE|0sdi2kW(zPLOb~ge?m|wsaznN27xlIY%Fhhhb%%X zmP>-agwW-KOsf6(E{Wfw!{g7$m^`x1Ojhw#LO} zP~45TIKFalHZYsCpkDE%8Td``g zp*)avzjde56S^diKhw}$G!7_;B>z)r%JOQW%D^jmr<^nMAvu9R-pLL@f~AR{HG4my zD^I7$sUpkrmj0nWg$*GqkEA><`&mfE%A2#y3MFQi%9Hh3t$kKbQ3xayQ5H*+4Y60k z^di+_y5tN#jv|<4Z!0ma7ZKtq&n3?$R*r^;&abk`1HIBL^hD_uLu~zTWdg{Ok}^XO zp_f7`NW?B>QwXK(mw&QL{?oX|tKGbPwVzAOTz-bJzQRvDl>E*-o0Xo{=d%v9m3f6| z{3v8ndQab!rZ5>D{z?;O|FX@#gEk6b6|Erj;}q+$uYcP5$=OdS=kNwmktPIHPM0lZ zXqCO9b!6bbysL}^H{hr)cuE;Fk-k|b zLL#mHg1A+RfGS5tP*dNZ0%!W`!_`}K&@;r**D?5~9vP)^o zezp`DR6g^SOIR-=AFw{d*KT8dkXMhRJhfFCWPGhm^NLeuMt0_ia#)Vd7}zgO3yk(< zo7uMRn=v&rCWv=1O?(K{-@mHrPH?-b$ zc2g1S8QGS7e@!)ojDJnb|G0bqo4x zN|SxrLFt|1?kF2p+9;c|FEjMAzI{a;-mb7Q#R$n`TXpqXP$EQ`mgrSbZzF^ib{RewO1RWlCAWVahTou z%75jkob`2`Ej0ad&+M?jx~#IH(B1mc*;m;Qe1m5@BX%m*u8B`nYYb*fVM#^xUTQv+ z0!x|KPzdakD}ks)U*sc2&oSB{^bnJ(3f7Rty_T4oRhm+?>8!GwUs_RKn46VF`_lMJ~<%qq;t)HBVG;+XhEjYP891r{v}KP4x|MkTX=kHMT@ zU@>XbNwL5dd@4c1>bB;L+)Q0cQhXB2yvC{z0K}$tfBbo&`H%V#EEtgCe71<5g5_Byv$En6rjXSYm2YOhU3Q znFL8JSZxZB5@q#F1dB;f#l@=h23h+#g>@K`C}~lfxOOTf9XjfLSe7IuRY&R!cRn$S z=ZcG=P$MZ>%^CqD?kMnxPtY0lDNGB{>l5SSSl){CmceA;fpGy7qZ27=PGj9KJ*$7E zG1X6(92J>j((6+6=4|HqYYkL_Fbyi>Q$bFKQD&0r4DTCs+B8{qI6v3OJ*f|7Q58}p znb}5l60?bnnYooEndoz^L7Q$V&IbW2%F2c(OxhSnn^lWsl`od^SWXS*2IgrvxOhsD zHtdjTDJU!{7eK9g&mOWcAg)yG0y~@G8R0*mXR?YwcEEMaQ=#_4l z6`1t#af$I{)Dl?^3{a&YEnXd$7{}zdBtvE{1zA9!`lLi{9H}Oi*_@pQd<%Mw=tM=O za$BR`lF9ei88bw+AJ za1u1uWEPiM7<6)2v5B#IQ<_?rUzQJLU@7K67Q(#66i_ftFE!PmiBDkWv`%X&&rZ@5 zrYFZy-=Cr(2bNJ%TFmzfq{(v37(Xhm1!OcaZH}@kmY74mQe|Vz%VJ0@MTHiPT4y$E z(z0_iA#Ro~$$;2HYi&xRo>j*|n)Q-8Mh!9PB$IMDG&fvgNk@Xx^+r>M$x>1(pcX=G z)@gj4*S!9-H-7!wx$_pY+}UayS@&h9tM~5k=ma(KaE68DOoaJsYHF0Vx2jp%M1%*$ zNcv8o0<<351dRj6jOj%?!r4;kh5%8GIg=7V`f4Nv3W$y1h~y}BY!oW8gqy^5qNf!Q zN5G0Nu?BVv3PEC4*`VqSWLHCQ$SumtV8MaB^t{SylQu0ohlNKn3)0gw^9u4Y3VI`%L`wIwC^@mP7F7nGVx}Qo zW3-epRVJq}D>Ytk%rK~RmORP%<)vPp^)G#DXgw8s>ruM zDPw+Kab@L!60_Evk(QB{X(+6y%%)hRw4eapq)#s_&MPdfsbrpeX^xpC=~ZdWhRZFh zt}e`E4Svc2WvT9}()^Ozs@#(NG-F{2x-2cbu&mg^{sP8RXUZ!uronE^{VOa2(P!~F zG+uULvBhL8Dap;CPKD}1ouxQ0O`ltqsWU+@oh&ua+J)(<3@82LL+R!;wK|g`FU-2d z!lFKKgUO6fgid5}GmC|~02cMrr{Rbg0h;NKEXbne7o^slg+Dv&Fe_Qg^0y8fpB4CQ5eGXJh0?VBv$}Z%{Lb)u(v?sVAMFUf<{aH zXkc+Jnp(UI1yDtp1T$4?S(O6{tY{r>+K_+>H+_-XCW>%`s&L$a--cb%ScOeb;K+0XQ#jp_` z9Nh+XHKb$Z#LDu$LYXL9Mn>E+M2&B)U_PN)1e@c*gl~jrIlMow+lY!sH;HD(RCgZzAu&TCNn`Smp2}4;78CM)0`5^iQuPrK!FR@{h zG^k0B@?#yMXcqNn6*MiXk(rH}Sc;#c{y-hP-b8qks#eEEMzKU=RBD=5^d){7br{Se zC#Q?^s7Xy`5^)SO%Ftvy9SbfbB}Bv~@ia+VRZJXNUwl?o64h}mqRs`9HCV62n0Spk zK1!9ArcTnD(p0f5MJ1(Y>f~gByS1p)=vd60IuQk(&Vmit8SEmyr%J8Mz*fs_>{JOlOi#XEKV{#r)J{zF8$v z=9B9=hwqq3NmQq%#DvEQ`iyNv{oI(@iG@kDxjAVn z4brPk&CWw5XJnaSagy4}D(tnW9%2_ls$>F5IFMCZ%qE>i0$XfzN&?j#%)U;c)`T!K zUBeR6@vN2)!()#5juR1;xJXjq#7P1m>r)btvzVx))Kq$iI@4&A4!tHJE=8+L zj8&zZbn#eIw1SZ8MiTSo**s_fp8~~h#lG3a+PDHPv#u$0V zEH@*a^#t*9WL0hA5=%xpGQ_-Xyd%7#yez~nLssHKz6|`+ne(xN=w6~ah>m5%Ao9#& zRRq6DH?m$ab3R!?niWly1x=uEx>z6+Bc_!FL^UFrm{<%57t|8AnKF=rq+mz;P3tL& zf6swJXqIT9c88*8qF)UZG|Ai|C2LKDr4&&hN)(MkUsy*HqE^FX1&@#m6VpwwBVY+q zc!W$URTl(z%2W$vyJ9A+Lq4#R2!lKoy^@JEG?)UOMbxc08ImZL9&;n;hy*R-1Mr7P zz)*-JA5c$aDA$yU6`4GPm@|x+ zJPXDTqt5r}NFU)!$d!iv!BfEHkg%E1U-{xQM1diJz^N=l5zRuKRO})rXi{Nb=HoC; zTa=_^MUz>cLFNV}VO3}-VGdIO62}(_AvnMv$)FlB%;Mn}+l8CWEGHJ5Dx*%&Ar@8i z0<&{16c3_75PdGfOb;nK;3_6Wi+$N<@rCfSV0&RKR1PxAM@4dEmJT5RR6z1M0XzZZ z#Q@9Tt|~PUL;!NO;<$-6=L_oy1!NwRHZj8AgZYr&EQv#9-&&(j17#t8E#Zy0x>HzTP~M~XoddQlmNdn(r2tklRLr3^aXp(Rc%x|1=K zuhtTwMLnQ73^JVte*~e%L;^;!mqW-fE|t{*XJ(crRbJG|O!2`*!;!>dDb73V?`qTu z3F>q`CJ;Y0R@}V!ICdh%DQYI^@PQe5CTN$IOgs$~D09AWl92QGBu-(WH#U(;7TIM@ z-=vs$07dXet{$7nLIgNPtXYB=tRjwO-SHHb=ZeQUmM0+|P@XVZ792?uQNj}irA$V^ zeol&J~C2IA!re`E5}bMkW}_+kAr$Z9|q zadPtbl2Y_KgCfpMRt{gPMHGr}BbLMnj3z>00z5%$NOdS*IG4$3S%fMWK6nPk$;!=T zA4}4wBW0+DESWUVvvLDD1uqV~&&q#R1&>#$)D8&m{XLR#1{T zlj8hIG>BEQ8YQK&N1g~$h*-@u*%E=Z29k=3u!LrP|0jyN|`aL@*LP)v8r@T5Hrd{ zlbABcBz0z9uoGEUt}FGUd`7|Jv8r+>=9tD)o}8SRC>Mb!@+3r~Vuqm#MwEb$Do&{l z7E4R$hP-kJYS2UE8qwrS7*}eoV>;T*dtDl&LmjjQOH0gs;D{| ztIF7ZB8sMH>AZNSnP3;7$p$d#B>(Ma9kHV9TWc!f^Fk$Mdgj~(OMO@83_dDhcJvdl zKv@q5bK3kPGl|WJKk&>n{)|vLBNd`+2O0H+@!tY3LAg*d@cyg8zz2Zno+JaXf2to{58 z5hPy0U*O~KVSeL=S20W|;6$#M;SjaN1qSTUo`bXBt3ixC4;sPAl)rlV<-61Lrzb-wWRo}x(n4cyiSj3I*JpfS07>KVK68sT(y5h{u&q)FJ9Suf3 zi4XJbzyF~tm-+DNZ~u*h<)Foz*}w5Kp+9?iAxag9Ch`(A8s-Oy{q1@jBQ%plE(!-{ zgzV(Gv?n)3O_5_13K>fyw;g=TUaX$FkdfFD9v+cA9l-;>v&-!fVGAY^bE;dx zPY?qji*6K8mk$W%eCY8|E%YP7yogJv3E{#7*~UMq1-(v`=?go&Bf&;KZ#)5LVpL;B z`?5x4Qt35mPv=CLdc-=)X{H{<9`n#)`e3Ox(J7yA3#5lq1}K_{>@#|;nnrU`p-w5< zPuO&|-sA&N=2CB?)!^n;jtXsZaXv8%VhT*wMY%Y~Fl7B^U`J5Mn`h(L0~G;JZ?5~$ zi#QNE%Txrt+y-%Xh-=X(ux5M?AqzRG&NV|;X#B>t4i||3Vv*aVzx+fTAXymD@f_6E z{Nk6h`#lF&`i&@2>ZO?|60b?<%G(#$!ZO(u86{@p&VU+|fBWW1osgSpoc7nBotAGY zQG_D=ejRVpzx~9OD)-9R5Pk#RAG~CJNK-7H{n(ZK(tycrCbRw%2YDq@AoGP2e9Zyb zfXon|k+hER47HGNNWEg?TJ;tr12m>|(KyieD0LgdPIl6n%&wLCoDVX;s!!)8S2t)*zu)y~LhG2vthE--8n{gpP zP-GP4*Gu?P31JJ-k2>egw*$I5ObQ9L_b3(Zs)pg-)MssJ2&MXJ3AFFvir)WKL3`47 zlv5NBbGV;&eMCPR=YE;F8;2>EYN%E=r9HX;bs%bx5v6=oUV;gUk8&`_u%b26*Z86+ z-p{c>)XC|RWGUN_eKAW=8VHdO`#09tLV>Jt^JK^%8ZH+o_cgtVd2;j*M9Re{#dFYI ziU9%xzb64>Rh`aQ3sk_r6He(Ap^d#mMSYedPA{sg+J);uiF&yFWK&SgS1Vd+A}+2t z6+nqaSJ#MM}P37&|x1u97GvHiuP&0PbD8qTHkK z>`&6DGOG$_B)ZPYsX8|e+Eqo?>%~e$^dYQH)~dNdBo73p zI>iGmLZLizdP%}j)4HmrTGAmB240>Bhr*hP)HUjgc=av(kD{n=A)_@?e2Au6hDg|Y z6IM-A_FS^L`3z7xX!zI`Qkv1iat6#soj5cNX~|fJ|LCJwB3pFwW(y%AS39GTcB60B z?#lVc5#QVL1~N9eMRiB*>JAZ2RD?K%j}~xm;k_&^hC#XIF&bf!>X)>WltzS!DxoJK znDN)I5CGBPu8kjj;;saw8$qROR$#>Jxq0aK1RC?RUeJ^f#~J7kEQ zulUU^!XW<$y{~`%4gcq2um?o6?oBfjGOGW|08ysPBZT5wg*R7*vPs^H`6`Q3PizNO z4{C@+E+eSH3=uTJP>fEDu8l@u3@WL*6>cba zv2&?vPhHJym`B3DWCXun8+u*h?IBks-j?K_m-msM(jjx9AdfRrHUSTI;YN{y;+Ny|eM9W>HfVI7JxgiQp3-f5f#s8Ur@b&I;{ zqC3)(baWbeKj1oc9Lyuy_@owpz)sc&yAk&82s5Qu7AAs)R>QvZs=ra8e5DBH$Kw3Gpc0HL|A?nCBp`w z2a?9xA@H(wEg)5Q;|k@Hq=k+;&`=&e$ss(Nyb86Uuhx_QWhePh$P1{(fCRW33FxK0NgMF05jcu_FsvxfhrVO5h*07bSZx4V11;K zL#GaJ4STa4THS+k08Mo=$s6b!xyl;(Ntj@n&{qC5f~6d=03y{S%j<5v_)Y|C7d!Pc zGk-zW5)0E9>`tMRPhd=&Z?|Vk=VeuX&!ET=2~R{W43SF6t)LjmL}JNk8fkWG9D8VU zJ4!F^gv~2)GgQL>#E2nDh&*J;S;-cLmdBos(lta<<{+JB!M{7f(0<9^PGk(<`J$2$ zm&j;lz==D3dS#Td*RPu=F%|NoI65AyR>;DoN-CP1I^l0ZQ_O-g3ybBvLJ`JW(mrdg zk(1^V_hPLB!OCkX^$X(h4;Ph-I~^8nHW|~9_=JhWY1U(I8x0AtiXkpk*QArt6*lSN zY?~x7UQ*+2(&rV^+%SMOh><4y)%OL5!A$dDpsQ=e0-6}A)0Y8O$EGE)au%{7pWS@+QOAZQNiOs+W->VS%86(eg( z+jJIe7n9pp!W7P|n?_GfQbc==D1#vhNnlJj$E!ySfF)(9Vo|2qNW;M)6aBmiqYfL0 zJl#Q1of%ABtMnmw%V7{8fMg;tRTpd?ayWU0rT|(8lgaMKy`@)XbS*-%7J88wgT$^B zo2XZoV_@b8>^-fFA;i>vx$}13)a~e|qF9WZfgGN+1WP%Y6Wd|49r9pUaAhMGfx8PO z%VcX&kO@SiTn|JkiQpB>YEx-Nnf_t!!UKUUq{mw^zIYg}fhpkWXuVF&5tYk$MY{_y zff5O|?kHMK01B}fK!Cakjbsf#!4^*KknxHyLf=geCK07{vOR#!F%u-87B*S3*DHzo2J2feAt zhM!qP+N?5#v$%@FGD-%R%r=|4GRbN;I+h^x?kLVE-AX8$Go+-HPU+Rzz@R>}S#eJ@ zeQ6QegTav5i`d{db9$1i&M?7RkW?rF?V@zG2Sl9|?9$ZA0#KNiivqZ67~((LmhQGK zXom=7IMt0XQR_1;m3B(q379>5DWFCAO7!f-O&7zu%g>eqmI6bSbPR?>x_hLae$A3A zL79=(a;y_Nyr9FgkuYE^meyUwS;~%LH_OQs7R#;7R0RlfYwpo@)_-lU9b`{|>El{K z&4O>L(CAPmi%qVhW43`>WHPAXMJ9IBPM^Nu?}m3>O9SWaQVGBa0~w2XoKOGQG~=fW z!Johk*O?13SYu958D>&?JBoE~(DM{1aw1KSHAJa?S#|)#wuz?)oCtS7?IA*v@w2$C zoZ^53ZBro+U?+Hj@(i;xr+J5??~f9THo(pok6C6G%vQSFZYc!l{#&fEt{n#=wZf(_ zOZ%Qe#KBUy!LwW(F$jOc`^i>D^n^!4t<=v(#S4$;#YZQ$qcSm`w>!p%hI)W#CpAcY z!bwBe#E~0JCZaSOs1L%=leXxsL{fuL+82+i6fs%Wx~Hr@Gv)ji?DNZVgZ*3NNGeK%y#e0p8gj$(1=pb!2hm zwfc@Uk|M~;c`B(=i&02ZwEF;#_E*L85=3;8_x&o(Pbme0GXF^1gnwxqRekyZP;;x< z1y}EHTMcf`!lI3I3JF z^a+Ddm|*PAR6a>ROc+}tzsj|mmU`3Sd?Z3&Vv2ax@E?%^T9H%)6KzKvk@L5xb9Aik zjoKmO(OYdp^g24JcIOlv5LvWb&CjRY)+)?%ZZm5v@(E`fd>KB8>ryXFy$dyg7)U?` z-gU}F5Z5jlGKKW($eqpWRFTX{njRm?vg*sUu?=bgWRo>=nuG4SPnBM(4Geob1l(u! z|H&o02b%YB2!)S_mn)ipy8HO=!!w<^jMZA?Da$RGm+^5kBM*TnAy|gVMmjJBnt^z! z0g0h}`E1(aNFB{Z*!n#CV2-Q)h$e$P@GT44S+qurB8=tSfUeGlB3Tf&+fDmaiu*OU zLr|dHv~E>m9@^bKi?~z`m4mngEH2dFu^y1q1a9k=pJoSYLt&I_?$6+D4|p+o+6~5w zy9gr*=ypJx&2aXKcSyb6MA_;{oYnNVP$4WRaEq}I`lVN*UT<|nYg82ClPd2EdJv|h zW-Q8 zm(-aw2DYF>mJn4{-*osgpfEZ7e)!(Q$+CYA79&td(`Y_`6}Rs_2P>MUaXInk9#~gh zxBcm+>&CBqJp2XG?d$pV@*4%rkKr{M5N>l(+Eaj_CxRHP!izMyh)q}g@WKF|ZDe<} zr2gLOpVUHM2zAAly6A?5=b z_W2m${9{>YWNftOp-{m{`2>DBC7$4zaIo>>9(;K=E+*JCvTVDcO_WVr{r+=<-3GCQ zv5kc9To9cDBJU?ni(uSK=>Y{7^yx68p7^+Hu+f$ur>^|HdTV=1pl47vNOtojPx2O@ z#*~(@K1*ryEr$HEAiSVqPWYp+Z&rrYF(QReU9&{m+IJMRAZ0C5M1IL#^b-L@imOp6 zE0N0ZD?Rm?)Z5Np?lwiUgywIv{kY-Fp6g)8%Gdh}7$3ZV^&2^m=TN?oA3b%cbwF{i zFV7VRmhAYi5ATMndmueE2Q_|i{h*Fkr`Z2@sI;!Hd{DQ!!<^cC6#<{sU2TaFuB|p? zxB%ZN_5j`nZ!so49C>)qvrMC;xYuD~f~#??FHvY^q{fN@6U#NyRY2tJ$&LsruFCAw z6!A6lb=*mHRH^EyQXSp+v&ZKJfR|vZTk_M{s%CJpV-i;leX5gJ$`CI|8b$gTS@_lY zt;%OaH$`f8woPFadWcbSJ=C)F5Koea?1NBVpsf_bhw-1$-%;YbESF)SJTI?@<7(@K z&X3|g;zQ|?pp?~G)AMMMj0_&>qhNLARfXR2|MeMFzdQGy>xQIU?fL@#{{{SLH~%Pn z38ljJkny6O#69VQ1EKwuO`v=ra}pZez8=-)=8=R2M8PjVpiihsjf{~6NG5b6Rp499b1R@v@n{$Iqg@YBefxnrK1eF`rM@*2u?KHO z9~1FLWtbQQ$MFADGj@i(>H$uRc=r2D-vPZ*zPFp91&FU!E7DSv6Ph{_g+t{w1qOH< z#7YY6E1lamIDPzR)nDM+P03V3*}3(QU%EbR+W;t}4QevpgA~7$&sb-Ojyk!}hPh!) z2XhpMu&4h$DRVv5Q@U{u@E5q*S8-YeOz>c3iUm-QjPo$N)X!M>T?tyHsIUk%I@y{o7xgS1RXPuOX?GATCy32Y2 zuTCZfshFadkQ)jNP5bE0oaHM`Kyg82m!88G{lzl%I&~-jNqZ=%2*r(yGtxXxEw*(N-<;@k&|a3)0F5+E)zeB&CwKSh|J4 zhp@sz>=4~zi0|{qX;>^%!(PQ(`0bXafE^G%jPijzNNXBNwcvPO>)}xBBDsU;tcR*gpKPCC*PwUP`;$msQ|>Kgt}Jt{n^LQL{h7N@Z#?JY1lIf6gSIs9 z9qC-Mo`!rl!CT=#$n$}OtsFG3Q#(V320j<8ti+~t%X$Le8`nIy@~r%$)Ja}VZANDx7`w~JYJT1>}A6?G$E}m=8`6N>6-jUw- zq`hPP%=7XxKYEnkJMuS=_zr%tELth3MX^YJPd|@-lPUOvc<{vOSTo+vo!(Rg=dzb< zQ&127eOvr&(oT1JZL^zZ;0!&Tt}EXi2GBzDyy=-T?Y=|)gY+eoF|Z=)GM*XUEu;H9 zA85se`5zd|;GwmkqOA(CSswTJn)1*JLm?Kr-C!Cxi04cyDxRo~D; z6x1&Vq0s)DFAAxi1qiLC7A?nr@#q%SJk2@%M={gl5Q6;F>05={(gld0uUEBP8PMJF@ubBbrN&gzQNPG)Q%)gY+0z^7AXuGFlMmfrfR zFd|SFL|+%SNrdt#eFnUo+Q!%$S)G7~J~CNOM@#~=G@?+ioNr20VgLx^UtIQv1Xfq- zDENQP6GM%tiP{7rjiQsSdpG=IB`#(jvkHd}vf(%b(Dx%L;*Q)_pAPN(FT{hAR%>69 z_y;({IGnI~oI-%kBA)HpP9MP!)Y2|vceXsuW;-RFwZ>8I{-g)P&g#RO&}6tYykWTT dSp6GOLO|RAqfMIG?JaImqm8Scb*Fmg{{>d&+35fP diff --git a/xemacs-packages/gnus/etc/sounds/whistle.au b/xemacs-packages/gnus/etc/sounds/whistle.au deleted file mode 100644 index 6b6db75b633f23496387040c727650d9e5d2e15e..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 12622 zcmXAPXLwUr+U?vQcP4=VnM|gnK$4jR47kv-t%h;0q8nG)xED3ss;B7Zmx_Tj5+EdG z0=Q!gHg1x8Q*-Z<+-+ISP4(y;-OYFPSkKwo``!C(Yps2L*teLK`KLeq>DZtCbo>B# z{+~bn>7#S6pG8@Gb|F8HmGiM6H?O#)Fbhn+{zzYcT3TCMTBXufsZ7?^F6-!M>*$bm zfHC-MYwMKCI=Z^SPnon8*a6$tc4=FCXJ2<$Z&!D3XGd2@cSn17cc)A$Yi;`9PYXDz zvsa;ztCUK)Tp{o6=~wnhTUuHg>+9=Z)i*Xvdwb8X>NS=^2Li6 zFPmE1JNn0#?CTCr4rjctt+lD)#ml6X2ES@-f)YnO6NmrG9{>}r#?G(4|= z@v1{<&c7H&x67rijdjmzYU-s*%cbD3)LFS))=>NG#fz5yoj7{ZYHz!&`DIOQW3T!8 zIclt9phsF;Szh_FZ8|zAoI#jO{V!{3>N=*lNg9=6WTdt3c~h5~kvQ7ZIabp5>Qzhc zTH?C2p;@l%XziIw3ySS-sI3PPv`t*0L<~2-koGl7<;okew$2yNJLIyVq?lk`eNA%H!abQ`Ce)WHWTO_*j`utqVZ*K_=%GfwUsqsUxc@x>P2;3 zOQVW*JgBLnthTW|(#M-yQ&v@9KY7aQTwQtji$?Y7!vU@3Pih)^CSCqYI86yPgKMn3S->hC}QM%}-E>X)A$pV|L$$Acd$ z5B~E|`A>IWeEjz#|NZWV)PMdx;{NTQj=%k0%a6Cp4*d1-?{|Kn{Pkb5A8-Bo;hsak z-}+X$?;jmMmp=XH+nK-I{^h{iK9BDF=)GtEuea|^zV%MUx26AmXIJ*!oA(avK6C%( z{SWp9Jt+O{?{9m4D*f%%5Z`;Wf8<-6<1{X5^kzsvk{ z>4SZH!L)PtNB8gC{l{C;A3p-urWP>21G1lfJ##zw6`=x4Pd9{Qi#OFaEdhO#k1*H*dfCzwh5Ht@z77 zZk0ZM^S#?Q%XWQuyY$5y|G9mu^-b?PcSyVBw}1R#cUkFAf7|<@^ueCDzb}2d>%CjI zhTib`=8oTAlE3-x)3>T`KK$$Z_ilB+b@sdOKiOA(`}eo^-@6mFC+^!HKiK#1R{5R} zzr7W?JEZid_ul#Swrnr?yPx0NcdxW*_rJfn^XVI9U;nyy-#4Yl{+#p0{kM00_f^{) z|Ni2;4|d)As&2RUS9jlg>&KhqU5u|D?%j9ume(8AUsmsW_p96c|ML6i4ZGg^;?8@! ze)=+cxBnNv?EPnH>3*o_q})fhxgunaQm~j>q=+$ zrQP}C?L*()d+)ioKH@2Q)= z?>%(u!8-@;{QUR#zW@IHckkXlu=l}D-#yje#O`VRW@b;~&ANT$(&~NG(kJ`8Z~gH% z?{CZAJ$}39uV-&o?K%F<<2?tzez<4zx?~I@4t9& z*WJ%QeDmke_rLkm7a#8a;j4eXb?ckI?!Nu?J0SmecHjE?uWyxpvv1GMn|t?ub93+8 zU*F#I&o6)8{n6)7-t_sOt~bd4llhm<&yT*P%f9k?>-EN4clQ0`tNU*q{<8Tk#n(Q6{q^qq2fwfT zoBGbFcYpuxgAcy@{awG?{qNL$=k?x$`~N!fZOh+!@0@t|;oT2D`tHd)fwxxQZT$Y| z2M_Np_($Uv%kv!)A8uo(f>C5r|41Gp{mM5QI9TtR$X=|;Mcwb(qFv2 zeyjb+^6>PhzdzmYe>d}A75D!A$^DA=3w}Dg|BwHEM0#-HK*evL_}){0@a*1a|9(*U zA>-#$2Od8DAn0z?`xW>9{po}14}}l>50+JVg*;C5ZKyv@uT2SR)dY3RNH?mZPdsbz zNvOE!S6}CQ?G-@jKJxOVT% zfk%IQNcoxeI@ZAZ^pC5aeoA^sKUh_BIN@oi@AF2#h3WuGg~zX{;S{|p?&OPRKV455)&Wu?D=g~GeL>MW&d#;>!^KddJIOlvbKz4=CXpE`0x5jEBon$d89)Yx@eQ+@7O zb^Q_h(?H*fro%Z;!+oDMc~4aal4_=pchvbuJd5{#(djqy>^$Yg*hy*qsVmjdr)%4N zhiXWH)heIXYQL!RDBtI=d>G}FW9405vU0zGr`99&RY%VK9_>|CcX;FJS--MQuZ}Wb z|HqsobuYXN$^!hJ_8x40a@ha3j8ALI4^n>(KUiM->Et6n@88=$Y5nh!6OZOUt*bZ^ z`2P(e7y2a7x4hk}v%)X%DdR}Ziz6##0msUF54TsIpp;!YT3LT+=J9EtC+(lf zp8ELzk@;D5l~>$j>e2G%g9BwJ&OEgoeqM7l?#X%Yil#%VC#Q}-9rLQM@(y_td9eIg->XKy8&&6ySG64-s5~7|VLsYW>l0lb|ZAMTBp4^O5QDz>^iq!!1>Qg4lwU*)qva*fWn^~DK#)#Vc}rGBH&D5U4Z02ZgC zp2eSOX!Fz5&;p*T{JNi?39aFtY;HZ_eirKgvhReVE+C}Fe6pqSWJ*oUnOE&6w9lxN zx{*_z4QFDWC7*6-J(c+^G_YQNYWO8Nq|SAwqxtNmTDpH@=NbKrbCj2(XH*T8kUG1+ ztd*4fGLGCdaCV{oJhguGtg4X~Szi#)CL<*@Tp_h|2bf+(oogBkP`3m{H|_-Vv{J7$ zrBP+Qfv%?5^U}e9na1#tmPv|A7IdXKpW53+O=(J`b@tJCt+5f(S?a7bBC2_TJSdHz zOZl{co{;3W?BKrs5O#ZFbl1%J>8==hrzU8oJ?dh|a_Ce~)b%bw)Tk;tt+Oz4NKI$< zrp7AAF7Q;03#y?QfxIw&SaZRw&PkfmU4@kS@zc`@VihA{awa8Xh<8~%bvakD8aqCE zsX%FpnN!5w=q-+(RM1m7JGIvhCJ6c*H~AT5JQsgktQ z7)5Q7lZ1^IDN;FbdxptN<8vl`>5ZM~GF#%p9*2jzNGE~Tr7n%=^o_H|IN zHf2!zyF%hyGlS&4!Plfhs;VvYLfh*3k*+YhY$0f_Eha)XLe)#Jh4d(BV(ImuzAozJ zred;E78=o_A&s|0oR=yBZH=*1Sr0k6@jAJqgL1LS5jfC7jclGIYg@uYT8Ai5%T;Q7 zHzm2Xn5JqwA1Bq)R%CI(9ST~WEcZNcoFFrwo0dgJNJps-Y0CM5f#9?@Zt!SVL~Pqk zu%SC8N--44?t`Lq{g>$j({U{2POMgS{i=F0F0EG(KGA}At*nKvs{>GW!Mp96{ z`tD#&TgnPhouXjq$)#%xWZ%G*N2Wok0i zoJdu)g-1%qsV-?UP0nloox)+I%RPLySw%gUP7CZ!I|U2+fQUYb!~h*xN13;Q?`lf4(?YPiKa!%PE79ks@=C@>123x~}Wdqb}O-|BeOXRusPHJ@XILQv`rjUZ* z<>Z8B6M4QVj?yDL7Y5*#*qB2aZjPdKNGXxc!+|-kZUm~DLTIv1N_5j0pl||N(Gna4 z%1UpVCJ{|Z6ooYOysU>B*D_0XG$l|}tx>_9edp-XNorwhCT&6%7ozBjjOtN^Ug?|+ zz9HiWFUb;vhGa1zJv||jQWYh>X`8&(cqy>2DVWmQ78p@Kd?u$Z<+S2Okbg^az`1(G z>7?iEQ{yk9{5u;dl&1E8s8_@OY4wF?XBy&2{Y~d7QW+(*r9bdOgT|j-pA|6K5EIbb z7)+M7l7n9LoQ-)gaXRC9#;M`D$kQG5z{9r>S)vCnIZB$CGOu#}}VnIw`LWIVF2Z@o#SQ zC%u%O3aafp9#=E&mtD>Do2-fR>#I3;thF}a)XNtq{GT=YQLB2q<0@vo?G^Ff%8C#l zSyiB4L+zhvNj?Z{yj8AVB%}-iGI^I}&=Jd<@lL57jev}%i z-}&k;pO`AOPg2#IkE1f(d%QBvM_w7?+g?TSZLaqBYp6bTtgiO>sb?>I{i|R3kg8g| zgDTpOhL`srxmZ4VB&Uo3m*({&gJsc2`pV89Z7U~xw^Ri9ysA9o`?Bh!UtP`d6ScK| zr)ul`&eYWV1=KWv?<>E+nnvHing-v%>PBBu)hlmORiihlqUi{^yy*y~yyft@GO1Tk zne0&T(>AZrryXA5PrD99KJ7jf`K0Sm#FNg0QBQggMLp>`82z{hjJpp;gK-p?j|AVa zC$fXVPo;-~p0*yMJ#9WjdD`ejDr@ixD6986TlT{1O!@O8C(CP(oUE)ldaSbA+poIX z$G4`^&*xd?aqqf{Q%7Hx`yXj6BOPuj3-;=G8t&CwcID96Q`Vuyr}Kx>%M@N0%6bn+ zl}iuPK)|HR2Jf@gb$%zG)gC`yS98YqRTarcS{Zt@xAOAQ@e0mStYYHGrHbyOA(gE@ zl&V+0XKU*GPSn<%_N}i9^lq*UKH60gcVw`l;E1ha>_{9iJP!;5s~h}IKdU?C_p&C? zr==>`yQ}IF=uC-s5qN=!uIl!s)wG@ntZVc?)lg44A+3w>8>nR*w>)1u8DFP59s05} zfbvR8^>1yAIMdg3-GAy;kw3F>niSU}KNl?Pj;8jvCs8J39tu}FMT?USgavnX(W%O| zJhDc%OwN#w(xPR3p+TLUbc$S-L)J;>Ncpm1YP579G^D%xGF8!8K+(0&QPVoqA<{F%(jmf7&ljNg`5u-!85O`b_A2Xv~3d1M*qT*(I#6hn90ovt38U385 zO-C;5@1R8v$xbjZjd%I0eU>#hA~V>_CI$%BpNv)NKv;JKbA z`q}Ab<>^>i^Z7t!qv3QxOMBqC&X!AOCYx1fqovY_07dJZf0nd6h}tWI{nvn02Y0vS z1ZdmkOwG_9&8~eZ-&9-4RL~=vWOf_H@xg`#OsQmU_Brk@AjQ(rkA> zIc}iiI%%XwLApH9ag{ROr=lb)I_b2DeifOa>byXk?p0E*s$_Ar*)9e7xfc+ zZ85Z&E+zSzyyFUGrBhCeQArai#;$&9lu~wsZ0YWyg(_uMa(;JLNXV#6OG@c$kED%D zrvfkcNTbP9QZ*^AM@lEn$>ikNK3P)WTKmAcFhvKO!s_e`4pDc`k`ueTVkqMP9dW%~ zm#A|cYFgYtPaf6MqY4jG^=t;E_7Bj*CI==%uPK!U!Df{*CURUp8UQqQUh48yokr89vmY~GGfy?J~U85n<1HHLaYo{tAMA@@WOYW0j z3!3R4i-=Xq(epgH`cmkaVj}F4N@)ugtJGH`waT%u_|XCEoJ&0r7p{>Hhg=))XNJHk zd2IB2-&EN3sqWm+Y~=twa;tkbf}=ABUI2maUp!X&kz~cugD0_?;5`hUTh69F><9KJh^uwJ#?vGLyu4^RwL;HgRIbk z{)yC(X}OLbAy-+$uJ(*_&RcqC6N1$$O>|8E_*!UY|5!$lZeTPnOs&*}UmO_5LRbTn zSs}9u&6RMqY9WR$AKMPkR!rxGFQ{jdB1T6vaWRUCg~&v?#vJZYYYM|=M<=gE4oyx( zT~tnJ!!lJ9mQdr+czW3M@F+cUcyK0yu2e6FWXeb2pk>u~O7Mt!iXJ8((nZjFCk-J5 z{TgwwRyCU%GB`SODN;V8iMcqis0q(fu4+RJqqC;-Q&Z!4Aw$}ct5NDjb@b(-`Js@^ zk;&Phov{&Hux?^BD{N|NC_Zv*dN4LdJv9<}Ni{tko~oLi5A~>LjKRyJ6D7ej(_>j7 zLz=O~2<6f!Jw~xQ6h&7q42CAD7Keg4Ln~uJYZJ3G)M@R=3Uzc%!KNwkzJy>!Nq20x z(%BUntyt-%T~ceiDH&ta10>g!dWfW(Rm_tn=LcNm(Y2mj>d<=kwR7sVo{Q(zbA7R4 z>iOQN2=!`Dc+AjBPe|OTrZ?!q$mBrK<)Lv!Q2fZal9o6$rlKaPM$}Y>a&nMTsG3xh z`9q__q^*&`(ZI!#;juvN`0!NV%#=zSI5Dl%298fDmjZ`om3oqTUb#t9%_}y@gKG*S zd1zg3ql}p4o0Rc2xtTJ#AYY}-%qf49iv(%rv|Cmv_?VUj?VUz z^9Qy4lw9>%A2n0G-c3mzTS-(6Dm9J0I^7d|O=s?iiJIniF+!%<{kn4oSgkyt zwXN-mzO;sSC5JDudY8`IxJpGxDl*j-Mc>kQTn{t4yVrt*8%kwx$}+Hw(e8Am1<$j3 zrm1GOx|fzg=wuP}Ekc$Uwq4jc7o3|Xmq%P?PV~e_GUt1YAt~zv>M;7+a4$V{Mca$f zh$V%ZmY^H!35(LscP5=*HTF)^G8P91LStq$J=cSDtNmIkwlF#nd{wj3MGw>M^csT* zlUfy)u%_#ak20*umqH6y#^h1-#r3|7@O4Bv8Je*%)gK$XZtN3=x@~H8Sdu~4dokK* z>01xY-&89jujn=XDN%O4ayC49c~W^HW@SaW6T#I_48>ksUQy*nZETE(*u8h61Vd`f^;`s1TRFXyCmmIYzR!&A_+L!yU#cgopx`=%4 zRDaxs9e%GRsyJsz5f{(3^rKNZT(vUp3fIufiDnCxs@QnmLT_$Vo>(~)d#PC4Ul5%~ zs0U-Ni01opq6%;@dsVdBUlf%u0k&5~%RNL?j!>b9y;P*@;Y2cExiT)UaJJVKk>pS* z=&@{VpEWYsG^o5111%5eA`&g*1J`2^qkJYh!8RpNkIAtsN8&D_GyUS2bc0HLjSg#+ z3sDK{lk$XU_PSy^I^H^?$coM~4i3f99l8Nq6vI5KycUP7Ds?eQn=^{E*h2H*=!MI~ ziozO~fldr2(F;}vwHL0U8l^Cnu{}DJaEZC1UbuK|dq&NU%`}XSUB6JgGPFcbv}lL8 zvH7Mc^(DI1qFjo-!PBZTFXU{EOkTarSy372iK6MjoXa;XVs8=pr7tN}Q z=*gSoBRA;T`mxEx3!Ej8*cIo3YCA3kn;y!)m~NUJO{KGpqvKaDbImH<#RRTS?YNjM znN@S*Qfy;`$rmy=2Pcy*=PV6ruU;uxQ0eLM!fBS{FJjkB+0TXf^OSM#@LC)2JLI3_1k5(>OTv^ZjmPlC0h#I;mHGm6HiV6)@G z_*A=YoEM+!(vFv0Vc2KK^W)PTGt->w!0iYN!j_^Wf~ zJO;iOqr<#>zZYDYOZ-+%S+92Eo#IJhIm1< zk)Bd)m|e|I$unvfnJJmubFY09b5pkTl%fUAdR8LasF}-3%GsRJ6r`qDwX^n=6m)gQ zl$KJkGP|6elx>>PvXdEh-Ruq{MX)?$$Vg`CHFLSi85WI(%V5B|na%VR&Z=fLCppVF zt7E37T6G#rYO;7qqt8jsTi4DplhQ4^88{_bG&j4Rp2E~?=5v#COgfD)H5Ff&H8D~O zS9FVoDOsi^9Sovg(wZ|;3-vl3laaAKr*qw4h*q>~IjK2DotB-NzO$gU-e7Q67M62T zvo`1F_>44oQD@0z6zUfiIT_j8YjduwjN-LLePMde*0N5VodN4t49u*&4gHcZI}cAV9?ALrKY+UXSQ#E(rD(mDGc|*v^hH^N3YWgQd30Bv+LQQj#>>bEm^#% zUCK_mVVTnqj8xXL2K0|%SqRdpzs&1(;J>9mV-N{MK zH|lik^fY8yyH?0}-E;{^#W1I1rZGIr8dEkS6Vy_ioyuGVg-=VvmNe!ZMvg(J6WvJV ztbkl@FkGvejqLO+unEpi=xhn_*j;Gv(aKwk*s^a#PvsOFCv&x_Eg` z&&*2OT%Nb&-N>~pYhkdYUz%sxEgFw$%lDVP>91KL_V!G4(6UaBhykv}h<| zW+J9#6SE-OX#6WtG4`Hrfp3Rmt?Rv^~=RYnS9gAGKZN1nN}>K{4C74Q~HuC@VdcNT*yQX26G9su-LF}66LW37K5pzu%N_Z){B`;w#m4TvREvOX&q;?3wKNg zCx=1Q$ z&SvG?EJhQDn~$0-24Nwy*kag3nfZ`)-GCM6^PHA7n8jo|Eapuvn<+7wO*|I6*krbd z3OVd8quBw%v0ID|4yVv=G3^u;6%v~!GpB^bH|-b&ENA<$O z*#ryO#Mk*EF~^LX9c)*Da~m_UJjJ|Cw^<+-bM0;mAt0CzH)bxvx!f&}St26Xn8Ugu z^ziv$Re}gPIJ9XOqih7RS;QEZhlz|1*u``sc9Rg}7P&k|r&z*-ojWG6q=bt*4Fn=$ zqNr&H!t({FYhCOTuyKjr1>^ZByuDWJ<}fkO8iq)6Fl56Zaxpmsy5d45d3NxVi!zHa zOpl30g*f;p7qPpL?{?`CSdb6nCQ~uNX4!GQL+s8&9oy?dgu`^X^)`{H0CHOlh=|Q0 zoa=U2TmYe#bx6WuO7JziNSp^DmKDguWnu7|g^%P3ar=@O<`)niqe&=Y72$ThLr}s( zJZ2LFvp8;SeUm3-3f;~XSST#S5u<_U;jmrks;vkqKqU4xzL;0wM2yBF50i(X%cuY; zz|al7NXX;BPQ#`^#1f+}y&DoRVX8I9nu{l42_UPU4?#?c$Ydz;l&~a-!NNtkC5Us?!v_EWSqYJ17Ajh|6d^1=gsxdj z#6<$(<~j_EIEcuyE)es1kU+n|LyJWMbj`^lip2uknn(;6A#9VLg%@*i9-tK=8CGJY2#Rb4_NET~Hzv7&lQu#48e;wqduJUxKe$MR*C9 z2kUJ-JCDP|)+C6N%`dXA2{D2#WEnum`2r4i-2^#>B^>^m1(t}4*znqx2;*_M*qRGP zOL%PistrYoi`n)S7lf9uOSbh}e4&sfwCJ56N48*R#lyo{Jf3+)2#W;8oOL}Ug87`1 zb-f6}i;Ez=o{LIYMZz_J3SkLbv}P_rVQ!IFZ!Ur15;m?k3xu8`4xu-*VVuJw){Vu4 zhszVMT6ly&$QJ20i(v_mi|WlhF~;E{>n4r|;T8)4LOhU&1+SZgVuH_sj3yo*6L4U& zLBz!bEP;8Q$G3?%qK$Qdz$Pv!+0YBQ5|qu|Tt|zX1V>~uxLFRE&Bs<@t`p&wI8Al| zYUgmAmTj)v4$5ZQU}Mf=uE=685m-x@qHUvCw9V%VtOiJAg*Zi4qnqb+Gx=_Vjk|@j zi(#Xk?eK8Hb6Y^TirMg%StQ!#v4JNMWQByqJ9=2?A~+nk(aLoJO+q%T#cr#REjF8l z&=$nv?-(J01!40r11hi(MQq66!LVVMP5<5JW&}~6svxp;bn+Rx|C}!g(2jsLD zv4AU~YomxQaF`K%%fsZjwjGeo#bTpd7Rct{6ag(mcdX)KuH9_MFq{cwz~ph-*_>jB z(e1PgidneDia9Y3)3am2aC-@}*k;1)4nYxE*uw2D78BYw5`>LYSnM|199Fo90~YMK zyC@&oGFy=yE>nQ6?|5t?Rv~1uxSR-&#d82ex*=8(VKI1cH=70YehYpL2D{1P!C^K_ zWHY*8H;+|<8_g0F0U2+tyI?1eT|%sH3!GveOKdc|#cs4fU^AF`7{+3YOeP5R2w5yA z&=btfWum5aA-uyYEZ$kS3S1bQ37ZUHqNK3Mwq`H3xmiruV1{vwpU>GgIw7}{Rp2%o zU}Tfe;gn9?UJ^@tqE*TjVJzLhuc{#4Qx@3A@9J0I~`Q=N5su`6Up#wdHY(JpvJEnH$iX zFD5pvd=wQ6MLSjx0=vXK+_s4#n1^44Z`)y!OHvHbg+dtOWC=HMhnR2{2~qo|SmHn+ zo@djFLztTEtMI*}q2wp$T5hVV)-n-eEoC>M3@Y=Wbp63A_Lh!Io_!`l{z%jFhwA&1R@de9QS z$i3|$++wi+vRg6S15&`P8yF9UA(41v3j+*si!tlYj@#}Q3sHxiKz0a;7};<-aIr*G zf;x9_u}dTtLRKdRI>;B}&P^wbNe~fYwK^a%S}ewGW}D0D@Ce--<_*H-gv0~}vcXYE z$amRsi4YZ+pt#Kr69gm_*>`OC>jV*O+krz8gb(A6Z3J>dLLs*8bRsAw5W5`P1egH< zSuspR-~veOu%RBvgA}=3HhYO%!iU6en*>2o1X#N;6v4$1?Adlh9taUZ2!^2&F&GgJ zkRF6WDC}~=9$18l#Dv>{poB*(B3yP4fFei%bECi%<)Z}d7J)wyjnfT`U`U7qG>KfO z2poVB$p80ZcOw7;A~EiABN9~T5u;8CFh^kt;<8CF1jYqmGbTnL56XAjaRP;K5jfvY zfC)qZJ29LHN@g2FvG0mE+4IFH*SfdOU2ViY8e;DiK*UJpEOCyEjTu(IJ2 z9C4r!0($ztr-%Xfz{wz61d)K6;h-?E8ypE(B$mK9P7oj*7{Wa;z`<)P6hklx=oUht zPK3ZvSO7_I9Cl-37`z^U$OsqALqKjY0$!OQaG2XoI3NMoTy8=2*Cl(F;vWl2%yUj0u~4%2`KC9 zM)DEd?gsIqBA9U7G2DrWgaVMS1Hz$V1R-pg8;4PW5P%fq2a81zu>;OP5wRF??|^c6 z5Fv~>Y#68=ALQh;698rqA9dTeL71;MU^{jX=qh-pz;|3I28#iFY?zHeah?#7Y&i*u z5EhoejvYJZkwBpE+dEd!WgcGy&UJYZL@W^F_8lh>Z-@^&9WFZpdw?&e&E`TpLZKM4 zTCEt23PBHSHY>wjH|&5r~9Br`3*$ zK>@|EbHjn*d| zfK;~&7$P1IVBqUH5dbZOIdC^3_TV5d7ly;Yu^T0vPOuCljX(jnfFel1u^x;7L;yD_ zz`4T>@&$)sn9B{S_Bs{GYgi)~Ua$?}h0cUu? ztw<0eKv7hJIYFurpa!^Yowx^qB%s}|=?P$uy8+T&fL$J-6NCpygir!PLvRV^fKWFe z3JfX%R0jn)5Ey}hI-wZ2Kb;O30TM$1(z$Rkf#N{b2+Rdo1?u=Z30#B_E(z?xF&tFj zwGZ6+I&=>R3EU8F36NF5Mb*zNYbmI?yM zCEz6CcDWFd2k==8XyOndDBv4d2HbpIB!FKR1_5yZMRJ3ynC}7Q6$0IKih!KCVH6|m gK<~i_aZ8+TATK!XaU(95gb<<<1P21+LLu@013t0R4gdfE diff --git a/xemacs-packages/gnus/etc/sounds/witch.au b/xemacs-packages/gnus/etc/sounds/witch.au deleted file mode 100644 index cbe2ad504672668a4657456ec11cd36b5a335445..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 30107 zcmbWfOKpU$^l|4sF;QL`$2uzeEp z+bMW{Xa19#uk!OTo2B4>d} zIFXap_OScZ9!|$AE|W~0M>9EIQdLEnE98(U!K9_C8-~PX(^*as_4#xXv%IX12L1Q$V62)#J{6B863Lvf(5H|&9L|?QKAV6y@k~x$PRIRTe=yQkV2s8S zv3N$1XVX61?kx;~PlY3~NHk>%i(wZ>Z@LnN(8x)ls-T9dVObEZTwuXR-T^c zt60F}c6yJ}V(+n5d8ju=Qrz!x+TA`~c(0er<$7n#2iz{Z&FwYk&$av8YIU$ooI34? zc2Amnua`^3T64mmxt+EH*O{_-uH4;L>q8@YWVhQ~Ue$c6+}%A?dwSSsx9uOeRH0S5 zy)9NdTFPrX+~0R7V&|b)ELK`d+G{^JIB*JLt9*ZZUu~EXk8^+Tz&?AJ zhkFMHuGX}9e|24Xm}mUnz1;&_Y&LqhEnGcU%#_o;`~AT7ra#^nu8Pf$es0^_-P!kc z=9Rm`MYB4|xE;IS_6~Uc<@UO8Q?ISg9f#k49NI^n`}@MhV^vGqocrJQ4kz=*{nbUe zI^d5SKfdkk@#)Tev2a~&E;IJMogd%5@lNI8rcf(sIgfpJZ`Z}WHtTnn&4)$C>)zkr z^NOu{^{((zRa0)~-u{74c&Xv~xo%2s_m9K<^Gv&1yDPrbWbpquw53w*O0|6V`XZ*h z&O@7Pl6@{!O7+)CHt4Y(*j=x3{k~LueObo6o*(-T_xSC;e1F}o=YuZa_XBrCZWd~l zV&^q`>~icnJTKYCZRxJ{WCT6#@B7YNyM0}`zZ$)zj~$2K4m^!~y>RzXdC4c;u5Sm9 z^m1@pdbl2SQ$B}%=fGQ+YL|Dn_wW3f$M)^uFfyu@ilyuKx1`Hy+u8NhrH6~#>sDJj zaytIpb&F!-;{M^b^OkTre(WEJ-S*Y}L!qfja16q_Vy#%aZ9m20Ztu>4yRvFsm2Ru8 zbi(2PwvX=ca`o`|FdZh`&V9S*eB8XeeJZ`_8Joww>yB1>clV`I--vk}j$K=@HLc!0 zmIt%A_t0lM^xr=>iVx+Uc5XlP?7PDE{f9#Fp{qrF2d*Fcp_bXax~)G=g7E{_ciVYc zXDeB(bHeR$)e9yIO^Iw~f z*Y}NQIdOhq-*@_N`i-0W^6T{M=m+i#|LyDTP3fVpCA@n!o5x?C*2<+?cNK^o*zF#F zWnM4WYi~v@zHb9_sadZy%adI0WY6Y4iB#)1mDj2)M$Ue?Jc(AlepMY*rQ^77*Kw36 z8P)4*yDqpR?mcH9R+!)4RGV7fd-mhN9#F12m*tlS)$jFvb9%iGO5@_8eVg$_kG>s* z-IvDQRkfgnuqK+1;l(P1a{l}rtee?3G*uUgVzwb|% z-*&mG7wWCC=Fa_adXAT!_Qn19ZRN}E?i|MB7uw}R^-lKr{5ywde%PmMyO{x&%dJNFK<;l{LBe|j*F(xLB% z>BEcpRrS8M;sZx}wv_Exrv6ZAq*5Mv*O@vhW^32Q7B@Z29Sg=zAgtY@$kUuZyxQF8FMDNk=nYQ z&ScZa`+R4aM)mc+*`Mg{#JMBQziPvqdREk3oX-`B+`e=k%B#HM5`4Z@=rY%=mUT{c z@lM~={VUh)KW4(IW7B&&4_%Im{EMDAIZ1fWXRGSyex6?@9A_z4QkXv0i~X#Was*Dj z5xummUe~fRcMv*tXTuknyT!d43^;ste>(7UP_IAqBVkw2=F3lijV{dUYtkJI?8W&^ zt#UU~wA@iRzJHdw>eh<)=1Q_hBKAz|GFrVV56{!?fXgkN7V?e$coy}aojZ?KnNt07 zp-yAoXuxwMmdz@hGqMifxjQIduF9{?@tND}@%U3`7fQ8WAH;(`zuTWJHOd$L&OGjn zJDm~XVf9eB=hCUeW3S^_uP=(Tx0jSNVLJ?kC-bL5TNcBv*zwV+SgV)E-A>$yX*O?P(vyfQ9Py-;!nCM9_X9S+6Qig8S}x32 zV$>EovIV7kwe;F~%i2?Jdo;&CKKyzYW=Tiv*cr`VHLLaJYt9+9dxF7c>EYsOK1?|= zIR%n8t*gdkGmpE?5r|HO`ejRe%z4j(c7Og-EvZjWf;Z)HB;tCybv4K?xs!Oxbt=^I zRaqT!ZrSVM__@)%R>Ru4Gjkq}2zSl8s`oiZ?${%m*Kg&^*Q9oa{&E^LZ|au=eH?XV zJWh!#=F5eKxeU8}0dJ&vSHGNV!z`joX2NGe+tcVD=LJ-(O5Kjoo`ffQrhPWJM&!PSNHjSzKD1eXTHR;#FvNWIA+uQ zN2_e^rgo=h^qemljD@@1+N~k2f;QvmXpt}0OZVfrm~tW}35hvup&UymNJWz7&gz+B9h{Lz&o=?vGirXU*Ljr*2@Rui})|K{-~?mSu`AidE~5Jf#TsT-2@gZr-o* zSzM&gy{7z9yIdGK$({-L=aH+|=0I9-1sZSLhhDTusBbVc&F z5#=H}&Cd^4Uf=AzwrWcJGUt)by!>Ule;HbFyiW`yC*gMOCM9H~BmOwb7ZTmelW~SW z7TvM&Yr1)xT$#cV?>`f-wBf~BW+}PNh<}(UJ{HHzh3rqq0=ejIe^O5@xziNyHgXr? zL4(&L!F1loB}$oLJ-SSvcqF%^UkI;vDK(Z1=e>Een0YFtj9AK(^(AswiC!%QESODs zSF`kU_1?(K`C!f)%w0#{3TKn-%7fWii#%i>1zAZ2xky-lsy!E?sm0P}B;AwjMgFla z>wF@dIOkJ$!^vw_Px|?kXPzr0I~`eyo+Tu|nJ#8KjZ-ah;^kc0{3_kOO36{vlktXD zZ)*20Aqk>W^dD>YkF`RSmkb9Nb1#L9#7kL_6M{QE{s{Bu>M7kT2%5n;M8AD}a+&Ej^u;-zj*nNurP6xxy~Pfbk;93s zDvx(*J(KsQe14&3zF&lfOCe^O z>9e?-J1dn37w58?cBOph0#|8YjPyyyCZ75y=|a4Botfq`-l#i${xdNsoc1!_Ox|IL z(Vu#)q%ITTz_Ck8R+~@tz)NUv=5s9KZ&!_CYAVZ~Y}lP!y}uNC$yvy?3VKJG>+Dl8 zsc_j){4^dcc3Oo{R!aKCfZquJ%sgJYyP-fTWYZ#5u~i6?oN$lD*tw{Mx=<1yXs($|H_nW}~tk%oxsYxPJjkc#nv z;M-5}5;<@Pf^=+(4E8HDPKAZ_Y_PX!JKv3j-E_M=1wP*8})v&9rq|iz1EHxO< z`h!Jxk(DE{Kq_Yp-T_VLlT|i(9#192)x5bF&S#R6h{vO;grU8?%#HbS%1MbpCW0YB z8_ws0=~9!0kQ9$eA}FKzaxq&ivgth1J$znYOs491I+3)Tn2KdH;!>4IgVp;;RMl)g z9nWS3LzZXrkvcY(Ixlh(vR0z5&-I0_2qPUV|Xw@)|NdoCM6d7qo!vr!xMKFQUFjqYO>$0&lMTAI} zjFqe-FKLLFR3t@SEs?B*Z6bVF89D@l0qWo`B@b5+tec{&>nbdlU^i-k#aM!amyo1W zSLOoBV1Xn;)Kb@pUlb%sGa*4=LM~iK{ARjNEx-v9?9en*M@Cc@U^g_Oy) zP>!I3K#~w55yD_9`0)ol_<|}!r)bdy0tU||c#8&D8PvE47ETdl6RtywM2$fgpn{WK zp{u|p$c7Fmpbmk5xPU-XPl6G1+!DAz0cznI|EUt}Mn&+!a#WDPfp0n|4jBPNxh2{< zrH-kS2gD5$4%uKQ5Ef*4C zGAUk*KpDAb@ky+VqGNeRe58V|aL6Q`cGe^3?H&(9jkzgtr3HvM4D#ds)O=~JvaNM%iBU(G0&X)NV*$h!rCJ)Fi}qdD?lBPTuX^c0ILq4ho%`XjQ7zPNYeqKdJaFv$-lfLHWAQ=f63#>W z!O4ifyL>ISbTQ>PbRACB)m^DseogQ(htuI4h?Bco>9L#3gq$v?`&D`_K9$C^Tmm6- z@=sc|+`XTrxTweD^1cagw~ZMVvN6_Pg1`9q^sQL#Ma^LdZDa_7EZdo&XnB-xJ68p}qh zTh+}-!sj|YnY{GwpZm>KEPUcTISE!5Pq&@wQuK$BbPJ^Ft=rP*Rmhxr?XE!hpT=NrvxsnZttGoRaeayIEVZ=R}(9ETqt5rqv zTuO)hZufcgsn@%Gugg;K{M7D0Th#}Z=HpW~eSYTloQIx}EC*q~SQ&D|QiQb^smP&T+TIGI!obmck?4eZTX4Eds z-~eWq zkXxDfQRvW-OAiYAUCSKtNB)RCAtoBlerc>tI8WNYm&zup)oy7ZtvGx9U`I}wfAuR> z#V~yK_)b{P*6Q8Mc`mKlGu|ISg8%RQqQUd#$?@sV(IEKOUFm+F^YV_g^T0Hp@2i)h z>f*gI_kLJ^{#m=!=lQtLcXH_C@;~cW&5_~>`GPLnDOar*9^TcX^V4&;;~=@Xt6cQ@ z(|9O!>U7z;QloJFG)+eR30yg}>*`hIWomd&V=kY~X580{1?h3&$wyp1`+l}iDdCCH z@I^!DRj$D0{Nn1hVy}o(!7Q9B^Vj z8VrTbqB%pE%_o!TaJta)0w9Yd=JVP7(pWBlah9rr(GF;51>j@wq9EpYQ3Up(m0b;2EZghEkGgwDS(EEazZ2kAeyPss0!Rnqc$6TX*8t~7_b7L7-l6M!ij)7 z;2+QU?a5>H=`glF%9^JD__=!j-OL4ul`T)i6n3 z(%_FV9e)z$1p_DSi;eY=&n5-kAVbJd89{&z_>gqqJXt~wpily=q9_7f15xWJCwxsN zn8XW|2*`;-062IJNmNKxRoDtCbbuA;7WyUfj4l8{p+iFZNQjey#)BIIo=^nnL~K<+ zFw8pEa2%0AZ3qH0Br!k_elWkRqysTSkmT8Df@z-jE~- z0*Vn&T!EQ*B|u{Glm!Af-$YN_=#d0W`eWFR;ZYXEjshVd{LYTyhNqZdLFxk|pG zkS>`O@Iz$2FyBy&Fu+c$nAjm600%-DQKqZ4^{7TMBMYq%fxwh9on$@SrO=~3Gm(t2 zB(X9Q$Q&a((SR_0h0dDCKfzoq#^cF&zRCHcJr zPcHw6HThblBLzHIuRhN#tCdo*`tqI$xel=2pBUFmclVX|Mex{hVDo0U$Hv25tux4; z`1bcaTxJAmca5$X@Ot-cK4FC7Vr@7MdcB9X;}!o>sop=l%`zUh`@nZoT+-XR=I9W#$l)LU>CU_>{PhB?JqdDXK&Y|r(R37yMoe7dfoOP_Hd$AX*?93 z`b)3N_rva8&C8YA<#;$bb@}%W1M^(HQopH9yAjXn!T#AI+I+y``J^X0PY-^asOPOx zvv@V{#(gI?Y^ew|9@?eiVzP33y?efB=C$-#yVQEJ&+ps!aPp|!t`^ME?8xKWbHv0v zX03wOGee%^1A9c%>($0}eL6XDo$lGswQRlgbp4_avD#_dJLj{_yQk9iqMvadyLY|W z)!^>Ab|H0UUJv#ToXNRzrSfa^qy}8xZ$JE6zHwjwdEb6Nb^3RHc$4wQ?ej%Rc}co} zd%a!>dAahh*`w+^_WZDUSJ`T<{&UjkV>8Z=eV>tdF4YQmonFT0|MA^*k{p+wE-z+n z&VOp(u{o7#yIlR%u1-&VE^O?GCtHwJed~$7z`=K$Q`M^V^2KXynK;9?61RKQs}>98 z_M;l`?C<`tncUm$!>>wR=Z_8%ec!9{PullpVdzK105B|CDi_EKqpI5hSC5tUHf7pF#rE>S{s`RY#Uf=%Cp6_JZzAW4nTf>#- z)c$?n;T(4Fi?^56wshuq?_#S^&Um>iTo<0YxuDm1uxs}w-(HJ1cZGi64EfyHjNuCl z?T72Ta=EAQ9d*_PYTAa9lE*%b5~jhN5D#nxTsrEHO~&rYV}3 zXn16{Fs#w+!{!Z9=8@FFct^u920BTSFz8`O)G0p&+<>`*un7&o1T-l1hA~h=o{q9* zm{Bz3*)Y=an589Dgka34hDgtXn8`GlvA{eh3i&)Q(p08m8aG62eB+Q7TPll%ifLQq zaydXX1J{ZQL?v=Ou^Rwga7>msp5sMqx0}zEg$`jkF3(GVY}5Hn(`6x_gLK)z#y{-) zLu!ztF&F6`b+N!OEWsFFLiMEr;X3kL0;IusHn(H`0ALg0BN#N`CYn$L3G*6@5KXLz z00Myk19nlVh{;pNT%s+JuA+Gie~2IaLX&_U%zz$jvOzf6zjMl>XVoq8?Vg=R3J*wRh1K!Ox-e^>$qq>YN0t>iJ)qi-@0M3k?E zfXi|SLEczJ5?R=(aS>=HoZ16&sr}HRWGPMkkYcqc;S01NOrf?RUkHy_#*-~jj7tz8 zgqcj{F&n|WrCOSahnWXGOcNt8JwS@kWVJBendA})CDU1m)~$hS*h%H+XM`PLDWqB< zwhU)sWgM2F>{_NUlLoSu;s_zkU@L4O5k-bZh$O`ndvI7zS%kH!Efk^(_(!~~y;ud4 zG&3zElZAlvk}0Hv1$oN=ooEKKj0K&EW4^HKEkCa49>r}0c+TT7KtzUJSl8+k)=MyHe2k=MZGu{fg+jQ+#J7k z-UqWWmUE)9NH~__6|Mi)Zw-frBqSoCa3q;h=WlPFm+||O&!t1bz*$^0=daJrr(xR= zGC}{zk^kHfdhd_b=lAxK%lNU~^*ENBJU`d#FU`4-3wymT_sJ@U4YBvN$Kf&`1O9UQ za+&u=^}f<-Ecno|-RX2D_+AwVtXZFCBFA=z!xc5vYUQEWXwIeJvCU?8MyDDhG)6+; z2wODm{>9?qp>o}P9ApE>huG|QruM53<(q1K6b&5jA=AVO^ZWa|LbEnb9=X2n+HH#5 zxxK%?etvon936b$KXA{vM)9_A+h}TjpKWJv-!WU3?@EPQ^DS};_HN4_ee8J zs8PCaXME1@-+mm#5}n&(;j&gVGcNni&fcM^-QV3`Jlwx!j=eh&nTtFFG+Z@GX413w z{oAfHGp&N*zBtUBx{>$WmlNH);sv%J>IqET-}XEy=DZ1`C$_XVH*`=7ge$!O>H`V#vydnaDow{Ji8m&^NN`Co;~OFZb^`L?@r zlIawIH43%XalrN`teRt?{pPRBS~Yv>{qg6{H@lpFxWD=9SF;fdy8rz4V<)_vU)|pS zSL3c7I@|sBZD&7|9bVl0yeLPV)62?>qax|vH$tU zpL>V>*MAi*|GIh{`rHTq{O7lW*rffhpBER`ZO!RA_}{;MJIuZH{`J?zzuHeJuj9vm z`{&O7pkMv@v+(O>s@vV){`uebY>Bt}U;p~`vpF!Fw*7zpv3nTk*MI%j9!sG z@y9p2yIs5bS-7|!YT?7fKmXX-4+DW-g3^1BI}Z=O?bvOiP`bJJbz6K_{I31|@4GJS z-mcsiudW{63~bJ`+ni?se%gJk)UXG37)5sIH0V!e^7F;G``UV+PxQQ)N@kPUcpA6> z5AehBcrYAHH7%b(nmLh(bNQ9F0IfU1{(PCsWm1_OFaqXmj1ROHhcOlN`vQ2wSV}yX z&E`2gY6Bz9k@+Ejf-wYR3_X}**a0Zwd6CCZ#-7xHgiOE&5eudeL?f9_Gs|Wq!`Ox) zi;a6UU~3qZz=LrQB!W#yy0A&g8s)%%XMH^TuQMd;drO>g<30&$Wln6Boja)f(g4sOgBi1fgRHkk{V+D!5JM#P!BPzt!1YtgbXG%2U?I; z*D09P#)uttM(P#RZx}%)C161viVcZHkB3&MB`vJI5Nt97p<^OgbC4F+qJ*X_!z>O8 zI1!jgR6s|9spJZ|CQ{Fn$yJ!eltKv=!z#LsU<5iNj9@Yu17xs9gbmCr%T5H)x`df1 zCm{$JW1#r52m@S!09QO#o2qS)#|qvkQ54>9-l{4bI@tyrJso*WY7G^plEup-Kagj zV?`xs^wbiX_*b2!F5iv>1^7wgZjShsXJ z?RIb299L_g)F)ih=Wt+EGHi6J)l&JfKIelz8)i1YY`#`XHvn&XHjJt6z;%){umSL< z+^o#fr*7Nff&FAmy1UA`lj5d$#LZJ_H53R<@E9H z`sS`#6_bACDGr?{=kHHIf_L?Yaq8H6xa+X{LNDFM?Om}_8*qSr$X$2?@@wzmtB9j_&MY(H#=jv)WoC|}*)+&wRHKKK5f{m>iEHR_e?>td-p zKR^=>FWBn@;byDKYMtG${iAw+C$;y{;t!{dt8URhlj4|}EfEK&h6U=vZ+ zX0nNzW+*a%^wDEA4(2b7zneLb!a^}13LADY5>uquu)7|m8Np&=Y;;N-IIMPoTttMX zEv5^4w%X8kkZ*}*Y&7!|fs`?>4}FLVXgX1uJf?v0GRwBrQU4PavdA9h###@fSdLkW zHcpY*8|7b_n5*O#$p#B-AoCy^BqDB1ut;!}=Io7MWG~Z4>X-*;N1`x&1ZkL0M6*a% zMKBQslF&p<7@0vlAc3-x&t%~e1dtdHPQb@lELj^mzF`e3ruuX+ z0#ija{M#reXomTe8BNv@Bq3o$S^K&cwGj_%z(^)CKGwgOdN{u}z_N*=$@s`Ja$<8Z zwsnsnJE)9!*2jj8zCTL9forlwwiIvdv$UWtGnw^!_yJzl!*IV^?MNoCneauPBGU_3 z(S{TuFcFQl&KhmeolfwA=V?En~ z=2EFdCc_DaHtSEY6Lx~ZB1-~Oc*$9Tk^vGe+RETEq&UNg3w<#f_9xi1ZHO5V(UdRv}UL>R{1ljWQH?jZ892-rz2IBIX<0C#1m1w8koiitavzW-w-d>x}Z%=bg zOoT9p1%ObL=gv#L{n%IJ)cN`G@#$G~A&uJDIraKF*Z9ckiT5ZF%u7nM)u_HSf%g)p zSX0C7H(w50%}TS?S(v%Nsn6r{pGoql`CM9!(_>!~lKvx) z=g1#jn(xnzO5>>sr_PSNZqIR0R>!qw4G;%;uZYj*bo-8C6Z5TEd#FFXF3i-C*W>ga z!E9(;lzWd31uT*gMnE>Is>M$LDmN_%o~FbER3S zwE^rB0od#FhXfr!rBQ2kUY0`a#OHAzorXod|6FZU8=bbs#gDxnx9{XUFLz#nEo+_5 zgiB#L#^X6TPfNpYvsSC)*8%w4`4L`M_XpF0@%98*+I;Pr*+l5r>pMM-WuD#NOLW zv)*XE4_4W9z<+Xb5=^9}={vnW|ME6mis@(|a2g0jGrT_PzdjLhyviq#WjsDPi{(V6 z(|&3+n(ZO5a@co-jXt3`uTR@AjYi|~eLUw<=rKOLrJt3|>1*q$`PhD+s$4dHes*?- zpDRG>a`yJ#?sR&Sg(hUvcqoYAM#fE|%|^pse>hsq4Vll<`gJOU0Yf(ylksRU8sps~ zNyw-1_+inP+H^FW;GR@4Zs6w;GHKktsDM!i+1bf-I-f5z0|O7A%Vsi2#E23=1P~Ms z8k3NX;ki7GO0-5q2?C5&Si7OT0R}bT33{$)(-_TJfDnXHFkE9W#W+X@6=K{&O#&U* z2LfP)k&i(kN|q3na0eR>B~s7w5;{gwE0rt(*MJeg#xN{cCNfw?Ps0qeP(}kIDMnb* z0}>6nq@A%@;w&OfR2Zw-+(nf2(9FhWHtAa9HBAPLMm|~YKr#NY%4{}Z8kqM)G?>KC zdI{5!=8Z8D9hfJG6LSL1fPXVV5%J^L@LN5agHNalR{qSOB8)>sElH1-O~Ps%_3QTuemK*6s4`K-z&g_33SMG53Pp*3~`iCqJa-<@fcwj z%F@K*JqFhtR`AWGGM~-ncnfDGaXCEA;)iUo)eb+PGnvd5nlADg4BnuMrar^((~Ku` zWeJgtnnNyHoy{gAfJQ8wix}uJnsZo)*B0{;1Sl$0}A3dJWm$z zqzrGd%(WRtcw~vO8v(m7vDQz|hx&X8Fgn8!3;@X^W1r`8c(}yAKdkysu(3cig&b^# zc#yH*VXVw1>RgpfY!1i~JDxiYO&@EsF{I0I2Kyt3ib+MGJ)%=ZQLs>tfgDBe8wVV0VCewvq=7s|eWgrhaDIv%j*y(q=92IU@7|1* z=>(<#Tk||PF;{Xc#hg#agXt7+aIN5ADx1R_Tf8DKhSLG2N+kHPYXOTE;O9(T9W5px zPnR$nARGU3IT5IKJ|0cRm?2l-O{9^a%VPf~exhhF8p3ASmQH}4%}SCsS&T=c5gHL2 zS~JNMAaKTzm!rw3KO9Wv8X^r^ERjkZf;t#u@pG`4FVP8-@kBhC%4vc!9(4!3!D6Zl zd>#-w2C%-A7lYAzzuyP1n9pE66^X-~v6@dtoqlhqEC9??v1l|3gEe(98oc&<0|c4N z#iP+Mcx7=30dKwTbgoGG9N}w#3{F;i)4_WWi#Hn9ZsM_6B$iAIh~&86?srFvg$xr2 zpF^9j4aSh$?E`l3kQ)g{;)$Fl&xgI2_s;ulqVxGwBpeRKfcnLGr~mT))|pNfA(sfB zpNArNAwivYhwsntou0A~@|oy)2tRO?zy{%Q2fqT=(n53vpLqXbA-9jt~qr7 zCEanO(PTQ;kb|Np9y~DN{*tl18TT!2(HXnP`Fs{D;HeCHAMSnH8Z)896_&p!bCpWQ z>1i$xOorV>L9zl-^>>5~R_ zN}(VXU*uRNOvsm0V%l(S?6SB}@ZrB@Fq6x|_@x&yfg}k0^tEPQ>-p{SlXk|t{n)U> znsq=RjGBtwcA!$q8V@6Qo}@=W;0=);_t;}5P21Q=iI+gwn99;*7#K195gcHTstbSt zr2BOfF9{Hk0$edQ6?g*ZiUwu&>`IUa6FFtsusKtQPy%9jcLAC}#iK5^DnbA~=Moen ze1u0}1^5hz1USV)ZLoD?EZy}IMqxbv;^`D??JyV#b=vO89+f3^g|U1L8HNtIc;yAp z+}LBOVPOK#yKHe{{Xj+nOu#g()@yh-g8?7_Cd?Fg?HV8j-Wk|e$pfO`4H?pg1y>zH zu#kZV50jpf^Epf{JW!Bk%qKvR^mH!LuNeXY3V1}*;W##ILazzb1Ps9;P((oPvKeB7H#w*g5M62o5qlSi3h;_oTktv#@D%okqRljYp)IBg zw$)?L0SU^mKYPwV8swG?q zY$-A`9M-j_$iD&tpi`5LgelTFUS4Ta2tg`!rqC{1poU}$bV*(;CIFJ-5kg514r%-_ zB}@I78tj?Sn-0p7RX`2;aZK8qI~tFA;}P&YpeF!n0wplXMD`aM*x?XWRx%Q^31nuI z*ySVZ(-G3bufySRp}?qQl3pfF;^`UBSbtN0|PCwQ6|Um5ik(D_ZDdB8ITkD1|^v=C}2-9^*-#0Uq3k4@d+}@n$WKWUVc-M6Kl!``WCv=}ZmjW(O7iX5OX<-y{Ub=6ici?$f~tAN=INhIdOP zN5N+?TN11?=IXk_R@#R>YZbq1Aqg8Wjk2hpKZ#?*P4o{j78eO3 z8#f2@coPv+{NUd*ZAqIt|MtD*up(f||KgLyVO9K8V3B2fZDf-5bgWxujj*j!R)7y& z5#po+ryFLAzM*c(5Ki%>rvzeWf~_&?6Or^;_Xq9+>rrl%VU zX`D3XG(*$ugb9?RnM}ajBRaM>5H`@k%*>8%q0H|&gLj-mh{O@|=DZtN`>lmMww5E!DO_f{4_7lvtNiAWrP9Uj5428vmPK%4|w z1nq#TAPvX^Q=>A6X%=9^D=bJw;em6hECDBB9#$GG+X!gD23US2 zs?PFuGg>RbT!o3BBMb=`I@hMi8v*)Yjzjv1RU!)vEWOSa(*@9shM$(f%1ahGEY!ga zjG1wQ63lN{4YmMHj%Ge=8C?JkLKvw*h6@OTS{zd%gdtBhMW$hebQTZ;l1{)z_>mm^ zzV(DK7D^CLXdzrf!O`#o*+>eGfsxUr7|J5xi^QO!LO-Ary~G3qs192dBBV(8W;#P^ z0(m-S^jaE_AD|gb03OA@GcKRTL5oa?HDZ8F;{v;bmm*#rqJ#$IF)R#(%>>R>7{Lhu zt7+utIAraRSh3Qc6U2d>VrJ07xD2R0NA7Zhu1_5w9RbVP1e^#tAxENMtr>BAWOWH>e~1C9W6C6k#ngyOw%{1`a$ zs%Xds3kekh*#Ua7hXcxgn#E<*|yl zUaP}Epx|c0-9&@Ir|Fm$%dG4X?jL3a^sqq#oYrlOzE9a-tA}GzjTo>_N1~P(6EKKi z#Ig>WcVrr4*jU1bK>DB&hfy~lA3Pt!=Z1rrw>4Q+qI@~lBNcsF5J7;RYu!bTL8ZJn_cl2sO9Asy?=7XPQBuii3i*ar*4R{WaI23bp$CGUfu&el4t zaBhp%L1BfK;oGA1$=}yoQ$Jk&T5Vft9p2w%t;;`GV(mnPkGj^`nhBO#t-oPe)4zOe z>k{=NdY@&YU=z8`_ZJagE=V3#rb^ZsQU3P$w|c~H)!hVvCipEJW5i9#r^>93rGZfq z7yACHlPKGOF^9gEf04_I)?QE-vow4NT>~5{+8*0bZz=1O-}EpiQS_B;@iJAP>Th@$ zX?^iUDQjUCA?Dk4TRFkrx03dtWs9AF=EYXl~Aos!3Xd9Y+bOS ze~!|pYQ(i+`9l89!>yi;K32{0cO7&pv7jQAu{Cg@9gLt12hlDE5$H|E5KBV{238tK z$N`4;*yAXxhwMEHsAO9Jfuw5l2)72LbmOo4lNIxgZE)l(ffZP8S_Nx&AYkqN+7sg0 zNZFQIU6xe@jq0oqOX8OrRI(v&zZq>yW+!V2)Z`ns4e9eYEBiv&vcoDWWrcLI_F(NF zEBU<*EoL@eQVlvjWNh2+LxaWty9T171qd?Z3?f)dQe#5cr!GJZW-Y{kjtO$z0SJ<7 zfC8A}F?Z7PDbjDqJz^)YPS};EcjTkkJ{z|3Nzj0njIF+eD$rrgwdgZ2VEvFleTl(s ztOHqDNK|5TG)h=1)k4TLdjn(8YBMkb!_I5uN^43A5{#stQlhl*YCTy1m{_wt`N-T~ z8$dCj&~Lm)SVVTfG>Q!QPraEQ1jtjiL`4Ar7NHR6>x3>W04M|CR*}F3d|6Val>!4G zhua1#(Rf>lZ4Cl=feFwt+F>GmD2IgM- z1nbtV_O&ar)}_8c9gDh()$AW+_>5y65Q+J{X^?euG125X9hRxM@hwYP<5Lk~uXTG_ zQCT1dOFaYbApjIIyjVq{q=YaH8)OZP*&GxL>yW88uuwvSh#TsSf z5-PJ1h51jtma5_)r?-`%v^u?I0TTtotf(<5mKZXY8NC&VY9C&FqT+Pp z858tT^of66vYnPUl^FBJ_WvM;c-F=c$9j+;e=V0kRb!`2=70Y9!v2|!3RqlOmqCdY z4pM|;UCqLmpR2J##;~P+QGp9qdtJH~w&h)Gq3gANv@VSk)Ri~KZvr>u&G%Y^#kC=_ zZ$=`)U#RO4Zk=MqUxfT#0oAvy`9;(x>Q=`(ZdB*f@#*4|gl(lyw0}SSB*tq0t=dl| zsAg%l>Z9b7%D-{wlNyqOOZxaEaBG`&^0{Pl{z=CF=yX$seKTb^Bb7w3bQATf7{cVS$b7g=_v#nr z|FJ3xD8&E6V=eoGk1G9J#SfhyjHKY-j?cw^d%mvmrR+n>7xLB)l#@vxY@a;)O#Hj^ zPZB@EXc6ho!JAV${onf?KJ#gwrRLj=~Kt*R3FPNu?A(!QBXWytuL;5Ks~n?b)?3vtwM=)ftJG4D3BFXlrw zxspXtKnKd1IvBVGOES~8uEfwCi32aq)Yih*8b)9mr%7A`9%Shkn&L$ug-w!`84XW9 zd}YC)5NxB(&Nrc6Gcua>v8}qHZ3#HB{Intrfy9E}8Z==PW-|Js_OP-`tTnBsqgvYt zQTsDAOTbHF=t#8OLJ1D4w^6wK-u#zesa7uh5mGCp;fV#y;t2oqX@Fc`Cu z+5!JJicpRVkmw5sY-OMd%vPfkb*q&)4D4A!$7Z{$A$xNmK*UB2kOUQIL^6pTIt7RX z(;u}sg@L8xOf1?nl!!PG-D-7GNrKlVK%!;c))1!1k_}dzh*;&JP}0K*b#AhNB8r<3 z!bmkDKwyvjWx)Xh>TM+&ST={1U|N9 z@mxwcUrQz;^M+(Vsugm=-k)VKhgj5MJ6VQx30%@a&cF+5H2h)%?Sh9DJpMrh946Z~ eA+bDxMmSABuMS?40!IvNglF;Ca+~lOR{no4$9a_i diff --git a/xemacs-packages/gnus/etc/sounds/yell2.au b/xemacs-packages/gnus/etc/sounds/yell2.au deleted file mode 100644 index 94f34d4745e185730d70e4420d7733e12ea010c8..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 20792 zcma&ONsqJI)+TuCU(~EJ^Sk$)H#$e_-Uj!*jgVy_3t0?Y5(A`SPy>F?_uYHX`$p^N z-2yi5jR7HKA%rXs7%*VKkfCdz{3simn_rLxx|MOq|@|XYc zm%pI@Bl!J4{N*qIQ{vx$gP-7Y{J;Bn|J~=moblg%`CtF|Z~pyX4*!qep7-yE|Ml#D zKl;z#{(1Q4!TPOw7aLUjQRNFH= zyxBae8W!P~lQk#*7n!$Z0|mpXc`%`mp>TA=ssGJ@NZ zW_cb3+8-?2a*r;9p&02L4hNTJz{pZZ(^O5YMv|7*qD(_~@HUu$19)7FaCe$TwQyS3 z4qltw8yJGL)$O5$;YasqXol-K?LxhM5DkWLjt)(@2iq|WvRtb(nyT+ftVtV&bF>Y& zhTyK|kw<5LU}*KwF6Rkjxp!>Ct0K;3=QLZEP1?F;8APet*e_+KUL!SGaj=%Bxy2GG zPo;Jd4As`68l=Y%E#{!P7|!h1n}ds0Fz;Y8je|~+jrw7udu`&d2h+{eNetV!acif8 z8DSiAbEsxZo@An^r%Dv*?SU03cC}pgRFk4yeQUQGgeo1-I z<8P9FmP@+g8>RnMaSywbv@AiT#q-h#HD9^3rO+g|;CqOgaOT+IVuPl}M47 zu|&p`8NxMX-Bwzebe7&O3`rwOD2~zEYGE{K$*Ch%#v*8Ov1Q66S!&sP$;GIHu4<-7 zVkrpMr`$wrCz2(bpBiY9aMrwAtfpJ0u~QEy=IzuyQAm^9+0rUysFuB5XvbQb*olWi z0rRx=Mzjj?yfB1-ROYZH%y zHLJ{5i(?jbMJJao(u=5 z5f8Omd%w_Hl}cNiF5Ggm>@0YZ$tG}lB{MkPY8+-NnlB=%Pxz<=nzj ztum^Lns&sk?S{(MYK5jV9jVPiLth#uo`Gs@mEBT}BBl#t6D=0^n|(Ro&;*w@MLnN4 z)mpKL%~%zyRBTCHTA6G^ny3~*)N*i5=H}9JemtP@jJ0=&rlm22uIvt)fh60?STDse z&D!s+oqgOmm0X3{8nxCz6gEz^f>N7ZxuU8xiQxMqvzHYrk9g}j38&lQnj!X@Ww?!a zRh)G`qdgj@R_jeLrp@=H3I zW>#7=i_<%>t}^Mor)#2qWagrsglg_$?gDoQe4~v(6>Zd?(lNNbohpS40m zH4?{k+O3!DrL3;aRx^{`FOC>ODRZ@vZxrJsI`bt_Y%{5{%d$p2;{d(lTg96YNy1B6Cu%WJ+oiJ+3sYuCI@1IO%W$IS9%g#PuYufz8Nad)VzXt!$Zxgd)UPCLbTRhx2xlZ&U0{M1P&8VdKxw?m06 zvys$era&xt`IwBM)@Y#CW7XAY34$xWXJ?H%mPA#Go~fR4%s>rgu%IiBi>Is7+$p-! zh_etV(Q36^c`dc8t=(o%)!=+vW*2rA6{jwQxZDD-t4cE)s%{30R-GVeOI8`n#%;Gr zw2*Akp0mAmBNvX+W5La4D1NHD9-2x?8s!2%Mz ziC|=sZBB5@F{7U|hW)|b(6#hOgeJhN}fyp^PP$7ZFub&B|! zT_~-1q+l(Dg@}hj=xVU2K`m?E-&LUsBhIW^J_pQ9%IE0$oXi#I)!NKu@YT#98iv!1 z*LM7bPL$P+(@3{AJedAmTixu46mpa|+>C_c6#znx9^GUVYkweG?FJ)^wREhdkG81@ zBJ+Zki>4`kINTwTD8=`=2ENvdnVO@Jj>zfpaCOVhT4*(UB#51+toIcZYpT695y_g| zhAPB!_F^zJGvS=gu?ka(!>BRt&9PMeI36eoxQ@A!WD=Qz$A(}ZDQztyTsf9x@w&q1~U%<9fJC{nL8u#7v@?}pX6TsOD z&Vee$^VD{B@U-oE*N8SL0zfi%vfgYg8c8JS1vhV@jY^3&Hwr`T)FX|ha}Dqq6z`mnNcPL2Ed`@vw3vJ?wYas zVlda*#cYDw%nc-!a%U4xPlporcw{0(F-A^@BQjaldr~U|eA%499Lv<1Op@_jdCsky zM~O)XA&>iJ+Z2`ymZbsTilm*N`=i}u$cgPkQR%k~nM@~R$crKlH zSXQJ^#M`t|HAzruxT=Y6hTIJ&EeJ6WP8MAWGp(8@o9Ut{40$StGVOAe9mAi5g~Z zh#amAIR-5x>qS!Tk9Jtr+R~Zofg58`N!yUA6vOxBbZxhyp#;MYR*h2KTDKDwW5gQ; zbhm3pQ>|5R+lp0|BNfiICY+msXl~kq2xVlXlID!cLhT8=#>?c|hN1S9RdO+6!4gnS z9O#7@$!+jR#T`uBP(c|<$r5-{Hyo~WTO6hUG)Tc1w?yN}w$BsM+>zVlGVXF=W`JSx z4xFdvb1Rp1*PB+grEZV4Bo4+K0Gt(nEaZ1HqnN7eXz~*#mZZ6r z12=cPiX`g>zpte!L9h}fniG)(Ch=-1+1?6FvTSiO4mGAL0&W?jZ7E(`t?W#5JK8j& zxx)y!@8+B}(iwtRD{yneD;21{T()v`ZK&cgY&tn65PP`9p_0ODg{(E^nRvn)?dnNp zGBnd^a%|>uM`2)k0VllLC1>f zaGOZsbM^?s9?O$)3Vlkywv*NSv5$>sfL)T36%cl}P6rJDy_zJ`?O}mYNTg zY?_#8Ww@sGc^qnPw`jU*juv#hwp_MzHJ6{X;F7qqvX#S>^We;3Nf(PC!_iX3bFtp1V zokpAqPp8uMpSE?BMh7_Fn$7G)MdudH81M~l2{?7ufh(3^XOrzYZ)D1va7brcYtGFV ztf^8>w0E4I&rmbDox)^x1)#nNU{>KU;u$dS{2>eDQ(n*H_PkUEA$X+MA$-N^nS6UD z(8(eQ8U)8h1N4bBAXZ91_N zHIH9oFuGovh2nm^Xl1L$cwb4Ag5W_V^3T=OkT|KFp;t2xgkcU`1KkMwTotryr}NfW zuH}wf9{6T_y0GBNo?A7c%8omfQVa)t0=iqe$rL!*$<(BYm8md-Kqk^ha2kvoBP9=E z3qjA6tSPt#fYutGB88!x&k$p^lqOaaHJ@>(YB_jDS`I;;>vxv?vnsIbL+9gxec_Oci`Im<-NwXP^s3n%`DI+yFn*?JaN!<=sRF;YwzuVx}pt$xPni z=54sK=Vc^SHu-g}>?sQ;pQjgEGk099+;W)`lwz9LY@B?F`V)lb-IYRvC^MTJv&aDe zu}pI_Hu5C`un5gkbF*%j03EbzBZxlJDpf{ToqFvks8}A?CA(g4$=tq}Lyd)6Dm3TZ zF_UjDIX#1@E2>a9idz73jD?*?F;<0t(utv zs%!vHVb1kjvPw=DjS{h&?F#vZ#p`7R1lL*;*)7&>z>|>>+)}nGO=vT{2<46|kb_{P zyuq^NwlF@V5qHK@sYGqTA1aOrj0-cRl?8~bjgv~D&UntC6?1Wb(=Dm5CShz0Yz(3o zeJhbYum%zXAYp=KYMW&}m1Vf0S*kID1w##SFhxMx$ukfzWp-C6?Rc#iFYbmLqDZf_ zGE_H56FgHk#(FAEO9M3pHX>Tm7b2Fe9A{D+*~?D8;EBA}0F;l_$WpuYk}9I! zRw0WxAPuMzE~)iQZ|R&>EYRB6ge!!^Gs(OGP$En!;|-E&Z4@fqmRAy%Ys%cN27&Ga9tGRY zMGBb895`!SO%h5J(DV1g{IQp41R z-O?nYSjD9+gSWtt1AC=ZktpKkVY98Hjh4dHNO7)}vZMki;f6IkRA9>7NR^r+iyIHF z5r+i>0=P3}xhI|dPVvC{rB-XA2`UDnK{g6)&7hC&NC&YURGHFfw!WUaD0blWN-|B)IT5e#U9?`pWqG@y3Dam) zOLcWFG3ACm0yZ6|0lugi6SWbC+snzyD|<$*j@R}pQ+I02VoE~M2G8lq!hxNTQK&uU ztr{TqTNzwiD}bihZQLC2;gdC0LjZ`gQfYj>E0uI!2MnGe%DXnbHVROtEeJmvT_eUg<3`KC>y7&X(m3O^J$C1OCDUr5AOj5D^$R1p^}w-eD;< za)@PM)g#C63bDE=XswpMVT!RT@R?0dHOQ^hD5T1piFT~IfC9`_+VhQL5p}ZJaEXSq z*=)9MI#yN{4{(bs7f{EvK>`AEbuW-)KVNq4-gROG&h24Y8^ z2k8SNTIn>vTHAIJV5Yv3xQ(klA(yiH9C;VQxS>|lH3sl?GN67*WoQexA@|k*q$sv1!urorEqOIoH*958H$y+AH1CkA<}T$WJEF+t8TveW;_l| z(ZY4H9Enqd54jwTdwt*t^r;g8WXOk7NJdGPwHh1Nj{1|k57w%L65dF&wUL^-2~l0p zCLFa`!(I;*>^jt5eoDDW+!)Mhd9+5aq7CkS+YCjHrF8T6NEEK=C?CT6{o1z?jO%o~X) zYz#&!K@jnzs||-#0g4?)BMYf%0FpV=u24$Fip!C9Xxoi=(OUJ!Yb1NnoLe1`?%v7PnX1CZZWcUWA2Yszsi{$n7OfhD71V#=ct_8U1_C{JtTe%nn zoLXP=^lY?3twsXxh2o{+lHE-mI8ik@0U+ThnyStg(@8T@2K3%~CM8mhBB7a!Nj+X* z){B`~iB~`@RE}%8P&^)1Q$fi_%cwSXTS^12+X`rHK#>fx8fmUoguSCKY`Ix27)$G2 z(F0C^-U)qvY)7vn4dD}{KH(@>p#DQ-8Z0&ypARFb4g^3eKb&V z`yWfV5=u`Ns|CJ2LVi>myc+4EzdTt_7KBa*BX#Yot0t0nxygFK9rf&W^vHL*%@iD9 z7JL_!h?AE9VmwWdL=>`x=}@oO&<&!GIukgVNKYrzb*8FN5$rhq0JL$QT+LU93Z>@b zn8)@F09#yXEADY)pG$d;IKu&%q8p~td$2j7tq2vqTA#j=gH6h(8X&AJ{3_2+3LL72zA3B(Fpj*7wfey(NRrNhuT!AJwH z6ipNr{!rUk^)`@o>?gf73|6u*@G3hpiL{yNaIno?-!_+Dy(*^U<1{0Fu@mCvGPUo1 zD6o+VfWrD0r!iR{atzeW?-upH16 zKc){p=84QPTa>nwsiQgJo8)286?13~YAR!Py)o)H5k~p|{;(D=TQimyRqXaMX?%5- z*<224Z-fyixv(!#TfFqPP!-g=gu&Ou&4tcW(%^ZTjwRyueE13KRFR9&Ves6i!!S%P zhTSoqPuv8(S?9~j1#-B-4klWukPgPp0a)mPDDEvee$}p`a3HPqK81RyShIO{xG5t@ zC`fKP-wqt8+RAt&7^Pw%9J70G0_KN~)^r3?!vYTYcB#jz$rw#og0S3GtK|@U;6H^{ zG)2%LE-dX#5xz^QAFqq*9gJDSF1G_o1{5p^uR}HBrx~ToiDn{;g=5?P*Svg{^bW%J za!0|HRImWbA8OQ(?~OqpWU|?MJkpqavqlIu8FjEQtrF4cL>)=JP2(M1xsif+(n54JR|VT8P{t{O6Y( zi?+(PFya9mhOh6MT<24Z6e}P-9gTqoCUTv%K0CAe9flI)-eN<*<-}ca^6@4G{RE&- z*r`&F=WhK}_kBp-U^=-T%$7zfmA}gv-`{fa&N4yrDK5x3QNAq-{hsNMXl;X?uXp*x zA?C;V?vU}fMM53}B}BT=x`VA@U#f-GeM6pXXAVRWp{zI_>Cx!UwI_3Z*GL;kD7WT0 zCyK82`=zm6Y#=V6 z>pIq$D6u#uEuC1E=N4A3E;k54gaHGm5(R2D*-`~ZZaJe>Dva8S+W@4yf@Xm1N8*mj zFm4~2qs|XWC}SF~${nKNJYva;!3)hqg*xm2M-~sjO>40-`8g5Iw$0g?Q=mY)NKR&} z(K;D|S}UGs_nFHONSirjvnmCmwM}opYVpfJO=Ek@tx~*+)@I!yrzOv?tLod!y2+FS z32!stW|QW{Rm$ykgqn>N)MEUvNe6t zAht6)2~nJ6^W#D&R#*+BGO2r|a(f{tt0{UHsB8caQgQ4GV21dmsaWw~ayJ02Dke~H zneukOld&+|8iRg74!>y=s$zLdDIIQVYbzPI`U=@(^n*Q-ia}&2?z1U(u)xvQ!8r&* zK9u%!6HS^d*RCL*vj_180-4Iesnc9vE0(b%h)&B|IEJ`}-PDIX$jr#yh8rHku?)~d zq4aP{=d$hHf@Ae~5Uy_5O;D0!a>>?mDlSAa6h_R&9zP1(EXcs5rLe?ef%0xGQy_R( zQgusREd(zbOdn@6s<~J-igi+&@vIXH0kV8b*8ziH%+c%dhTr7;5V{#V*l}i7pt>@j zZzT%~Wm}*+fYQrjq2R2y>!Fgrg<9K@ox%Bi0Z;_<6}yhzrSZkc%9w&%tl%@wGFM0h zs%<&B2of~9+}zFV!(x|&0I{LbRRi!j^@C{}oKT4tu-&SjJPr-C+R_ZQFDJuj)e@?? z9ZNT>puVH?QY?bj)hSt!1*cWR#1&<5!6?fKY_5mM%zd6-8jZ2wbBjt5yWXf^3Re z&jG~|ivdPuRmlU~UI2xvsWd#q!#Q*(p!F?J=V6>(=&T&^r?3@ISER|Y2zXHOs0#H! z1m7;r5;mO^W&E&^we>NcZje9$iLa(MQesqjG2BE$D5(R|aXZ*G^Hq8EXGJ2CEY^2+ z!x_z+xsq3Mqm+dw+x{mBev%*}Q@ zuu``%8YIlPJyM}KW`Xs;szpL5W$BbW;A(LgsB1=DJr)S(P30(e`))Lp1BTXTk-Gp) zt)=6tFO)){I6C8d>-bF==$&M5JTzkQ5~!y3N6njX9#?g8_q{@*a8qG{j3e)l<_Oi$ zM|~iED>$nO@GQ_}ywKWd;@7Ae0Tu8G|2brCZsS!+l1JSG6b@7DVAy9OH&B_;4E7V; z^e(*~ai8PFZ7^1Kw(NVCiTJ}VH)G$m&~*r+q#5u))o?f~aoqQyesdcsDKj9Ku;5@6 zopJs5P2@V50K6F6+oIt>0a)6{Cv$rfj62-0H*CX!uq~|F4j;P;#oH?xKrJ$J8{f}| zF9Yf(5P`h)=>5Zq-QKlXw%0LYx8ZP6VMc@fOeZyH+R|O&nKq0f^}m;j+D+y!YzY z{urWeReIpS{YJFEj6cea#xT*TJ~U^}jko`1}T04Z2^G_U-viT8S4}ejEvd z&M@n{%1NXC8(R$A+{KB>_sgpiybNF)Zt%WJUSCGRIvsU;htORFUyr))YUI)%2gSz0 zN0++2ijeDG=gqmfxQSpI_x98+pI^a;$=ef~zP`SML}Bp!t;cWu8Ex?RB!@1q0{Q*y z^}gp_UW763`}KVn@%gUO!pGAy*Sx%lw)oe_H_Cqjo{@ilcwQw>eV`EX`q)GL=cjjv z@8|pXR`C29ReL`__MvOvZPQ|3ehm`7^SHBkdz|2*>#IOb{CIj=hcB-S68HJ8R6;km zF^_wD=`!J)AS$wNT_<~Y7cW@s=liI2cLS3f_G{o2?k)ob;q&8TK>06k(Rugr{TTK6 zLc~;ff9MxaPr_#Z?U_Sj7pD=b_x#vdL#L-P^}F*lK*A@daqIK>wX4KV&l6Jb<(@6x zoSc_t-LK~l_x99R6}qpFLiYN^S6zL+zr5{lPcD%8+vBqqxjehE_|farckBGe70Gw* z-^n}Q5C4|yJ#_fW>5t%{_xQk;ZZ6IuTJPy;v=5zJ<+k0&r)BE$+?N}FzI1r%@&cmx z-p8ksy1WPweD~{9_r-L3i=}^r^%yPcQ1Dug=RjSgJ-QfA2t%lA|LhZrR&nM;fZ)as``1Bybfge9|TJP7d zH~Qk_uC@O7^IbFPpHEuh@<*tO zEgl{|72l5-wtRTvE78k~yVCsa?@xB<kMrV_Zi@;e{@{5guAUFD6>mw{Ew zM0}Sq_2uu6%H=uWQ=WS`iB}-sZAtib-%a^~rB%1DR44}vT}H_FpPypz5?54~*Y|cU zc5%~OJU$Ag%NWj#-&ZzONrkUtyYF9bRP?%FD4=GF)SA$301-Nm!}68CwV!@1$VQ_U zz6pEp_s{B$4{`>b0aB<`@{!x@`2K#7Iln#*KYL!h?xLZqkp6i8g@Ue)`HAd#?Q-ZQ z*8YC@+y<{|`nW$k*4rg09IUOMo_O>!CN1{*Yz3&u+dGi^Jbk#(O@VZ$Jz<9@Z||Zt zuJia+zwzaFY-d@iBI&R{w14~gFb$mD9eW=vlAyHW^+jy)^PgX-vn!wl=eZ?wv|8cwU}Ny}X_Pt-Dp92cyXPT zAO3h<-krsayl;Kcrwe~sxd1%}D`!jKSk(cMADM1+6-T8Iv ziu>uJQiU{U8^LA*3_u0Vx}NeG|t< zPd~qK{{?guz)CIF6M@@+`~Jr-KIjWzvmr--?FAVy=bMLrcA7W-;z0mq7UEb71q0~d zkDr6=#Z^P)x=XxTfp2dj`s+XM7lDhr%KW3N7pvvi?Jc~x|HpIt_A=`9Ki6fVRg7KV zpuK z1DCf-_aFZlVLwh`ulvH9^;F>U4B|Wg`fHu~ahBWn9=mcgesO+L96bH&g988UENgWi zKLFo)ady%Ee*V`dGxpnA5xC9wdGYS_$Bpv#@NXSD_}2@>c=^Rq(B=6}bn*7-v zS3fnse{rDD&E;)|fBX4QHhJ=UT>F0du*&h<3tygn{`()3$dBLSCjaYEF5I4;`CI*` zzu#}8KYoiH*k6zH>h;N)pYA>VaX(F+{mU&iz5mIgSEm&IV1$Cp2Pgzq|olG*+6*Zm^-pH3S5 z!-EX_pc+!hi{F1dXyJc3clw?04Oz%W1A!X<_Uma~JUfjMeCN5_jQB78O=H%1_*_SS zKaZ*J53f!r0zpv58$JGf!$FLpd!M}pQO-rKqd5C?|7rzK&oisuOXmPZZ+%&B`ug~? z$ejHM@4p{kw0O`T%C(lg=Z8Le@tcq6K0i;2kw72_A4V_tPh#}+x1hm2JuT4i?fDh5 z?LPhdY{z~-&F#PLU#H2dOMj|8>pwkAFyC)CMeeoJJ*2{Sm+|f3@z=KzJ2?y4!~2IR znB()5J^i@vjFF4K`5OHFuYTEo>yH8A_~qxb5&Dnm_^83!O0HOZJ!=icfA5Y`kmp^_9u|iCG;=8_Tu5+UX|-JU)bQ;{@b^g`u#WP@OVdyqkV6nMcTwLt@Swf-=U2Jx`*GLoK0mxT z*Jo!w>ht>>@MPJG-!6^MKmIX{pPXD_EWa3ZKAhm+P71@H_rt>NT_n{q`OlZPEqrzo z&_7;3*jDWFI#?Ta*?w7j?a(xjfFXn6R1I+x%c}0AF9v;HikrXaX$6p^Z za&sEO`>!wG#Pv-estl&$cW;CEPJ`;xbFUSO#i53_0%&~J3S3-P`kgnx!{6P6Q1PqV zA6ljO%{AWZJbhyRvzvnYB^csxjYQ6Z(%WO#i(iGR-fFX*4`x`*cS8-I2P-pu6N*>4 zE+z(I=^8$PhV2%`Zh^wlZn7B$y6i&FS@<&Y5wji z3dFk#WzK-a$QKvh-dD9aNICaA+m>f5^G`l@{JpaF&19ikJuX+uW_$3;VdyaDzWB`L zUD^iR2EJg&cJQh=`WRZtNZM0&c9Q}r36qB_D_*n@9+Ijw+S_fL0PXcu1cELxt_xbW&R3DD?9E8dT zx?ROL{L&yQH4C&QcR&{bNL@{`a7&yltHCI->;hgoT2`i1GB0;Orioif8Et_WZabHo zFw|TNOU0qu?RpI*`H@^JX9|wnvILe>p+LU9=?P9IgS4G0>hQgx0*5N@N~IWMM`4vb z$i6pA@j&DfW!ezARV`gY>y&d`jX1p=jZxBiy|&ubWUlTQfY*`i2B_N~SL@A|NPvs( zx9T43g`;!vthEpXxtyr9D9fg;)m(CcAa}3rWQ!te4bKC*23wk1^<2JXtVPMqmuRqq zlt965A0P-Rw3V4?=Mwe9R3u78dd;t!g_^6{4TRn+E4^8%AYjYmS~)aoBuyGRiOK2# zREt3|syFmfxU+Za1t2&W&FY~*^1$}EJ&xn`L=0Jce+-V%U@+E_haX=;IUEWncl};( z;G~0>m+|%M<0GGpMT1aV8N7VXY5-?I`WILhMEvG9l-zwiKMm@4z6(DF2}iB5`?g7MH$X9zPDb%Ts@4`ugxPLxPtV zm#Fyq^Kp>7IJ+!t1|QEo623mUh^=3L{pu0{-+9DYeuEsP>_0p66YLv+)vc@3OIYnc zJ`Ttz$R^Ti_x@MMzB@gSS{w*4Y5|1kTX*mbQoCI6)K^nR?~ffVaea0Q&p}G{wJBWx zeqLPw{4>c$E>G^N{MWBv-&o+s?@^h3d+Kn-;E&$|^7qrP&aM{z{VcxeKm2@aM{j;V zDQ$ZXzd9Cl`qvAB`@DZ#133TtMSJw}^L|v0{P+Qxpj&U-jQ{lapfbAu<7=D0JvoVO zKb{_6cZHjiQ@{55@bG1)!>8vJ`R(C#L_jwem&GLrf`SK1c((<$|J56)nE(7HA-;9K zm-}|%+6OVc*UslQb9d#7>7)0zE+Agc&%(#S=XY;v#V#-X`0(wcH!^Ftr?(~c{r#P# zW7lVQ)a?D`1Jo(cPVd0EomUx+_$~qz_xAh>D!XUr@%HHB^-Vwmm%ztQU!Pujbl~hP z=nOxfJM$Je^n1ORr_Qtz0vV?}e13Q{k|0@2?uL&K9kzN724@Qltxu<~PR_&H+s{8b z2QVU+=oSplckAxt$4z_Cd3YSy!QW4AkKM;#9VHbwIgQf2`=3uj^7Oa!?BW~Dq!GXP zaRx0r5BIP8%=vFVcne_7XFGK9+Xb@uxW9i<<0pT+sExnw?}u*e?DzA+b=ew>GQUyl!Oo4o(`6L{Z!`1!0t7r&pu zU{-&<3i=zI_WgblRo;L8^JNz~|Jy}*`~Gm>*@u4o^(@bI{?_IeiUSv zPlI;g;^YQo-%n3n{Ok* z+q2VKy8rU<%#;3;vpcWX0r)8IKmE@f!BdAv10a$Cr1bpCBDZH}0k{A9{L0($ixVF@ z1b5?dfs6A{O?U@4K7zE@zaMoT-^S&;^K*ZD2$0wqgroBS$lKmOW))x}A(RLF0eegY zFYa2)ug?467`yb{B0~S|btn~X&wS(A#GKzv@G2k6lgsLFD0_vpx5LCKCq5NUP z_SpF$>%U7Kr-Lp?31Z<`&RdOoeZedE@AC8t(597wkM7hp_!>!tom~8w+PVY0Qm9G98cSTyZ`bFXeVJ607WI!gwN6sTkm=wg8O? zAV~~@Es|r77tAsogBlK~%#EhUbTpK4B!TB(vxf=F3uys5VPSGoF#EM=% z9!~%<<%nH*jVzQXdYdsXXm}BVNb*vBWWlF#2ky+az|r%uuX5b z2FTNF786M=jsO2YT~rzGC*m$H(d&B z=VXqase`vqw80V0xVE90P8+MY=%bL4uTidow>9i!@X8Act<{^LiUZytVUsnWF*qKyt)zP` z1jSn5>Y%MnR?BGX==$tXUiA^ zBtbLzh~{$Tx(8-prnHevp^#`*KcZ3I#LqZu~R zM3x)~h9DdSfdz{#SZukUFR`USjwL}j91g}oxPrwNTd-uw{NBtiPjO5byy48e`M1ln zC6jMtIiQ2M_`n(*zTe;d{SrU__Tl5^@a^u)-L5--_wGFG?*IJCgY#$a-=Ez+-F>}( z%GV!x4mCag_2prouKzgu{VF}*KRjp3yg1)1+lTMl%s;cc&8DCBFZ(=C%fLIM!(qF7 z&G4vnmtx!CCx`K1-7nAI9)Dm6mlr&v{LiBv(g|0eJ`H<=Od>hM z_tM|obQ2LKXjRH^eH99i&@NNS;($r$7U)jcSddqg5vrIeX9!tBgaBopN*Sl1bVmqZ zV3#RNpg=Ym8;}1$A3~hP{vzg=GIYa|k0lNRFRN1Lq-ddsg(mZdp$5E5hTx>2?qD)G z9+iH$?P09R<2W93?D@?aKxk%I5dc&ps9s}DLzoJmP_&es254-!D-wC8NxU}`+&F2@ zC6|OWFEK7esCJ;Pfpe$O3$#2e4h%97(V(P9WL~fC7#-D6PU4PF z5clMnP}D;fB3RtH90`GapjIDE&&+5Q7_rp+OcN=QVJ!4G&;%3Bi)w@uh~jyU3|A_l zAzGD=V8m59wFb+EnJE)2=?lms%$l-hicZxo6h?rO2?Ho90AE{DBXf|GaYAZC5sX?( z0+ehq5QAM!K;$4Lz6PZSaygLZW3WM5ZgFxGEYmlmP}=;oMf3Tu_PTzd^)t# ztOY|D+(W4-;w!BXC=sn)DZFZzS}^HcV`ffDrsL${A{tYt=1^T$SGSwiqt*zkLjx*K zO`?b#E!VFyP@vDpU2Tcz%1}1-HVT^_J=gXLs!?c+NMrz^`Iy8^ylp<2-zvM^!<(yM zb={<`r6>kCcBx5*uhaHstgu!i$t4mG$wkFBo$65Bww$J1$0MyUE524{v5?gU__mMO zQGBV|R}}Y(iB_ewc&lJ};80ugU8(+wp&P!{VWBOzYLi+;m}H_|s0ur*H600|aCCrO$aF6Eib}oNT!L>Q9g~+49 NTrx=AiVf}_%fD!v*MR^4 diff --git a/xemacs-packages/gnus/etc/todo.upstream b/xemacs-packages/gnus/etc/todo.upstream deleted file mode 100644 index 92ff87ed..00000000 --- a/xemacs-packages/gnus/etc/todo.upstream +++ /dev/null @@ -1,1523 +0,0 @@ -;; Also know as the "wish list". Some are done. For the others, no -;; promise when to be implemented. - -* gnus-topic-kill-region - From Colin Marquardt - - I noticed that when re-arranging topics, C-k yanks a topic just fine - (runs gnus-topic-kill-group). - - However, my habit is to do marking and the yanking the region, so I - would run C-w on the marked topic. But C-w runs - gnus-group-kill-region and doesn't yank the topic (for groups it - works fine). - - So could we have a gnus-topic-kill-region, or a - gnus-group-kill-region which handles topics as well? - -* Speed up sorting in summary buffer if there is a limit. - - Suggested by Daniel Ortmann . - -* Investigate the memory usage of Gnus. - - But it does seem strange that Gnus would use some 15meg for this. I - think that is worth investigating. I suspect that bugs or bad - design are causing waste; they could be in Gnus, or in Emacs. -- RMS - -* Google group digest - - The result of Google group search return a thread. Is it a digest - format? - -* NOV caching. - - Implement NOV caching with Gnus Agent. - -* Multiple charsets for topic names. - - [Done] - -* Allow specification of server in Newsgroups header - - [Kai wrote] - - WIBNI I could put `Newsgroups: nntp+quimby:bla' into a message and - Gnus would know to post this message on my server `nntp:quimby' into - the group bla? I think this would be way cool. - - But Gnus would have to rewrite the Newsgroups header before actually - sending the posting. - - Thanks for Micha Wiedenmann for this suggestion. - -* Understand mail-user-agent. Maybe gnus-mail-user-agent. - - [Done] - -* Emphasis delimiters show when `W W c'. - - [Fixed] - -* Parsing of the common list confirmation requests so that Gnus can - prepare the response with a single command. Including LISTSERV - periodic ping messages and the like. - -* Parsing of the various List-* headers to enable automatic commands - like "send help message," "send unsubscribe message," and the like. - - [done, see gnus-ml.el] - -* Parsing of the subscription notice to stash away details like what - address you're subscribed to the list under (and automatically send - mail to the list using that address, when you send mail inside the list - group), what address to mail to unsubscribe, and the list info message - if available. Hitting the "get FAQ" command inside a mailing list - group should display that stashed copy of the info message. - -* Some help in coming up with good split rules for mailing lists, as - automated as possible. Splitting on To and Cc is almost always not - what I want, since it can misfile messages and since if I'm cc'd on - list mail I want to get both copies, one in my personal mailbox and one - in the list mailbox. I know other people handle it other ways, but I - prefer it that way. Accordingly, some way to semi-automatically - generate split rules based on Sender, Mailing-List, Return-Path, - X-Loop, and all of the other random headers that often work would be - very cool. - -* Support for zipped folders for all backends this makes sense for. - Most likely using jka-compr. (It has been suggested that this do - work but I think it should be verified for all backends.) - -* Support for RFC2015, PGP-MIME. Probably has to involve the people in - the Mailcrypt project. - - [done] - -* Agent (Can someone write some subtopics here? I don't use it myself - so I don't know what is lacking.) - -* Support for encrypted folders. Even if the mail arrives unencrypted - Gnus should be able to encrypt the *folder* for added safety. This - should go for both Gnus' own folders and the folders Gnus reads from - (e.g. /var/spool/mail/${USER}). All backends this makes sense for. - - [John Wiegley's article <200011030445.VAA08277@localhost.dynodns.net>, - posted on gnu.emacs.gnus does this. - Also, gnus-article-encrypt `K E' encrypts the article body.] - -* The stuff on "Newest Features" in the manual should be implemented - and the node updated (it maybe is?). - -* Splitting .newsrc.eld so the history is in one file and the - configuration is in another. To help those that reads at two - locations (e.g. work and home) and want to have the same - configuration. - -* gnus-uu-decode should complain if one or more parts of a series post - (ie, "part N of X") is missing, and optionally tick what parts are - there for decoding in a later session. - -* Additional article marking, and an ability to affect marks placed - during e.g. mail acquisition. I want to be able to notice the - subject "fast money" or "web traffic", automatically mark it with a - `$', and score it into oblivion. (But I fear that wanting to change - marks with mail-source-* and nnmail-* functions will represent a - philosophical conflict with the rest of Gnus' management of article - marks. mail-source-* and nnmail-* currently hack around with files - under ~/Mail and leave traces in ~/Mail/active, but don't affect - things stored in .newsrc.eld.) - -* A much better interface to nnmail-split-methods. I don't know how - I'd like this done, but I know that the current method of manually - hacking regexps is pretty untenable for new users. My boss, who is - tenured faculty at CMU and CEO & CTO at JPRC, and whose research - work has involved Lisp for the last 25 years, is trying to implant - himself in a Gnus mail environment, and this is a big sticking point - even for him. - -* PGP-supported encryption of entire nnml & nnmh groups. There are - people with whom I exchange mail routinely who don't send w/PGP, but - I'd really rather that the content not be left lying around - unencrypted. Hook into article acquisition the way jka-compr - supposedly does, to auto-decrypt every message read. - - [See Support for encrypted folders.] - -* Baby's First Mail In Gnus. Some set of functions that the - new-to-mail-in-Gnus user can invoke which will query the user - appropriately for the basic information required to establish mail - handling, leaving the appropriate traces in .gnus. Perhaps a - customize buffer would be appropriate. - - Where does your mail come from? - - If some server, what is your POP/IMAP protocol identity? - - What is your identity when sending mail, as opposed to posting to - Usenet? - - Here are some basic concepts of mail groups (list a few: - personal mail, company-wide mail, mailing lists, garbage dumps, - receptacles for outbound copies of what one sends; which ones do - you want to instantiate, and what mail should land in each? - [/viz./ problem of nnmail-split-methods interface.] - -* Full integration of nnir into Gnus. Generic hooks for adding new - external nnir sources. I use a couple experimental, in-house tools - (JPRC is a research lab, occupied with document analysis and machine - learning) and adding new search engines to nnir by hacking the main - nnir.el module is rather clunky. - -* Manual ordering of articles in an nnml folder. - - That is, keystrokes to move articles (or whole threads) up or down - in the *Summary* buffer relative to the other articles. The order - would be persistent (e.g., across gnus sessions). - - With this ability, an nnml folder would make for a good to-do list. - -* Since many uses Gnus to store to do lists I think it is time for an - nntodo. (I know Kai already written one, maybe use that for a start?) - -* nnsql backend, which would allow messages or folders to be imported - in a local (My|Postgre|?)SQL RDBMS. - -* "posting profiles" ideally accessible from a popup menu; allowing - choice between predefined profiles of - from,name,organization,etc. Example: I'm at home, but need to reply - to a work mail; i can hit 'R', then use this command to switch to my - 'work' profile for purposes of this one reply. (This might already - be possible with current Gnus, but I don't think so.) - -* Better handling of the mail retrieving / splitting feature: - - the variables -get-new-mail should not exist anymore. Mail - retrieving should be a separate matter. - - we should be able to split mails to groups AND backends at the same time. - - meanwhile, we should still be able to associate certain mail sources with - certain backends. - -* A better interface to the agent download scoring rules, like the one - for the other scoring rules. - -* Editing of messages in the agents cache. - -* More article marks (like '!' or '?'). - Maybe user defined marks that can be displayed as any choosen charakter, - so one could do things like limiting on, to do whatever one likes with - these articles. - -* A possibility to add notes to messages. If thouse could include links - to other (stored) messages this would be very practical. - -* A nnfolder like backend with .overview files. - This would not only speed up things, but also allow nnir to work on it. - - [done] - -* Allow article editing in groups which do not support it, but - emulating it via deleting the old article and entering the new one - into the group. This would be very useful to support `T ^' (say) in - nnimap groups. - -* Allow user to specify which kinds of groups should be displayed. - For example, I want to display all the groups that are displayed - now, plus those which have cached messages in them. (Gnus does - display those with ticked messages but not those with - cached-but-unticked ones.) This would become even more important - when we allow labels. - -* Go through the todo list and remove items already done. - -* Create new data type `article identifier' and use that instead of - article numbers. A first implementation could offer something like - (num . 4711) but this could be extended. This would be useful for - using servers with *really* large numbers -- there we could have a - bignum type. It might also be useful for the nnweb and nnultimate - thingies where article identifiers are not really numbers. - -* Allow use of digests to keep related articles. Normally, you use - groups to group together articles which are thematically related. - But sometimes, you have so many themes that this becomes - impractical. WIBNI I could have digests in a group, and there was a - way to add a new article to one of the digests in that group? - - Or maybe what I really want is a way to tell Gnus that a specific - thread should always be hidden (as in `T h') by default, while most - other threads are not hidden by default. Hm. - -* New backend between nnfolder and nnml: have more than one article - per file, but more than one file per group. With .overview files. - - [done. nnfolder has .overview. Backward- and forward-compatible - between 1.0 and 2.0. (setq nnfolder-nov-is-evil t) disables the - feature] - -* .overview files for nnfolder? - - [done] - -* New backend nnbabylfolder. There is also nnbabyl which is like - nnmbox but uses babyl format, but there is no babyl format - equivalent of nnfolder. - -* Make movement commands in summary buffer independent of `move after - mark' behavior when marking articles. Currently, if you don't want - `E' to move to the next unread article, you have to set - gnus-summary-goto-unread to nil, and then there is no way to move to - the next or previous unread article. - - This one has two sub-tasks. Providing the commands is one thing, - finding out useful key bindings for them is another. I think we - could provide the commands first while not changing the behavior of - the key bindings; then different people can experiment with - different key binding schemes until we find something which suits - many people. - -* `Move to next/previous/first article' is a misnomer, since ticked - articles are also unread but not moved to by these commands. Should - the terminology be fixed or the documentation, or what? - -* Allow sorting of threads by newest article rather than by root of - thread. Consider the following thread structure: - - root1 Jan 1 - leaf1 Jan 4 - root2 Jan 2 - leaf2 Jan 3 - - These two threads are sorted this way because root1 is older than - root2. I want an option to sort them the other way round because - leaf1 is newer than leaf2. - -* Improve editing of MIME messages. I would like to use html-mode to - edit the body of a text/html message, and enriched-mode for - text/enriched messages, and so on. This should go for multipart - messages as well. This is probably a hard one since Emacs currently - does not allow several major modes per buffer. But maybe it would - be nice to hack Emacs to provide this infrastructure so that Gnus - can make use of it? This would also make it possible to provide - nifty commands for editing the headers, for example, rather than - relying on commands which do the same thing everywhere. - message-x.el is really just a half-assed attempt at doing it, and - while it is useful, that's not the way it should be done. - - I think Francisco Potort,Al(B already did something like this? - -* Provide commands for editing MML tags. For example, there could be - a command mml-add-tag-attribute which prompts me for an attribute - name (with completion, from the set filename, type, ...), and then - for a value. (This is like `C-c +' in psgml.) Or there could be a - command which showed me all the attributes in an MML tag and allows - me to use TAB to move between them, and then to edit each attribute - value. (This is like `C-c C-a' in psgml.) - -* Have Gnus automagically set group parameters for mailing list - groups. For example, if I have a splitting rule that automatically - sorts ding@gnus.org into mail.ding, then Gnus should clue in, set - the to-list parameter to 'ding@gnus.org', and set total-expire. - (This is probably Hard (TM). And of course the user should be able - to configure what parameters exactly get set.) - -* Along the same lines, automagically detect broken reply-to's. (But - don't auto-detect users legitimately setting a reply-to header that - points back to the list.) - -* Make it easier to change parameters on a set of groups, - e.g. set/clear gcc-self on process-marked groups. - -* Make it easier/possible to migrate between primary select-methods, - if that concept is going to be kept. Right now I have only one - group on my primary server, and I'd kind of like to change from nntp - to nnml, but apparently this doesn't work well. - -* Make it possible to refer to uniquely-named groups without - select-method prefix (e.g. mail.misc instead of nnml:mail.misc). - -* Allow a user-defined picons directory for personal groups. - -* Annotations as discussed last autumn. Be able to make comments to - articles for all bakends. The comments amybe should go into a - seperate "backend", like nndraft. - -* Catchup on a topic and all its subtopics. I.e. do "c y" when on a - topic line in *Group*. - -* Better/more advanced subject washing in *Summary*, see my - js-gnus-simplify-subject-function I posted earlier this winter. - -;; From Newest Features node. Some are not done. - -* I would like the zombie-page to contain an URL to the source of the -latest version of gnus or some explanation on where to find it. - -* A way to continue editing the latest Message composition. - -* http://www.sonicnet.com/feature/ari3/ - - [N/A] - -* facep is not declared. - -* Include a section in the manual on why the number of articles isn't -the same in the group buffer and on the SPC prompt. - -* Interacting with rmail fcc isn't easy. - -* Hypermail: - [N/A] - [N/A] - [N/A] - [N/A] - http://www.uwsg.indiana.edu/hypermail/linux/kernel/9610/index.html - [N/A] - [N/A]http://www.miranova.com/gnus-list/ - - [w3 or nnwarchive?] - -* `^-- ' is made into - in LaTeX. - -* gnus-kill is much slower than it was in GNUS 4.1.3. - -* when expunging articles on low score, the sparse nodes keep - hanging on? - -* starting the first time seems to hang Gnus on some systems. Does - NEWGROUPS answer too fast? - -* nndir doesn't read gzipped files. - -* FAQ doesn't have an up node? - -* when moving mail from a procmail spool to the crash-box, the - crash-box is only appropriate to one specific group. - -* `t' `t' makes X-Faces disappear. - -* nnmh-be-safe means that crossposted articles will be marked as - unread. - -* Orphan score entries don't show on "V t" score trace - -* when clearing out data, the cache data should also be reset. - -* rewrite gnus-summary-limit-children to be non-recursive to avoid -exceeding lisp nesting on huge groups. - -* expunged articles are counted when computing scores. - -* implement gnus-batch-brew-soup - -* ticked articles aren't easy to read in pick mode - `n' and stuff - just skips past them. Read articles are the same. - -* topics that contain just groups with ticked articles aren't - displayed. - -* nndoc should always allocate unique Message-IDs. - -* If there are mail groups the first time you use Gnus, Gnus'll - make the mail groups killed. - -* no "no news is good news" when using topics. - -* when doing crosspost marking, the cache has to be consulted and - articles have to be removed. - -* nnweb should fetch complete articles when they are split into - several parts. - -* scoring on head immediate doesn't work. - -* finding short score file names takes forever. - -* canceling articles in foreign groups. - -* nntp-open-rlogin no longer works. - -* C-u C-x C-s (Summary) switches to the group buffer. - -* move nnmail-split-history out to the backends. - -* nnweb doesn't work properly. - -* using a virtual server name as `gnus-select-method' doesn't work? - -* when killing/yanking a group from one topic to another in a - slave, the master will yank it first to one topic and then add it - to another. Perhaps. - -* warn user about `=' redirection of a group in the active file? - -* take over the XEmacs menubar and offer a toggle between the XEmacs - bar and the Gnus bar. - -* push active file and NOV file parsing down into C code. - `(canonize-message-id id)' - `(mail-parent-message-id references n)' - `(parse-news-nov-line &optional dependency-hashtb)' - `(parse-news-nov-region beg end &optional dependency-hashtb fullp)' - `(parse-news-active-region beg end hashtb)' - -* nnml .overview directory with splits. - -* asynchronous cache - -* postponed commands. - -* the selected article show have its Subject displayed in its - summary line. - -* when entering groups, get the real number of unread articles from - the server? - -* sort after gathering threads - make false roots have the headers - of the oldest orphan with a 0 article number? - -* nndoc groups should inherit the score files of their parents? - Also inherit copy prompts and save files. - -* command to start up Gnus (if not running) and enter a mail mode - buffer. - -* allow editing the group description from the group buffer for - backends that support that. - -* gnus-hide,show-all-topics - -* groups and sub-topics should be allowed to mingle inside each - topic, and not just list all subtopics at the end. - -* a command to remove all read articles that are not needed to - connect threads - `gnus-summary-limit-to-sparse-unread'? - -* a variable to turn off limiting/cutting of threads in the tree - buffer. - -* a variable to limit how many files are uudecoded. - -* add zombie groups to a special "New Groups" topic. - -* server mode command: close/open all connections - -* put a file date in gnus-score-alist and check whether the file - has been changed before using it. - -* on exit from a digest group, go to the next article in the parent - group. - -* hide (sub)threads with low score. - -* when expiring, remove all marks from expired articles. - -* gnus-summary-limit-to-body - -* a regexp alist that says what level groups are to be subscribed - on. Eg. - `(("nnml:" . 1))'. - -* easier interface to nnkiboze to create ephemeral groups that - contain groups that match a regexp. - -* allow newlines in urls, but remove them before using the - URL. - -* If there is no From line, the mail backends should fudge one from - the "From " line. - -* fuzzy simplifying should strip all non-alpha-numerical info from - subject lines. - -* gnus-soup-brew-soup-with-high-scores. - -* nntp-ping-before-connect - -* command to check whether NOV is evil. "list overview.fmt". - -* when entering a group, Gnus should look through the score files - very early for `local' atoms and set those local variables. - -* message annotations. - -* topics are always yanked before groups, and that's not good. - -* (set-extent-property extent 'help-echo "String to display in - minibuf") to display help in the minibuffer on buttons under - XEmacs. - -* allow group line format spec to say how many articles there are - in the cache. - -* AUTHINFO GENERIC - -* `run-with-idle-timer' in gnus-demon. - -* stop using invisible text properties and start using overlays - instead - -* C-c C-f C-e to add an Expires header. - -* go from one group to the next; everything is expunged; go to the - next group instead of going to the group buffer. - -* gnus-renumber-cache - to renumber the cache using "low" numbers. - -* record topic changes in the dribble buffer. - -* `nnfolder-generate-active-file' should look at the folders it - finds and generate proper active ranges. - -* nneething-look-in-files-for-article-heads variable to control - whether nneething should sniff all files in the directories. - -* gnus-fetch-article - start Gnus, enter group, display article - -* gnus-dont-move-articles-to-same-group variable when respooling. - -* when messages are crossposted between several auto-expirable - groups, articles aren't properly marked as expirable. - -* nneething should allow deletion/moving. - -* TAB on the last button should go to the first button. - -* if the car of an element in `mail-split-methods' is a function, - and the function returns non-nil, use that as the name of the - group(s) to save mail in. - -* command for listing all score files that have been applied. - -* a command in the article buffer to return to `summary' config. - -* `gnus-always-post-using-current-server' - variable to override - `C-c C-c' when posting. - -* nnmail-group-spool-alist - says where each group should use as a - spool file. - -* when an article is crossposted to an auto-expirable group, the - article should be marker as expirable. - -* article mode command/menu for "send region as URL to browser". - -* on errors, jump to info nodes that explain the error. For - instance, on invalid From headers, or on error messages from the - nntp server. - -* when gathering threads, make the article that has no "Re: " the - parent. Also consult Date headers. - -* a token in splits to call shrink-window-if-larger-than-buffer - -* `1 0 A M' to do matches on the active hashtb. - -* duplicates - command to remove Gnus-Warning header, use the read - Message-ID, delete the "original". - -* when replying to several messages at once, put the "other" - message-ids into a See-Also header. - -* support setext: URL:http://www.bsdi.com/setext/ - -* support ProleText: - - -* when browsing a foreign server, the groups that are already - subscribed should be listed as such and not as "K". - - [done] - -* generate font names dynamically. - -* score file mode auto-alist. - -* allow nndoc to change/add/delete things from documents. Implement - methods for each format for adding an article to the document. - -* `gnus-fetch-old-headers' `all' value to incorporate absolutely - all headers there is. - -* function like `|', but concatenate all marked articles and pipe - them to the process. - -* cache the list of killed (or active) groups in a separate file. - Update the file whenever we read the active file or the list of - killed groups in the .eld file reaches a certain length. - -* function for starting to edit a file to put into the current mail - group. - -* score-find-trace should display the total score of the article. - -* "ghettozie" - score on Xref header and nix it out after using it - to avoid marking as read in other groups it has been crossposted - to. - -* look at procmail splitting. The backends should create the - groups automatically if a spool file exists for that group. - -* function for backends to register themselves with Gnus. - -* when replying to several process-marked articles, have all the - From end up in Cc headers? Variable to toggle. - -* command to delete a crossposted mail article from all groups it - has been mailed to. - -* `B c' and `B m' should be crosspost aware. - -* hide-pgp should also hide PGP public key blocks. - -* Command in the group buffer to respool process-marked groups. - -* `gnus-summary-find-matching' should accept pseudo-"headers" like - "body", "head" and "all" - -* When buttifying things, all white space (including - newlines) should be ignored. - -* Process-marking all groups in a topic should process-mark groups - in subtopics as well. - -* Add non-native groups to the list of killed groups when killing - them. - -* nntp-suggest-kewl-config to probe the nntp server and suggest - variable settings. - -* add edit and forward secondary marks. - -* nnml shouldn't visit its .overview files. - -* allow customizing sorting within gathered threads. - -* `B q' shouldn't select the current article. - -* nnmbox should support a newsgroups file for descriptions. - -* allow fetching mail from several pop servers. - - [done] - -* Be able to specify whether the saving commands save the original - or the formatted article. - -* a command to reparent with the child process-marked (cf. `T ^'.). - -* I think the possibility to send a password with nntp-open-rlogin - should be a feature in Red Gnus. - -* The `Z n' command should be possible to execute from a mouse - click. - -* more limiting functions - date, etc. - -* be able to limit on a random header; on body; using reverse - matches. - -* a group parameter (`absofucking-total-expiry') that will make - Gnus expire even unread articles. - -* a command to print the article buffer as postscript. - -* variable to disable password fetching when opening by - nntp-open-telnet. - -* manual: more example servers - nntp with rlogin, telnet - -* checking for bogus groups should clean topic alists as well. - -* canceling articles in foreign groups. - -* article number in folded topics isn't properly updated by Xref - handling. - -* Movement in the group buffer to the next unread group should go - to the next closed topic with unread messages if no group can be - found. - -* Extensive info pages generated on the fly with help everywhere - - in the "*Gnus edit*" buffers, for instance. - -* Topic movement commands - like thread movement. Up, down, - forward, next. - -* a way to tick/mark as read Gcc'd articles. - - [done, (setq gnus-inews-mark-gcc-as-read t)] - -* a way to say that all groups within a specific topic comes from a - particular server? Hm. - -* `gnus-article-fill-if-long-lines' - a function to fill the - article buffer if there are any looong lines there. - -* `T h' should jump to the parent topic and fold it. - -* a command to create an ephemeral nndoc group out of a file, and - then splitting it/moving it to some other group/backend. - -* a group parameter for nnkiboze groups that says that all kibozed - articles should be entered into the cache. - -* It should also probably be possible to delimit what - `gnus-jog-cache' does - for instance, work on just some groups, or - on some levels, and entering just articles that have a score - higher than a certain number. - -* nnfolder should append to the folder instead of re-writing the - entire folder to disk when accepting new messages. - -* allow all backends to do the proper thing with .gz files. - -* a backend for reading collections of babyl files nnbabylfolder? - -* a command for making the native groups into foreign groups. - -* server mode command for clearing read marks from all groups from - a server. - -* when following up multiple articles, include all To, Cc, etc - headers from all articles. - -* a command for deciding what the total score of the current thread - is. Also a way to highlight based on this. - -* command to show and edit group scores - -* a gnus-tree-minimize-horizontal to minimize tree buffers - horizontally. - -* command to generate nnml overview file for one group. - -* `C-u C-u a' - prompt for many crossposted groups. - -* keep track of which mail groups have received new articles (in - this session). Be able to generate a report and perhaps do some - marking in the group buffer. - -* gnus-build-sparse-threads to a number - build only sparse threads - that are of that length. - -* have nnmh respect mh's unseen sequence in .mh_profile. - -* cache the newsgroups descriptions locally. - -* asynchronous posting under nntp. - -* be able to control word adaptive scoring from the score files. - -* a variable to make `C-c C-c' post using the "current" select - method. - -* `limit-exclude-low-scored-articles'. - -* if `gnus-summary-show-thread' is a number, hide threads that have - a score lower than this number. - -* split newsgroup subscription variable up into "order" and - "method". - -* buttonize ange-ftp file names. - -* a command to make a duplicate copy of the current article so that - each copy can be edited separately. - -* nnweb should allow fetching from the local nntp server. - -* record the sorting done in the summary buffer so that it can be - repeated when limiting/regenerating the buffer. - -* nnml-generate-nov-databses should generate for all nnml servers. - -* when the user does commands in the group buffer, check the - modification time of the .newsrc.eld file and use - ask-user-about-supersession-threat. Also warn when trying to save - .newsrc.eld and it has changed. - -* M-g on a topic will display all groups with 0 articles in the - topic. - -* command to remove all topic stuff. - -* allow exploding incoming digests when reading incoming mail and - splitting the resulting digests. - -* nnsoup shouldn't set the `message-' variables. - -* command to nix out all nnoo state information. - -* nnmail-process-alist that calls functions if group names matches - an alist - before saving. - -* use buffer-invisibility-spec everywhere for hiding text. - -* variable to activate each group before entering them to get the - (new) number of articles. `gnus-activate-before-entering'. - -* command to fetch a Message-ID from any buffer, even starting Gnus - first if necessary. - -* when posting and checking whether a group exists or not, just ask - the nntp server instead of relying on the active hashtb. - -* buttonize the output of `C-c C-a' in an apropos-like way. - -* `G p' should understand process/prefix, and allow editing of - several groups at once. - -* command to create an ephemeral nnvirtual group that matches some - regexp(s). - -* nndoc should understand "Content-Type: message/rfc822" forwarded - messages. - - [done] - -* it should be possible to score "thread" on the From header. - -* hitting RET on a "gnus-uu-archive" pseudo article should unpack - it. - -* `B i' should display the article at once in the summary buffer. - -* remove the "*" mark at once when unticking an article. - -* `M-s' should highlight the matching text. - -* when checking for duplicated mails, use Resent-Message-ID if - present. - -* killing and yanking groups in topics should be better. If - killing one copy of a group that exists in multiple topics, only - that copy should be removed. Yanking should insert the copy, and - yanking topics should be possible to be interspersed with the - other yankings. - -* command for enter a group just to read the cached articles. A - way to say "ignore the nntp connection; just read from the cache." - -* `X u' should decode base64 articles. - - [`X m' does so.] - -* a way to hide all "inner" cited text, leaving just the most - recently cited text. - -* nnvirtual should be asynchronous. - -* after editing an article, gnus-original-article-buffer should be - invalidated. - -* there should probably be a way to make Gnus not connect to the - server and just read the articles in the server - -* allow a `set-default' (or something) to change the default value - of nnoo variables. - -* a command to import group infos from a .newsrc.eld file. - -* groups from secondary servers have the entire select method - listed in each group info. - -* a command for just switching from the summary buffer to the group - buffer. - -* a way to specify that some incoming mail washing functions should - only be applied to some groups. - -* Message `C-f C-t' should ask the user whether to heed - mail-copies-to: never. - -* new group parameter - `post-to-server' that says to post using - the current server. Also a variable to do the same. - -* the slave dribble files should auto-save to the slave file names. - -* a group parameter that says what articles to display on group - entry, based on article marks. - -* a way to visually distinguish slave Gnusae from masters. (Whip - instead of normal logo?) - -* Use DJ Bernstein "From " quoting/dequoting, where applicable. - -* Why is hide-citation-maybe and hide-citation different? Also - clear up info. - -* group user-defined meta-parameters. - - From: John Griffith - -* I like the option for trying to retrieve the FAQ for a group and - I was thinking it would be great if for those newsgroups that had - archives you could also try to read the archive for that group. - Part of the problem is that archives are spread all over the net, - unlike FAQs. What would be best I suppose is to find the one - closest to your site. - - In any case, there is a list of general news group archives at - ftp://ftp.neosoft.com/pub/users/claird/news.lists/newsgroup_archives.html - -* From: Jason L Tibbitts III - (add-hook 'gnus-select-group-hook - (lambda () - (gnus-group-add-parameter group - (cons 'gnus-group-date-last-entered (list (current-time-string)))))) - - (defun gnus-user-format-function-d (headers) - "Return the date the group was last read." - (cond ((car (gnus-group-get-parameter gnus-tmp-group 'gnus-group-date-last-entered))) - (t ""))) - -* tanken var at n,Ae(Br du bruker `gnus-startup-file' som prefix (FOO) - til ,Ae(B lete opp en fil FOO-SERVER, FOO-SERVER.el, FOO-SERVER.eld, - kan du la den v,Af(Bre en liste hvor du bruker hvert element i listen - som FOO, istedet. da kunne man hatt forskjellige serveres - startup-filer forskjellige steder. - -* LMI> Well, nnbabyl could alter the group info to heed labels like - LMI> answered and read, I guess. - - It could also keep them updated (the same for the Status: header of - unix mbox files). - - They could be used like this: - - `M l RET' add label to current message. - `M u RET' remove label from current message. - `/ l RET' limit summary buffer according to . - - would be a boolean expression on the labels, e.g. - - `/ l bug & !fixed RET' - - would show all the messages which are labeled `bug' but not labeled - `fixed'. - - One could also imagine the labels being used for highlighting, or - affect the summary line format. - -* Sender: abraham@dina.kvl.dk - - I'd like a gnus-find-file which work like find file, except that it - would recognize things that looks like messages or folders: - - - If it is a directory containing numbered files, create an nndir - summary buffer. - - - For other directories, create a nneething summary buffer. - - - For files matching "\\`From ", create a nndoc/mbox summary. - - - For files matching "\\`BABYL OPTIONS:", create a nndoc/baby - summary. - - - For files matching "\\`[^ \t\n]+:", create an *Article* buffer. - - - For other files, just find them normally. - - I'd like `nneething' to use this function, so it would work on a - directory potentially containing mboxes or babyl files. - -* Please send a mail to bwarsaw@cnri.reston.va.us (Barry A. Warsaw) - and tell him what you are doing. - -* Currently, I get prompted: - - decend into sci? - type y decend into sci.something ? - type n - decend into ucd? - - The problem above is that since there is really only one - subsection of science, shouldn't it prompt you for only descending - sci.something? If there was a sci.somethingelse group or section, - then it should prompt for sci? first the sci.something? then - sci.somethingelse?... - -* Ja, det burde v,Af(Bre en m,Ae(Bte ,Ae(B si slikt. Kanskje en ny variabel? - `gnus-use-few-score-files'? S,Ae(B kunne score-regler legges til den - "mest" lokale score-fila. F. eks. ville no-gruppene betjenes av - "no.all.SCORE", osv. - -* What i want is for Gnus to treat any sequence or combination of - the following as a single spoiler warning and hide it all, - replacing it with a "Next Page" button: - - ^L's - - more than n blank lines - - more than m identical lines (which should be replaced with button - to show them) - - any whitespace surrounding any of the above - -* Well, we could allow a new value to `gnus-thread-ignore-subject' - - `spaces', or something. (We could even default to that.) And then - subjects that differ in white space only could be considered the - "same" subject for threading purposes. - -* Modes to preprocess the contents (e.g. jka-compr) use the second - form "(REGEXP FUNCTION NON-NIL)" while ordinary modes (e.g. tex) - use the first form "(REGEXP . FUNCTION)", so you could use it to - distinguish between those two types of modes. (auto-modes-alist, - insert-file-contents-literally.) - -* Under XEmacs - do funny article marks: tick - thumb tack killed - - skull soup - bowl of soup score below - dim light bulb score over - - bright light bulb - -* Yes. I think the algorithm is as follows: - - Group-mode - - show-list-of-articles-in-group - if (key-pressed == SPACE) - if (no-more-articles-in-group-to-select) - if (articles-selected) - start-reading-selected-articles; - junk-unread-articles; - next-group; - else - show-next-page; - - else if (key-pressed = '.') - if (consolidated-menus) # same as hide-thread in Gnus - select-thread-under-cursor; - else - select-article-under-cursor; - - - Article-mode - if (key-pressed == SPACE) - if (more-pages-in-article) - next-page; - else if (more-selected-articles-to-read) - next-article; - else - next-group; - -* My precise need here would have been to limit files to Incoming*. - One could think of some `nneething-only-files' variable, but I - guess it would have been unacceptable if one was using many - unrelated such nneething groups. - - A more useful approach would be to, in response to the `G D' - prompt, be allowed to say something like: `~/.mail/Incoming*', - somewhat limiting the top-level directory only (in case - directories would be matched by the wildcard expression). - -* It would be nice if it also handled - - - - which should correspond to `B nntp RET sunsite.auc.dk' in *Group*. - - [done] - -* Take a look at w3-menu.el in the Emacs-W3 distribution - this - works out really well. Each menu is 'named' by a symbol that - would be on a gnus-*-menus (where * would be whatever, but at - least group, summary, and article versions) variable. - - So for gnus-summary-menus, I would set to '(sort mark dispose ...) - - A value of '1' would just put _all_ the menus in a single 'GNUS' - menu in the main menubar. This approach works really well for - Emacs-W3 and VM. - -* nndoc should take care to create unique Message-IDs for all its - articles. - -* gnus-score-followup-article only works when you have a summary - buffer active. Make it work when posting from the group buffer as - well. (message-sent-hook). - -* rewrite gnus-demon to use run-with-idle-timers. - -* * Enhancements to Gnus: - - Add two commands: - - * gnus-servers (gnus-start-server-buffer?)-enters Gnus and goes - straight to the server buffer, without opening any connections to - servers first. - - * gnus-server-read-server-newsrc-produces a buffer very similar to - the group buffer, but with only groups from that server listed; - quitting this buffer returns to the server buffer. - -* add a command to check the integrity of an nnfolder folder - go - through the article numbers and see that there are no duplicates, - and stuff. - -* `unsmileyfy-buffer' to undo smileification. - -* a command to give all relevant info on an article, including all - secondary marks. - -* when doing `-request-accept-article', the backends should do the - nnmail duplicate checking. - -* allow `message-signature-file' to be a function to return the - value of the signature file. - -* In addition, I would love it if I could configure message-tab so - that it could call `bbdb-complete-name' in other headers. So, - some sort of interface like - - (setq message-tab-alist '((message-header-regexp - message-expand-group) ("^\\(To\\|[cC]c\\|[bB]cc\\)" - bbdb-complete-name))) - - then you could run the relevant function to complete the - information in the header - -* cache the newsgroups file locally to avoid reloading it all the - time. - -* a command to import a buffer into a group. - -* nnweb should allow fetching by Message-ID from servers. - -* point in the article buffer doesn't always go to the beginning of - the buffer when selecting new articles. - -* a command to process mark all unread articles. - -* `gnus-gather-threads-by-references-and-subject' - first do - gathering by references, and then go through the dummy roots and - do more gathering by subject. - -* gnus-uu-mark-in-numerical-order - process mark articles in - article numerical order. - -* (gnus-thread-total-score (gnus-id-to-thread (mail-header-id - (gnus-summary-article-header)))) bind to a key. - -* sorting by score is wrong when using sparse threads. - -* a command to fetch an arbitrary article - without having to be in - the summary buffer. - -* a new nncvs backend. Each group would show an article, using - version branches as threading, checkin date as the date, etc. - -* http://www.dejanews.com/forms/dnsetfilter_exp.html ? This filter - allows one to construct advance queries on the Dejanews database - such as specifying start and end dates, subject, author, and/or - newsgroup name. - -* new Date header scoring type - older, newer - -* use the summary toolbar in the article buffer. - -* a command to fetch all articles that are less than X days old. - -* in pick mode, `q' should save the list of selected articles in the - group info. The next time the group is selected, these articles - will automatically get the process mark. - -* Isn't it possible to (also?) allow M-^ to automatically try the - default server if it fails on the current server? (controlled by a - user variable, (nil, t, 'ask)). - -* make it possible to cancel articles using the select method for - the current group. - -* `gnus-summary-select-article-on-entry' or something. It'll - default to t and will select whatever article decided by - `gnus-auto-select-first'. - -* a new variable to control which selection commands should be - unselecting. `first', `best', `next', `prev', `next-unread', - `prev-unread' are candidates. - -* be able to select groups that have no articles in them to be able - to post in them (using the current select method). - -* be able to post via DejaNews. - -* `x' should retain any sortings that have been performed. - -* allow the user to specify the precedence of the secondary marks. - Also allow them to be displayed separately. - -* gnus-summary-save-in-pipe should concatenate the results from the - processes when doing a process marked pipe. - -* a new match type, like Followup, but which adds Thread matches on - all articles that match a certain From header. - -* a function that can be read from kill-emacs-query-functions to - offer saving living summary buffers. - -* a function for selecting a particular group which will contain - the articles listed in a list of article numbers/id's. - -* a battery of character translation functions to translate common - Mac, MS (etc) characters into ISO 8859-1. - - (defun article-fix-m$word () - "Fix M$Word smartquotes in an article." - (interactive) - (save-excursion - (let ((buffer-read-only nil)) - (goto-char (point-min)) - (while (search-forward "\221" nil t) - (replace-match "`" t t)) - (goto-char (point-min)) - (while (search-forward "\222" nil t) - (replace-match "'" t t)) - (goto-char (point-min)) - (while (search-forward "\223" nil t) - (replace-match "\"" t t)) - (goto-char (point-min)) - (while (search-forward "\224" nil t) - (replace-match "\"" t t))))) - - [done] - -* (add-hook 'gnus-exit-query-functions - '(lambda () - (if (and (file-exists-p nnmail-spool-file) - (> (nnheader-file-size nnmail-spool-file) 0)) - (yes-or-no-p "New mail has arrived. Quit Gnus anyways? ") - (y-or-n-p "Are you sure you want to quit Gnus? ")))) - -* allow message-default-headers to be a function. - -* new Date score match types - < > = (etc) that take floating point - numbers and match on the age of the article. - -* > > > If so, I've got one gripe: It seems that when I fire up gnus 5.2.25 - > > > under xemacs-19.14, it's creating a new frame, but is erasing the - > > > buffer in the frame that it was called from =:-O - > - > > Hm. How do you start up Gnus? From the toolbar or with - > > `M-x gnus-other-frame'? - > - > I normally start it up from the toolbar; at - > least that's the way I've caught it doing the - > deed before. - -* all commands that react to the process mark should push the - current process mark set onto the stack. - -* gnus-article-hide-pgp Selv ville jeg nok ha valgt ,Ae(B slette den - dersom teksten matcher - "\\(This\s+\\)?[^ ]+ has been automatically signed by" - og det er maks hundre tegn mellom match-end og ---linja. Men -det- - er min type heuristikk og langt fra alles. - -* `gnus-subscribe-sorted' - insert new groups where they would have - been sorted to if `gnus-group-sort-function' were run. - -* gnus-(group,summary)-highlight should respect any `face' text - props set on the lines. - -* use run-with-idle-timer for gnus-demon instead of the home-brewed - stuff for better reliability. - -* add a way to select which NoCeM type to apply - spam, troll, etc. - -* nndraft-request-group should tally auto-save files. - -* implement nntp-retry-on-break and nntp-command-timeout. - -* gnus-article-highlight-limit that says when not to highlight - (long) articles. - -* (nnoo-set SERVER VARIABLE VALUE) - - [done] - -* nn*-spool-methods - -* interrupitng agent fetching of articles should save articles. - -* command to open a digest group, and copy all the articles there - to the current group. - -* a variable to disable article body highlights if there's more than - X characters in the body. - -* handle 480/381 authinfo requests separately. - -* include the texi/dir file in the distribution. - -* format spec to "tab" to a position. - -* Move all prompting to the new `M-n' default style. - -* command to display all dormant articles. - -* gnus-auto-select-next makeover - list of things it should do. - -* a score match type that adds scores matching on From if From has - replied to something someone else has said. - -* Read Netscape discussion groups: - snews://secnews.netscape.com/netscape.communicator.unix - -* One command to edit the original version if an article, and one to - edit the displayed version. - -* `T v' - make all process-marked articles the children of the - current article. - -* Switch from initial text to the new default text mechanism. - -* How about making it possible to expire local articles? Will it be - possible to make various constraints on when an article can be - expired, e.g. (read), (age > 14 days), or the more interesting - (read & age > 14 days)? - -* New limit command--limit to articles that have a certain string in - the head or body. - -* Allow breaking lengthy NNTP commands. - -* gnus-article-highlight-limit, to disable highlighting in big - articles. - -* Editing an article should put the article to be edited in a - special, unique buffer. - -* A command to send a mail to the admin-address group param. - -* A Date scoring type that will match if the article is less than a - certain number of days old. - -* New spec: %~(tab 56) to put point on column 56 - -* Allow Gnus Agent scoring to use normal score files. - -* Rething the Agent active file thing. `M-g' doesn't update the - active file, for instance. - -* With dummy roots, `^' and then selecing the first article in any - other dummy thread will make Gnus highlight the dummy root instead - of the first article. - -* Propagate all group properties (marks, article numbers, etc) up to - the topics for displaying. - -* `n' in the group buffer with topics should go to the next group - with unread articles, even if that group is hidden in a topic. - -* gnus-posting-styles doesn't work in drafts. - -* gnus-summary-limit-include-cached is slow when there are many - articles in the cache, since it regenerates big parts of the - summary buffer for each article. - -* Implement gnus-batch-brew-soup. - -* Group parameters and summary commands for un/subscribing to mailing - lists. - -* Introduce nnmail-home-directory. - -* gnus-fetch-group and friends should exit Gnus when the user exits - the group. - -* The jingle is only played on the second invocation of Gnus. - -* Bouncing articles should do MIME. - - [done] - -* Crossposted articles should "inherit" the % or mark from the other - groups it has been crossposted to, or something. (Agent.) - -* If point is on a group that appears multiple times in topics, and - you press `l', point will move to the first instance of the group. - -* A spec for the group line format to display the number of - agent-downloaded articles in the group. - -* Some nntp servers never respond when posting, so there should be a - timeout for all commands. - -* When stading on a topic line and `t'-ing, point goes to the last - line. It should go somewhere else. - -* I'm having trouble accessing a newsgroup with a "+" in its name - with Gnus. There is a new newsgroup on msnews.microsoft.com named - "microsoft.public.multimedia.directx.html+time" that I'm trying to - access as - "nntp+msnews.microsoft.com:microsoft.public.multimedia.directx.html+time" - but it gives an error that it cant access the group. - - Is the "+" character illegal in newsgroup names? Is there any way - in Gnus to work around this? (gnus 5.6.45 - XEmacs 20.4) - - [It works in 5.8.8.] - -* When `#F', do: - - Subject: Answer to your mails 01.01.1999-01.05.1999 - --text follows this line-- - Sorry I killfiled you... - - Under the subject "foo", you wrote on 01.01.1999: - > bar - Under the subject "foo1", you wrote on 01.01.1999: - > bar 1 - -* Allow "orphan" scores in the Agent scoring. - - [done?] - -* - Edit article's summary line. - - End edit - - Sort lines in buffer by subject - - --> the old subject line appears in Summary buffer, not the one that was - just changed to. - -* Remove list identifiers from the subject in the summary when doing - `^' and the like. - -* Have the Agent write out articles, one by one, as it retrieves - them, to avoid having to re-fetch them all if Emacs should crash - while fetching. - -* Be able to forward groups of messages as MIME digests. - - [done] - -* nnweb should include the "get whole article" article when getting - articles. - -* When I type W W c (gnus-article-hide-citation) in the summary - buffer, the citations are revealed, but the [+] buttons don't turn - into [-] buttons. (If I click on one of the [+] buttons, it does - turn into a [-] button.) - - [fixed] - -* Perhaps there should be a command to "attach" a buffer of comments - to a message? That is, `B WHATEVER', you're popped into a buffer, - write something, end with `C-c C-c', and then the thing you've - written gets to be the child of the message you're commenting. - -* Handle external-body parts. - - [done for some access types] - -* When renaming a group name, nnmail-split-history does not get the - group name renamed. - -* Allow mail splitting on bodies when using advanced mail splitting. - - (body "whatever.text") - -* Be able to run `J u' from summary buffers. - - [Done] - -* Solve the halting problem. - - -;; Local Variables: -;; mode: outline -;; coding: iso-2022-7bit -;; paragraph-separate: "[ ]*$" -;; End: diff --git a/xemacs-packages/gnus/lisp/ChangeLog.1.upstream b/xemacs-packages/gnus/lisp/ChangeLog.1.upstream deleted file mode 100644 index e859aada..00000000 --- a/xemacs-packages/gnus/lisp/ChangeLog.1.upstream +++ /dev/null @@ -1,10108 +0,0 @@ -2000-10-27 Jason Rumney - - * gnus-art.el (gnus-signature-face): Use italic on any frame that - supports it. - -2000-10-27 14:19:53 ShengHuo ZHU - - * gnus-mlspl.el: Require cl when compiling. - * messagexmas.el: Ditto. - * mm-util.el: Ditto. - * rfc2047.el: Ditto. - * rfc2231.el: Ditto. - * smiley-ems.el: Ditto. - * uudecode.el: Ditto. - - * smiley-ems.el (smiley-region): Use mapcar. - -2000-10-27 Stefan Monnier - - * ietf-drums.el: Require cl when compiling. - -2000-10-27 Dave Love - - * mm-decode.el (mm-valid-and-fit-image-p): Don't test - window-system here. - - * gnus-art.el (gnus-article-x-face-command): Check - gnus-article-compface-xbm. - (gnus-treat-display-xface): Check for uncompface. - - * nnheader.el (nnheader-translate-file-chars): Only kludge things - under Doze with XEmacs. - -2000-10-26 Simon Josefsson - - * mail-source.el (mail-sources): IMAP predicate is a string. - (mail-sources): Add default values for IMAP mailbox, predicate and - fetchflag. - -2000-10-26 Dave Love - - * flow-fill.el: Require cl when compiling. - - * mail-source.el: Require imap when compiling and defvar - display-time-mail-function. Require mm-util. - (nnheader-cancel-timer): Autoload. - (mail-source-imap-authenticators, mail-source-imap-streams): New - variables. - (mail-sources): Use them. - -2000-10-25 20:13:02 ShengHuo ZHU - - * mm-decode.el (mm-viewer-completion-map): New. - (mm-interactively-view-part): Use it. - -2000-10-25 18:51:12 ShengHuo ZHU - - * rfc2047.el (rfc2047-q-encode-region): Don't break if a QP-word - could be fitted in one line. - -2000-10-25 Dirk Meyer - - * gnus-demon.el (gnus-demon-time-to-step): theHour was set to - seconds instead of hour. - -2000-10-25 Per Abrahamsen - - * mail-source.el (mail-sources): Better `:type'. - -2000-10-24 18:31:29 ShengHuo ZHU - - * gnus-art.el (gnus-request-article-this-buffer): - gnus-refer-article-method might be a single method. - * gnus-sum.el (gnus-refer-article-methods): The second could be - a named method. - -2000-10-23 Simon Josefsson - - * flow-fill.el (fill-flowed): Don't flow "-- " lines. - (fill-flowed): Make "quote-depth wins" rule work when first line - is at level 0. - -2000-10-21 11:23:21 ShengHuo ZHU - - * mm-util.el (mm-multibyte-p): Test (featurep 'xemacs). - -2000-10-21 10:54:57 ShengHuo ZHU - - * gnus-art.el (gnus-article-mime-total-parts): New function. - (gnus-mm-display-part): Use it. - (gnus-mime-display-single): Ditto. - (gnus-mime-display-alternative): Ditto. - -2000-10-21 09:38:27 ShengHuo ZHU - - * mailcap.el (mailcap-parse-mailcaps): Don't use parse-colon-path, - because they are files, not directories. - (mailcap-parse-mimetypes): Ditto. - -2000-10-20 19:55:59 ShengHuo ZHU - - * gnus-art.el (gnus-mime-inline-part): Check validity of charset. - -2000-10-18 Dave Love - - * mail-source.el (mm-util): Require. - (defvar): Use rmail-spool-directory unconditionally. - - * gnus-nocem.el (gnus-nocem-issuers): Update. - (gnus-nocem-check-from): New option. - (gnus-nocem-scan-groups): Use it. - (gnus-nocem-check-article): Bind gnus-newsgroup-name. - -2000-10-18 Miles Bader - - * gnus-nocem.el (gnus-nocem-check-article-limit): New variable. - (gnus-nocem-scan-groups): Obey `gnus-nocem-check-article-limit'. - -2000-10-18 Simon Josefsson - - * nnheader.el (nnheader-parse-head): Try both "from:" and "from: ". - - * gnus-sum.el (gnus-get-newsgroup-headers): Ditto. - -2000-10-17 Simon Josefsson - - * gnus-sum.el (gnus-get-newsgroup-headers): Search for "from:" - instead of "from: " for rfc822 compliance. - - * gnus-uu.el (gnus-uu-digest-mail-forward): Ditto. Insert SPC. - - * nnheader.el (nnheader-parse-head): Ditto. - -2000-10-13 Kai Gro,A_(Bjohann - - * mail-source.el (mail-source-keyword-map): Use - `rmail-spool-directory' as a default directory for the `file' - source, if the variable is defined. Fall back to hardcoded - "/usr/spool/mail/", as before. Suggestion by Steven E. Harris - . - -2000-10-13 12:01:15 ShengHuo ZHU - - * message.el (message-send-mail-partially): Replace the header - delimiter with a blank line. - -2000-10-13 Kai Gro,A_(Bjohann - - * gnus-sum.el (gnus-get-split-value): Use first match only (Ed L - Cashin ). - -2000-10-13 10:52:00 ShengHuo ZHU - - * gnus-ems.el (gnus-article-compface-xbm): Ignore errors. - -2000-10-11 John Wiegley - - * gnus-topic.el (gnus-topic-mode): Use `setq' to clear - `gnus-group-change-level-function', instead of `remove-hook', - because it's not a hook! - - * gnus-mlspl.el (gnus-group-split-update): Check the value of - `nnmail-crosspost', and use it to set the `no-crosspost' - argument when calling `gnus-group-split-fancy'. Otherwise, it - assumes that cross-posting is always OK, no matter what - `nmail-crosspost' is set to. - (gnus-group-split-fancy): The argument order in the - second-to-last `push' call was wrong, but since `no-crosspost' - was always nil, it was never being triggered. - - * gnus-art.el (gnus-treat-hide-citation-maybe): Added this - variable to correspond with `gnus-article-hide-citation-maybe'. - (gnus-treatment-function-alist): Added entry for the above - correlation. - -2000-10-12 08:26:30 ShengHuo ZHU - - * mm-util.el (mm-with-unibyte-current-buffer): Revert to old. - (mm-with-unibyte-current-buffer-mule4): New function. - * qp.el (quoted-printable-encode-region): Use it. - * rfc2047.el (rfc2047-decode): Ditto. - * webmail.el (webmail-init): Revert to use mm-disable-multibyte. - -2000-10-10 08:44:13 ShengHuo ZHU - - * rfc2047.el (rfc2047-fold-region): "=?=" is not a break point. - -2000-10-10 00:00:28 ShengHuo ZHU - - * webmail.el (webmail-init): Use mm-disable-multibyte-mule4. - -2000-10-09 22:50:05 ShengHuo ZHU - - * base64.el (base64-decode-region): Just give a message if the end - is not sane. - -2000-10-09 20:09:11 ShengHuo ZHU - - * rfc2047.el (rfc2047-encode-message-header): Move fold into - encode-region. - (rfc2047-dissect-region): Rewrite. - (rfc2047-encode-region): Rewrite. - (rfc2047-fold-region): Fold any line longer than 76. - (rfc2047-unfold-region): New function. - (rfc2047-decode-region): Use it. - (rfc2047-q-encode-region): Don't break at bob. - -2000-10-09 17:12:00 ShengHuo ZHU - - * nntp.el (nntp-open-connection): Kill process buffer when quit. - (nntp-connection-timeout): Add a note. SIGALRM is ignored in both - FSF Emacs 20 and XEmacs 21. - * gnus-agent.el (gnus-agent-fetch-session): Catch quit. - -2000-10-09 Dave Love - - * gnus-audio.el: Don't require cl. - (gnus-audio): New custom group. - (gnus-audio-inline-sound): Change to work with Emacs. - (gnus-audio-directory, gnus-audio-directory) - (gnus-audio-au-player): Customize. - (gnus-audio-play): Try external player if play-sound-file fails. - Use file-name-extension, not string-match. - - * gnus-art.el (article-de-quoted-unreadable) - (article-de-base64-unreadable): Fold search case rather than - downcasing string. Apply mm-charset-to-coding-system to arg of - quoted-printable-decode-region. - (gnus-article-dumbquotes-map): Fix dashes. - (gnus-button-mailto, gnus-button-embedded-url): Doc fix. - (gnus-button-reply): Just alias it. - -2000-10-09 Stefan Monnier - - * mm-encode.el: Require CL. At least, for `incf'. - - * nnfolder.el (nnfolder-ignore-active-file): Typos. - - * gnus-mh.el (gnus-summary-save-in-folder): Obey mh-lib-progs. - - * gnus-kill.el (gnus-kill): Typo. - -2000-10-09 Gerd Moellmann - - * smiley-ems.el (smiley-update-cache): Use `:ascent center'. - -2000-10-09 Simon Josefsson - - * nnimap.el (nnimap-group-overview-filename): Create directory for - newfile (when use long filenames is nil). Copy+delete file if - rename didn't work. - (nnimap-group-overview-filename): `rename-file' and `copy-file' - doesn't return anything useful, use ignore-errors instead. - -2000-10-08 13:05:11 ShengHuo ZHU - - * dgnushack.el (dgnushack-compile): Delete old elc files first. - -2000-10-08 10:59:13 ShengHuo ZHU - - * gnus-ems.el (gnus-kill-all-overlays): Move here. - * gnus-util.el (gnus-kill-all-overlays): Move out. - * gnus-sum.el (gnus-cache-write-active): Auto load. - * lpath.el: Shut up. - * nnweb.el (nnweb-url-retrieve-asynch): url-retrieve is - asynchronous in Exp version. - -2000-10-08 08:57:13 ShengHuo ZHU - - * gnus-art.el, gnus-ems.el, gnus-start.el: Remove gnus-xemacs. - * gnus-ems.el: Autoload smiley. - * gnus-art.el (gnus-treat-display-smileys): Default value in Emacs 21. - -2000-10-08 08:45:48 ShengHuo ZHU - - * gnus-sum.el (gnus-summary-display-article): Enable multibyte. - (gnus-summary-select-article): Don't enable multibyte here. - (gnus-summary-goto-article): Ditto. - -2000-10-08 Christoph Conrad - - * gnus-draft.el (gnus-draft-send-message): Typo. - -2000-10-08 Simon Josefsson - - * nnimap.el (nnimap-verify-uidvalidity): Delete overview file when - uid validity changes. - (nnimap-group-overview-filename): Store uidvalidity in filenames. - Rename old files into new format. - -2000-10-07 15:49:39 ShengHuo ZHU - - * mm-util.el (mm-enable-multibyte-mule4): New. - (mm-disable-multibyte-mule4): New. - * gnus-sum.el (gnus-summary-mode): Use it. - (gnus-summary-select-article): Ditto. - (gnus-summary-goto-article): Use enable multibyte. - * rfc2047.el (rfc2047-decode): Use unibyte. - -2000-10-07 15:42:59 ShengHuo ZHU - - * gnus-logic.el (gnus-advanced-string): Use "" if nil. - -2000-10-07 10:31:05 ShengHuo ZHU - - * rfc2047.el (rfc2047-q-encode-region): Better calculation of - break point. - (rfc2047-fold-region): Don't break the first non-LWSP characters. - -2000-10-07 09:18:53 ShengHuo ZHU - - * gnus.el (gnus-agent-fetching): New variable. - * gnus-agent.el (gnus-agent-with-fetch): Bind it. - * gnus-score.el (gnus-score-body): Don't score body when - agent-fetching. - (gnus-score-followup): Don't score followup either. - -2000-10-07 08:19:17 ShengHuo ZHU - - * gnus-art.el: Define dynamic variables in eval-when-compile. - * message.el (message-sending-message): New variable. - (message-send): Use it. - * gnus-draft.el (gnus-draft-send-message): Ditto. - (gnus-group-send-drafts): Ditto. - -2000-10-06 Dave Love - - * gnus-audio.el: Don't require cl. - (gnus-audio): New custom group. - (gnus-audio-inline-sound): Change to work with Emacs. - (gnus-audio-directory, gnus-audio-directory) - (gnus-audio-au-player): Customize. - (gnus-audio-play): Try external player if play-sound-file fails. - Use file-name-extension, not string-match. - -2000-10-06 17:38:03 ShengHuo ZHU - - * gnus-art.el (gnus-article-prepare): Configure it again. - -2000-10-06 15:11:07 ShengHuo ZHU - - * message.el (message-default-charset): Default value for non-Mule - Emacsen. - -2000-10-06 14:28:50 ShengHuo ZHU - - * message.el (message-alternative-emails): New. - (message-use-alternative-email-as-from): New. - (message-setup): Use them. - -2000-10-06 13:46:47 ShengHuo ZHU - - * base64.el, dgnushack.el, gnus-spec.el, messagexmas.el - * gnus-xmas.el, nnheaderxm.el, nndraft.el: Use defalias. - - * gnus-xmas.el (gnus-xmas-define): Defalias gnus-overlay-buffer, - gnus-overlay-start. - * gnus.el: Ditto. - * gnus-art.el (gnus-insert-mime-button): Use them. - -2000-10-06 10:01:08 ShengHuo ZHU - - * mm-util.el (mm-with-unibyte-current-buffer): Don't set unibyte - if eight-bit-control is a charset, e.g. Mule 5.0 in Emacs 21. - -2000-10-06 09:38:54 ShengHuo ZHU - - * qp.el (quoted-printable-encode-region): Use - mm-with-unibyte-current-buffer within narrowed region. - -2000-10-06 08:56:33 ShengHuo ZHU - - * webmail.el (webmail-type-definition): Fix my-deja open url. - -2000-10-06 Emerick Rogul - - * message.el (message-setup-fill-variables): New variable. - (message-mode): Use it. - -2000-10-05 Dave Love - - * rfc2047.el (rfc2047-fold-region): Use gnus-point-at-bol. - (rfc2047-charset-encoding-alist): Add iso-8859-1[45]. - - * binhex.el: Use defalias, not fset. - - * rfc1843.el: Require cl when compiling. - -2000-10-05 12:25:08 ShengHuo ZHU - - * gnus-agent.el (gnus-agent-fetch-group-1): Score-param could be nil. - -2000-10-05 11:43:25 ShengHuo ZHU - - * rfc2047.el (rfc2047-encode-region): Merge only if regions are - adjacent. - -2000-10-05 09:41:33 ShengHuo ZHU - - * mm-util.el (mm-multibyte-p): In XEmacs, it is (feature 'mule). - (mm-find-charset-region): Merge conditions, delete ascii. - (mm-charset-after): Rewrite. - * mm-bodies.el (mm-encode-body): Use it. - -2000-10-05 09:04:32 ShengHuo ZHU - - * webmail.el (webmail-hotmail-list): Fix. - -2000-10-05 Stefan Monnier - - * nnimap.el (require): cl. - -2000-10-04 15:24:46 ShengHuo ZHU - - * gnus-art.el (gnus-article-prepare): Configure windows before - gnus-article-prepare-display is called. Otherwise, BBDB's popup - window might be overrided. - -2000-10-04 Dave Love - - * gnus-ems.el (gnus-article-display-xface) - [gnus-article-compface-xbm]: Fix. - (gnus-x-splash): Bind width, height. - -2000-10-04 11:45:04 ShengHuo ZHU - - * gnus-art.el (gnus-mime-inline-part): Use prefix argument only - when it is called interactively. - -2000-10-03 21:20:31 ShengHuo ZHU - - * gnus-art.el (gnus-mime-action-alist): New variable. - (gnus-mime-action-on-part): Use it. - (gnus-mime-button-commands): Add command ".". - -2000-10-03 20:37:42 ShengHuo ZHU - - * gnus-art.el (gnus-mime-inline-part): Support prefix argument. - -2000-10-03 Katsumi Yamaoka - - * lpath.el: "." is in the load-path because dgnushack.el. - -2000-10-03 Bjorn Torkelsson - - * uudecode.el: xemacs cleanup (use featurep ' xemacs) - - * nnheader.el: ditto - - * mm-util.el: ditto - - * message.el: ditto - - * binhex.el: ditto - - * gnus-audio.el: removed unnecessary xemacs test - - * earcon.el: ditto - -2000-10-03 19:55:55 Lars Magne Ingebrigtsen - - * nnweb.el (nnweb-decode-entities): Work for non-character - entities. - -2000-09-26 09:20:08 Lars Magne Ingebrigtsen - - * gnus.el: Message the quit parts. - -2000-10-03 08:08:29 ShengHuo ZHU - - * mail-source.el (mail-source-fetch-maildir): Don't insert - newlines. - -2000-10-02 20:14:27 ShengHuo ZHU - - * dgnushack.el (dgnushack-compile): Don't compile dgnushack.el, - lpath.el. Don't compile base64.el if there is builtin base64. - -2000-10-02 Bj,Av(Brn Torkelsson - - * base64.el (Repository): Use featurep for XEmacs test. - -2000-10-02 17:38:12 ShengHuo ZHU - - * nntp.el (nntp-retrieve-data): Don't ignore quit. - -2000-10-02 14:43:13 ShengHuo ZHU - - * gnus-art.el (gnus-article-banner-alist): New variable. - (article-strip-banner): Use it. - * gnus-cus.el (gnus-group-parameters): Allow symbol. - -2000-10-02 Dave Love - - * smiley-ems.el: New file. - - * gnus-ems.el (gnus-smiley-display): Autoload. - (mouse-set-point, set-face-foreground, set-face-background) - (x-popup-menu): Don't clobber these. - (gnus-article-compface-xbm): New variable. - (gnus-article-display-xface): Move graphic test. Use unibyte. - Obey gnus-article-compface-xbm. Use pbm, not xbm. - - * mml.el (require): Fix typo. - (mml-parse-1): Modify unknown encoding prompt. - - * mail-source.el (mail-sources): Revert to nil. - - * nnmail.el (nnmail-spool-file): Revert previous change. - - * gnus.el: Don't require custom, message. - (gnus-message-archive-method): Wrap initializer in progn and - require message here. - -2000-10-02 Gerd Moellmann - - * gnus.el (gnus-mode-line-buffer-identification) [Emacs]: Change - image's :ascent to 80. That gives a mode-line which is approx. - as tall as the normal one. - -2000-10-02 08:04:48 ShengHuo ZHU - - * webmail.el (webmail-hotmail-list): Fix. - -2000-10-01 20:55:53 ShengHuo ZHU - - Don't postpone GCC if none of GCC methods is agent-covered. This - fix presumes that the post-method must be agent-covered if any Gcc - method is agent-covered. - - * gnus-msg.el (gnus-inews-group-method): New function. - (gnus-inews-do-gcc): Use it. - * gnus-agent.el (gnus-agent-any-covered-gcc): New function. - (gnus-agent-possibly-save-gcc): Use it. - (gnus-agent-possibly-do-gcc): Ditto. - -2000-10-01 17:08:50 ShengHuo ZHU - - * mailcap.el (mailcap-mime-types): Use mailcap-mime-data. - * mml.el (mml-minibuffer-read-type): Use mailcap-mime-types. - -2000-10-01 13:07:21 ShengHuo ZHU - - * webmail.el (webmail-netscape-open, webmail-hotmail-article, - webmail-hotmail-list): Update. - -2000-10-01 08:36:09 ShengHuo ZHU - - * mail-source.el (mail-source-report-new-mail): Use - nnheader-cancel-timer. - -2000-10-01 08:35:38 ShengHuo ZHU - - * lpath.el (overlay-*): Shut up. - * dgnushack.el: Two implementations of smiley. - -2000-10-01 08:32:42 ShengHuo ZHU - - * gnus-ml.el: Usage. - (gnus-mailing-list-archive, gnus-mailing-list-owner, - gnus-mailing-list-post, gnus-mailing-list-unsubscribe, - gnus-mailing-list-subscribe, gnus-mailing-list-help): Bind list-*. - (gnus-mailing-list-menu): Define it. - (turn-on-gnus-mailing-list-mode, gnus-mailing-list-mode): Autoload. - - * gnus-xmas.el (gnus-xmas-mailing-list-menu-add): Move here. - -2000-09-30 18:52:51 ShengHuo ZHU - - * webmail.el (webmail-my-deja-*): Rewrite. - -2000-09-30 Simon Josefsson - - * nnimap.el (nnimap-request-accept-article): Remove \n's from - From_ lines. - -2000-08-05 Simon Josefsson - - Make GCC to remote groups work when unplugged - (postpone GCC until message is actually sent). - - * gnus-draft.el (gnus-draft-send): Call `gnus-agent-restore-gcc'. - - * gnus-agent.el (gnus-agent-possibly-do-gcc): - (gnus-agent-restore-gcc): - (gnus-agent-possibly-save-gcc): New functions. - - * gnus-msg.el (gnus-inews-add-send-actions): Use - `gnus-agent-possibly-do-gcc' if Agentized. - (gnus-inews-add-send-actions): Add `gnus-agent-possibly-save-gcc' - to `message-header-hook'. - - * gnus.el (gnus-agent-gcc-header): New variable. - -2000-07-13 Simon Josefsson - - Asks the user to synch flags with server when you plug in. - - * gnus-agent.el (gnus-agent-synchronize-flags): New variable. - (gnus-agent-possibly-synchronize-flags-server): New function, use it. - (gnus-agent-toggle-plugged): Call it. - (gnus-agent-synchronize-flags): Renamed from `gnus-agent-synchronize'. - (gnus-agent-group-mode-map): `g-a-s' -> `g-a-s-flags'. - (gnus-agent-possibly-synchronize-flags): New function. - (gnus-agent-possibly-synchronize-flags-server): New function. - -2000-09-30 Simon Josefsson - - * starttls.el: New file, by Daiki Ueno. - -2000-08-02 Stanislav Shalunov - - * message.el (message-make-in-reply-to): In-Reply-To is message-id - (see DRUMS). - -2000-09-29 Simon Josefsson - - * nntp.el (nntp-async-trigger): Fix authinfo in asynchronous - prefetch. - -2000-08-09 10:21:20 Katsumi Yamaoka - - * nntp.el (nntp-open-telnet): Wait for the telnet prompt before - sending a command; allow the rtelnet prompt as well. - -2000-09-29 Simon Josefsson - - * message.el (message-send): Make sure error is signalled if no - send method is specified. - -2000-09-29 Florian Weimer - - * qp.el (quoted-printable-encode-region): Wrap with - `mm-with-unibyte-current-buffer'. - -2000-09-29 12:12:49 ShengHuo ZHU - - * gnus-agent.el (gnus-agent-fetch-group-1): Reimplement Mike - McEwan's proposal. - -2000-09-29 12:06:40 ShengHuo ZHU - - * gnus-agent.el: Revoke Mike McEwan's 1998-09-05 patch due to - the GNU assignment issue. - -2000-09-29 09:56:34 ShengHuo ZHU - - * nndoc.el (nndoc-dissect-mime-parts-sub): Correctly mark body-begin. - -2000-09-29 09:14:08 ShengHuo ZHU - - * gnus-sum.el (gnus-summary-enter-digest-group): Decode to-address. - -2000-09-28 Andrei Elkin (tiny change) - - * gnus-art.el (article-strip-banner): Use - gnus-group-find-parameter rather than gnus-group-get-parameter, to - allow inheritance on the banner. - -2000-09-26 Richard M. Alderson III - - * gnus-art.el (gnus-read-save-file-name): expand-file-name. - -2000-09-26 Dave Love - - * gnus-draft.el: Don't require gnus-agent. - - * mm-view.el: Use featurep for XEmacs test. - (mm-inline-message): Test for `remove-specifier'; don't use - condition-case. - -2000-09-24 Simon Josefsson - - * nnimap.el (nnimap-request-accept-article): Remove From[^:] lines. - - * gnus-group.el (gnus-group-nnimap-edit-acl): Check if server - support ACL's. - - * nnimap.el (nnimap-acl-get): Check capability. - - * mail-source.el (mail-source-imap-file-coding-system): New variable. - (mail-source-fetch-imap): Use it. - - * rfc2104.el (rfc2104-hexstring-to-bitstring): New function. - (rfc2104-hash): Use it. - - * imap.el (imap-starttls-p): Check for starttls binary. - (imap-starttls-open): More verbose. - (imap-gssapi-auth): Ditto. - (imap-kerberos4-auth): Ditto. - (imap-cram-md5-auth): Ditto. - (imap-login-auth): Ditto. - (imap-anonymous-auth): Ditto. - (imap-digest-md5-auth): Ditto. - (imap-open): Ditto. - (imap-digest-md5-p): Check capability first. - -2000-09-24 Simon Josefsson - - * imap.el (imap-parse-flag-list): Correctly parse empty lists. - (imap-login-p): Support LOGINDISABLED. - -2000-09-23 Simon Josefsson - - * rfc2104.el: Add SHA-1 example. - -2000-09-22 Simon Josefsson - - * imap.el (imap-parse-body): Work around bug in Sun SIMS. - -2000-09-21 21:54:48 ShengHuo ZHU - - * lpath.el: Bind nnkiboze-score-file. - -2000-09-21 16:15:25 ShengHuo ZHU - - * gnus-score.el (gnus-score-use-all-scores): New variable. - (gnus-all-score-files): Use it. - * nnkiboze.el (nnkiboze-generate-group): Use it. Inhibit list groups. - (nnkiboze-enter-nov): Fix it when there is no xref. - (nnkiboze-generate-groups): List groups. - * gnus-group.el (gnus-group-make-kiboze-group): Use - nnkiboze-score-file. - - * nnkiboze.el (nnkiboze-request-article): Use - gnus-cache-request-article. - * gnus-group.el (gnus-group-make-kiboze-group): Fix prompt. - -2000-07-16 Dmitry Bely - - * nnheader.el (nnheader-translate-file-chars): Path splitting on NT. - -2000-09-20 18:33:00 ShengHuo ZHU - - * gnus-score.el (gnus-score-find-bnews): Use directory-sep-char. - -2000-09-20 17:37:46 ShengHuo ZHU - - * message.el (message-default-charset): Set default value in - non-MULE XEmacsen as iso-8859-1. - -2000-09-20 12:02:24 ShengHuo ZHU - - * gnus-demon.el: Use (featurep 'xemacs). - * gnus-agent.el: timer vs. itimer. - * mail-source.el: Ditto. - -2000-09-19 10:24:57 ShengHuo ZHU - - * gnus-group.el (gnus-group-make-kiboze-group): Makedir. - * nnheader.el (nnheader-parse-nov): Remove Xref in mail-header-xref. - * gnus-sum.el (gnus-nov-parse-line): Ditto. - * nnkiboze.el (nnkiboze-file-coding-system): New. - (nnkiboze-retrieve-headers): Use it. - (nnkiboze-request-group): Ditto. - (nnkiboze-close-group): Ditto. - (nnkiboze-generate-group): Ditto. - (nnkiboze-enter-nov): Insert first Xref properly. - -2000-09-19 Dave Love - - * nnmail.el (nnmail-cache-accepted-message-ids): Default to nil. - (nnmail-get-new-mail): Test `sources' in top-level conditional. - - * mail-source.el (mail-sources): Change default to '((file)). - Add useful custom type. - -2000-09-18 Kai Gro,A_(Bjohann - - * gnus-util.el (gnus-time-iso8601): Correct doc string (four digit - year). - (gnus-date-iso8601): Ditto. - -2000-09-18 09:05:46 ShengHuo ZHU - - * mail-source.el (mail-source-fetch-imap): Disable multibyte. - -2000-09-17 01:13:46 ShengHuo ZHU - - * rfc2047.el (rfc2047-q-encoding-alist): Remove = and _ from the - pattern. Avoid using 8 bit chars. - * qp.el (quoted-printable-encode-region): Avoid using 8 bit chars. - -2000-09-16 15:57:42 ShengHuo ZHU - - * smiley.el (smiley-buffer-ems, smiley-create-glyph-ems, - smiley-toggle-extent-ems, smiley-toggle-extents-ems, - smiley-toggle-buffer-ems): New functions for Emacs 21. Toggle - functions are not implemented yet. - - * dgnushack.el (dgnushack-compile): Remove smiley.el and - x-overlay.el from the FSF Emacs black list. - -2000-09-15 21:10:20 ShengHuo ZHU - - * mm-decode.el (mm-inlined-types): Add application/emacs-lisp. - (mm-inline-media-tests): Ditto. - (mm-automatic-display): Ditto. - * mm-view.el (mm-display-inline-fontify): Generalize from - mm-display-patch-inline. - (mm-display-patch-inline): Use it. - (mm-display-elisp-inline): Ditto. - -2000-09-15 14:03:00 ShengHuo ZHU - - * gnus-topic.el (gnus-topic-find-groups): Add recursive parameter. - (gnus-topic-unmark-topic): Ditto. - (gnus-topic-mark-topic): Ditto. - (gnus-topic-get-new-news-this-topic): Use it. - -2000-09-15 09:01:40 ShengHuo ZHU - - * gnus-art.el (gnus-treat-display-xface): By default, Emacs 21 - display xface. - -2000-08-23 02:54:46 Katsumi Yamaoka - - * gnus-group.el (gnus-group-rename-group): Inhibit renaming of - zombie or killed groups. - -2000-09-15 00:09:56 ShengHuo ZHU - - * mml.el (mml-preview): Reinsert unibyte content. - (mml-parse-1): Remove with-unibyte-current-buffer. - (mml-generate-mime-1): Ditto. - * gnus-msg.el (gnus-summary-mail-forward): Ditto. - * message.el (message-forward): Ditto. - -2000-09-14 23:13:50 ShengHuo ZHU - - * gnus-art.el (article-de-quoted-unreadable): Guess charset from - original article buffer. - (article-de-base64-unreadable): Ditto. - (article-wash-html): Ditto. - -2000-09-14 18:55:30 ShengHuo ZHU - - * gnus-msg.el (gnus-summary-mail-forward): Disable multibyte - unless forward-show-mml. - -2000-09-14 14:48:57 ShengHuo ZHU - - * gnus-sum.el (gnus-summary-save-parts-type-history): New. - (gnus-summary-save-parts-last-directory): New. - (gnus-summary-save-parts): Save history. - -2000-09-14 Ben Gertzfield - - * gnus-sum.el (gnus-summary-save-parts-default-mime): New - variable. - (gnus-summary-save-parts): Use it. - -2000-09-14 11:31:28 ShengHuo ZHU - - * gnus-art.el (gnus-article-setup-buffer): Clean handle-alist. - * gnus-sum.el (gnus-summary-exit): Ditto. - (gnus-summary-exit-no-update): Ditto. - (gnus-summary-show-article): Ditto. - -2000-09-14 08:42:48 ShengHuo ZHU - - * nndoc.el (nndoc-dissect-mime-parts-sub): Remove - Content-Disposition. - -2000-09-13 23:58:40 ShengHuo ZHU - - * webmail.el: Hotmail updated. Add X-Gnus-Webmail. - -2000-09-13 21:41:25 ShengHuo ZHU - - * gnus-art.el (gnus-article-setup-buffer): Set - gnus-article-mime-handles to nil. - * gnus-sum.el (gnus-summary-exit): Ditto. - (gnus-summary-exit-no-update): Ditto. - (gnus-summary-show-article): Ditto. - (gnus-summary-save-parts): Use gnus-article-mime-handles if - dissected. - * mm-partial.el (mm-partial-find-parts): Remove redundancy. - -2000-09-13 16:59:33 ShengHuo ZHU - - * gnus-sum.el (gnus-summary-sort): Sort loose threads too. - (gnus-sort-threads-1): New function. Sort threads recursively. - (gnus-sort-threads): Use it. - (gnus-sort-gathered-threads): Doc fix. - -2000-09-13 Dave Love - - * gnus-salt.el (gnus-binary-mode): Fix call to gnus-add-minor-mode. - - * gnus-ems.el (gnus-ems-redefine): Don't alias - gnus-summary-set-display-table. - - * message.el (message-user-agent): Don't wrap ignore-errors around - it. - - * mm-encode.el (mm-insert-multipart-headers): Avoid redundant - `format'. - (mm-content-transfer-encoding): Don't use cadar. - - * uudecode.el (uudecode-decoder-program) - (uudecode-decoder-switches): Customize. - - * gnus-score.el (gnus-home-score-file): Improve custom type. - - * gnus-cus.el (gnus-custom-mode): Conditionally set local - variables for Emacs 21. - (gnus-group-customize): Disable undo while laying out the buffer. - -2000-09-13 09:38:26 ShengHuo ZHU - - * gnus-util.el (gnus-write-active-file): Bind - coding-system-for-write. - -2000-09-13 09:14:57 ShengHuo ZHU - - * nnmail.el (nnmail-get-new-mail): Don't test nnmail-spool-file. - - * gnus-cache.el (gnus-jog-cache): Temporarily disable mail-sources. - * gnus-kill.el (gnus-batch-score): Ditto. - * gnus-move.el (gnus-change-server): Ditto. - * nnkiboze.el (nnkiboze-generate-groups): Ditto. - -2000-09-12 Simon Josefsson - - * gnus-sum.el (gnus-update-read-articles): Undo - `gnus-request-set-mark' operation. - -2000-09-11 Dave Love - - * Changelog: Use iso-2022 coding. - - * gnus-msg.el (gnus-msg-mail): New function. - (gnus-user-agent): New mail agent. - -2000-09-10 Dave Love - - * message.el: Require mail-abbrevs for XEmacs for a problem with - keybinding despite the autoloads for it. - -2000-09-08 Simon Josefsson - - * imap.el (imap-kerberos4-open): Erase more (fixes race condition?). - - * nnimap.el (nnimap-request-update-info-internal): Remove tick - marks from dormant articles. (See nnimap-request-set-mark.) - (nnimap-retrieve-headers-progress): Demule. - (nnimap-open-server): Call nnoo-change-server twice, once for - getting the nnimap-server-buffer and once for letting n-c-s set - the variables in that buffer. - -2000-09-08 David Edmondson - - * gnus.el (gnus-short-group-name): Guess separator. - -2000-09-07 Tadashi Watanabe - - * smiley.el (smiley-buffer, smiley-create-glyph): Work with GTK - XEmacs as well. - -2000-09-06 Francis Litterio - - * gnus-group.el (gnus-group-insert-group-line): Fix. - -2000-09-04 Dave Love - - * mm-decode.el (mime-display) : Add `multimedia' group. - (mm-get-image): Avoid the losing `make-glyph' from W3. - -2000-09-03 Simon Josefsson - - * gnus-sum.el (gnus-summary-delete-article): Check server. - -2000-09-01 Simon Josefsson - - * imap.el (imap-parse-flag-list): Rewrite. - - * nnimap.el (nnimap-retrieve-headers-from-file): Ignore errors. - - * imap.el (imap-parse-flag-list): Hack. - -2000-08-29 Dave Love - - * gnus-mlspl.el (gnus-group-split-fancy): Eschew mapcon. - - * dgnushack.el (mapcon, union): Remove compiler macros. - - * gnus-agent.el (gnus-agent-union): new function. - (gnus-agent-fetch-headers): Use it. - - * gnus.el (gnus-group-startup-message): Modifications to last change. - -2000-08-29 Katsumi Yamaoka - - * gnus.el (gnus-group-startup-message): Specify foreground and - background for xpm image. Centre image vertically. - -2000-08-24 23:49:23 ShengHuo ZHU - - * message.el (message-send-mail): Narrow-to-headers. - -2000-08-24 Dave Love - - * gnus-art.el (gnus-insert-mime-button): Fix help-echo for Emacs - 21. - -2000-08-23 Dave Love - - * dgnushack.el: Remove `member-if' compiler macro. - -2000-08-21 Dave Love - - * nnimap.el (nnimap-request-newgroups): Eschew member-if. - -2000-08-21 10:09:47 ShengHuo ZHU - - * gnus-topic.el (gnus-topic-hide-topic): Use find-topology if - permanent is used. - (gnus-topic-show-topic): Read topic when to show permanent hidden - topic. - (gnus-topic-remove-topic): Revert to the old behavior, not using - hide. - -2000-08-21 Dave Love - - * gnus-ems.el (gnus-add-minor-mode): Add &rest arg. - (gnus-xemacs): Use featurep. - - * mm-util.el (mm-read-charset): Maybe use builtin. - (mm-replace-chars-in-string): Maybe use subst-char-in-string. - (mm-multibyte-p, mm-with-unibyte-current-buffer) - (mm-with-unibyte): Use featurep, not string-match. - (mm-with-unibyte-buffer): Simplify. - (mm-quote-arg): Maybe use shell-quote-argument. - - * mml.el (mml-make-string): Deleted (unused). - - * gnus.el (gnus-mode-line-buffer-identification): Supply - definition for Emacs 21. - - * gnus-salt.el: Small doc fixes. - (gnus-pick-mode, gnus-binary-mode): Supply a toggle-func arg to - gnus-add-minor-mode. - - * gnus-topic.el (gnus-topic-mode): Supply a toggle-func arg to - gnus-add-minor-mode. - -2000-08-20 Simon Josefsson - - * nnimap.el (nnimap-before-find-minmax-bugworkaround): New - function, thanks to Lloyd Zusman for debugging. - (nnimap-request-group): - (nnimap-request-list): - (nnimap-retrieve-groups): - (nnimap-request-newgroups): Use it. - - * nnimap.el (nnimap-request-article-part): Less verbose. - -2000-08-19 Andreas Jaeger - - * lpath.el ((string-match "XEmacs" emacs-version)): Remove - subst-char-in-string since we test elsewhere whether it's bound. - -2000-08-18 Dave Love - - * gnus-score.el (gnus-score-find-score-files-function): Fix doc, - custom type. - - * gnus-xmas.el (gnus-group-icon-create-glyph): Don't test - gnus-group-running-xemacs. - - * nnheader.el (nnheader-replace-chars-in-string): Use - subst-char-in-string if available. - - * gnus-art.el (gnus-read-save-file-name, gnus-plain-save-name) - (gnus-request-article-this-buffer): Use expand-file-name. - (gnus-mime-view-part-as-type): Simplify interactive spec. - (gnus-mime-button-map): Define it all in defvar. - -2000-08-17 Dave Love - - * gnus-group.el (gnus-group-running-xemacs): Deleted. - - * gnus-demon.el (gnus-demon): Bind use-dialog-box and - last-nonmenu-event. - - * uudecode.el (char-int): Use defalias, not fset. - - * score-mode.el: Don't require easymenu. Require mm-util. - (score-mode-coding-system): Use mm-auto-save-coding-system. - - * nneething.el (nneething-create-mapping): Don't use cadar & al. - (nneething-file-name): Use expand-file-name, not concat. - -2000-08-16 13:05:46 ShengHuo ZHU - - * nnslashdot.el (nnslashdot-threaded-retrieve-headers): - Failure proof for email addresses. - (nnslashdot-sane-retrieve-headers): Ditto. - -2000-08-14 20:08:40 Lars Magne Ingebrigtsen - - * message.el (message-send-mail): Only insert courtesy message - when text/plain. - -2000-08-14 19:55:04 Jesper Harder - - * message.el (message-cancel-news): Copy the From header from the - original article. - -2000-08-14 19:52:01 Lars Magne Ingebrigtsen - - * gnus-async.el (gnus-asynchronous): Removed. - -2000-08-14 16:12:11 ShengHuo ZHU - - * mail-source.el (mail-source-fetch-maildir): Use MMDF mail - format. - -2000-08-14 19:12:22 Rod Whitby - - * nnmail.el (nnmail-expiry-target-group): Fixed. - -2000-08-14 Rod Whitby - - * nnmail.el (nnmail-expiry-target-group): Fix the call to - gnus-request-accept-article so that body encoding is *not* done. - Encoding is not done on incoming mail, so why should it be done on - expired mail? - - -2000-08-14 Rod Whitby - - * nnml.el (nnml-request-expire-articles): Fix the calls to - nnml-request-article (the filename was being passed instead of the - article number) and nnmail-expiry-target-group - (nnml-current-directory is changed by nnml-request-accept-article, - causing it to be incorrect for the next article to be expired). - -2000-08-14 Rod Whitby - - * gnus-sum.el (gnus-summary-expire-articles): Fix the handling of - expiry-target group parameters. - -2000-08-13 18:53:08 Lars Magne Ingebrigtsen - - * gnus-topic.el (gnus-topic-select-group): Touch the dribble - buffer. - (gnus-topic-hide-topic): Take a PERMANENT parameter. - (gnus-topic-show-topic): Ditto. - - * gnus-dup.el (gnus-dup-suppress-articles): Do auto-expiry. - -2000-08-12 21:48:00 John H. Palmieri - - * mail-source.el (mail-source-incoming-file-prefix): New - variable. - -2000-08-12 20:29:53 Lars Magne Ingebrigtsen - - * gnus-start.el (gnus-check-first-time-used): Clean up a bit. - - * mailcap.el (mailcap-maybe-eval): Be even more warning. - -2000-08-11 Florian Weimer - - * message.el (message-syntax-checks): New check quotin-style: - Text must be written below quoted text. - (message-check-news-body-syntax): Check it. - -2000-08-11 Simon Josefsson - - * imap.el (imap-authenticator-alist): Fix typo. - (imap-gssapi-open): Copy krb4 fixes for modern imtest's, thanks to - Jonas Oberg for debugging. - -2000-08-11 Simon Josefsson - - * gnus-async.el (gnus-asynchronous): Disable by default. - -2000-08-10 20:22:09 Lars Magne Ingebrigtsen - - * mm-view.el (mm-inline-text): Bind fill-column. - - * nnvirtual.el (nnvirtual-request-expire-articles): Return the - list of unexpired articles. - - * gnus-group.el (gnus-group-expire-articles-1): Return the list of - un-expired articles. - - * gnus-sum.el (gnus-summary-reparent-thread): Narrow to the - headers. - - * gnus-topic.el (gnus-topic-kill-group): Move up one line so that - we update the right topic.. - - * mm-decode.el (mm-display-external): Put point at start. - -2000-08-10 Kai Gro,A_(Bjohann - - * nnmail.el (nnmail-expiry-target): More explicit documentation. - - * gnus-cus.el (gnus-group-parameters): Add parameter `expiry-wait'. - -2000-08-09 Simon Josefsson - - * imap.el (imap-parse-body): - (imap-parse-string-list): Add bug workarounds for Stalker - Communigate Pro 3.0 server. - (imap-body-lines): Remove bogus comment. - - * imap.el (imap-range-to-message-set): Move from nnimap.el. - - * nnimap.el (nnimap-retrieve-which-headers): - (nnimap-retrieve-headers-from-server): - (nnimap-request-set-mark): - (nnimap-request-expire-articles): Use `i-r-t-m-set' instead. - -2000-08-08 00:53:41 ShengHuo ZHU - - * message.el (message-dont-reply-to-names): - rmail-dont-reply-to-names may not be defined. - -2000-08-07 09:37:01 ShengHuo ZHU - - * gnus-group.el (gnus-group-iterate): Uncompiled function should - not use pop. - -2000-07-19 Dave Love - - * gnus-ems.el: Defalias some dummy funcs to `ignore'. - (gnus-x-splash): Use expand-file-name. Remove redundant facep - check. - (gnus-article-display-xface): Special-case for dark backgrounds. - -2000-07-19 Kim-Minh Kaplan - - * imap.el (imap-calculate-literal-size-first): New variable. - (imap-local-variables): Add it. - (imap-kerberos4-open): Set it. - (imap-send-command): Use it. - -2000-07-17 14:18:16 ShengHuo ZHU - - * mailcap.el (mailcap-mimetypes-parsed-p): New variable. - (mailcap-parse-mimetypes): Use it. - (mailcap-extension-to-mime): Parse mimetype. - (mailcap-mime-types): Ditto. - * mml.el (mml-minibuffer-read-type): Ditto. - -2000-07-16 18:25:07 ShengHuo ZHU - - * nndoc.el (nndoc-type-alist): Add outlook. - (nndoc-outlook-type-p): New function. - (nndoc-outlook-article-begin): Ditto. - -2000-07-16 Daiki Ueno - - * gnus-sum.el (gnus-restore-hidden-threads-configuration): Save - excursion. - -2000-07-15 Simon Josefsson - - * gnus-cus.el (gnus-group-parameters, banner): Type is regexp. - - * imap.el (imap): - (imap-kerberos4-program): - (imap-gssapi-program): - (imap-ssl-program): Customization. - (imap-shell-program): - (imap-shell-host): New variables. - (imap-streams): - (imap-stream-alist): Add shell. - (imap-shell-p): - (imap-shell-open): New functions. - (imap-open): Don't call authenticator if preauth. - (imap-authenticate): Return t if already authenticated. - -2000-07-14 Simon Josefsson - - * gnus.el (gnus-invalid-group-regexp): New variable. - (gnus-read-group): Use it. - -2000-07-14 12:40:51 ShengHuo ZHU - - * gnus-agent.el (gnus-agent-fetch-group-1): mark-below, - expunge-below and orphan-score are "group variables". - -2000-07-13 Simon Josefsson - - * gnus-srvr.el (gnus-browse-read-group): Don't pass fully - qualified group names to `gnus-group-read-ephemeral-group'. - -2000-07-13 07:40:39 Katsumi Yamaoka - - * dgnushack.el (srcdir): Define it before use it. - -2000-07-12 19:37:50 ShengHuo ZHU - - * gnus-sum.el: `W t' is toggle-header in info. - -2000-07-12 16:50:06 ShengHuo ZHU - - * lpath.el: Fbind subst-char-in-string. - -2000-07-12 15:48:29 ShengHuo ZHU - - * Makefile.in: Use W3DIR and lispdir. - * dgnushack.el: Ditto. - -2000-07-12 10:12:31 ShengHuo ZHU - - * gnus-art.el (article-de-base64-unreadable): Typo. - -2000-07-12 Simon Josefsson - - * gnus-agent.el (require): Require timer. - -2000-07-11 18:29:50 ShengHuo ZHU - - * message.el (message-bounce): Call mime-to-mml. - -2000-07-11 18:00:49 Lars Magne Ingebrigtsen - - * nnslashdot.el (nnslashdot-request-close): New function. - -2000-07-04 23:23:23 Lars Magne Ingebrigtsen - - * nnslashdot.el (nnslashdot-threaded-retrieve-headers): Get the - right line number for the article. - -2000-07-10 22:41:58 ShengHuo ZHU - - * nnslashdot.el (nnslashdot-threaded-retrieve-headers): Save point. - * webmail.el (webmail-fetch): Bind - url-http-silence-on-insecure-redirection. - -2000-07-10 11:43:22 ShengHuo ZHU - - * nnslashdot.el (nnslashdot-threaded-retrieve-headers): Use - unibyte. - (nnslashdot-sane-retrieve-headers): Ditto. - (nnslashdot-request-article): Ditto. - -2000-07-10 11:12:32 William M. Perry - - * mailcap.el (mailcap-parse-mimetype-file): - -2000-07-07 23:46:22 ShengHuo ZHU - - * nnweb.el (nnweb-insert): Stricter test. - * webmail.el (webmail-refresh-redirect): Ditto. - -2000-07-06 14:17:48 ShengHuo ZHU - - * mm-decode.el (mm-dissect-multipart): Match the EOL of boundary. - -2000-07-05 21:19:22 ShengHuo ZHU - - * nnheader.el (nnheader-insert-nov): Remove EOLs of all fields. - -2000-07-05 Dave Love - - * utf7.el: Doc and header fixes. - - * gnus-sum.el: Doc fixes. - - * gnus-util.el (gnus-point-at-eol, gnus-point-at-bol): Use - defalias, not fset. - - * flow-fill.el (fill-flowed-point-at-eol) - (fill-flowed-point-at-bol): Use defalias, not fset. - - * gnus-art.el: Don't alias article-mime-decode-quoted-printable. - (gnus-Plain-save-name): Delete -- apparently bogus. - -2000-07-03 00:12:26 Lars Magne Ingebrigtsen - - * nnsoup.el: Use expand-file-name throughout. - -2000-07-03 00:07:51 Kjetil Torgrim Homme - - * nnmail.el (nnmail-read-incoming-hook): New example. - -2000-07-02 23:17:23 Lars Magne Ingebrigtsen - - * mm-view.el (mm-inline-text): Check whether the text has already - been decoded. - -2000-07-04 15:17:05 ShengHuo ZHU - - * nnslashdot.el (nnslashdot-sid-strip): To strip or not to strip? - -2000-07-03 Stainless Steel Rat - - * gnus-sum.el (gnus-recenter): Fix horizontal recenter. - -2000-07-03 Simon Josefsson - - * gnus-sum.el (gnus-update-marks): Don't propagate download and - unsend flags. - -2000-07-03 Simon Josefsson - - * nnimap.el (nnimap-open-connection): Don't look up virtual server - name in authinfo (.authinfo now support ports, no need for the - hack). - (nnimap-split-find-rule): Fix. - (nnimap-open-connection): Look for nnimap-server-address in authinfo. - -2000-07-03 Paul Stodghill - - * message.el (message-unquote-tokens): Remove all quotes. - -2000-07-03 00:29:08 Julien Gilles - - * gnus-ml.el: New file. - -2000-07-02 16:11:25 Lars Magne Ingebrigtsen - - * nnultimate.el (nnultimate-request-close): New function. - - * gnus-start.el (gnus-clear-system): Clear nnmail-split-history. - -2000-06-18 Norbert Koch - - * Makefile.in: Better support for xemacs builds - -Sun Jul 2 15:11:35 2000 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.8.7 is released. - -2000-05-19 06:32:52 Lars Magne Ingebrigtsen - - * mm-decode.el (mm-insert-part): Characters doubly decoded. - -2000-07-01 10:23:08 Shenghuo ZHU - - * message.el (message-do-fcc): Encode MIME. - -2000-06-28 13:52:57 Shenghuo ZHU - - * lpath.el: Fbind image-size. - -2000-06-28 Simon Josefsson - - * nnimap.el (nnimap-split-rule): Update doc with extended syntax. - (nnimap-assoc-match): New function. - (nnimap-split-find-rule): Support extended syntax. - -2000-06-28 Simon Josefsson - - * nnimap.el (nnimap-open-connection): Use port stuff. - - * gnus-util.el (gnus-netrc-machine): Add defaultport parameter, - document port and defaultport. - -2000-06-27 Paul Stodghill - - * gnus-agent.el (gnus-agent-synchronize): Kill flags buffer. - -2000-06-26 Dave Love - - * mm-decode.el (mm-image-fit-p): Use `image-size' in Emacs. - - * message.el: Remove unnecessary `require'ments. Defvar - gnus-list-identifiers when compiling. Don't try to autoload - variable `gnus-list-identifiers'. Autoload - gnus-group-name-charset. - (message-fetch-field): Don't assume `format' removes text - properties. - (message-strip-list-identifiers, message-reply, message-followup): - Require gnus-sum. - (message-mode): Tidy XEmacs conditionals. - (message-replace-chars-in-string): Use subst-char-in-string when - available. - - * gnus-xmas.el (gnus-xmas-define) : - Define if necessary. - - * gnus-art.el (gnus-article-edit-exit): Don't assume `format' - removes text properties. - - * gnus-srvr.el (gnus-browse-group-name): Likewise. - - * gnus-msg.el (gnus-copy-article-buffer): Likewise. - - * gnus-score.el (gnus-summary-score-entry): Likewise. - -2000-06-26 11:18:57 Katsumi Yamaoka - - * nnimap.el (nnimap-request-post): Fix parenthesis. - -2000-06-26 Paul Stodghill - - * message.el (message-unquote-tokens): New function. - - * gnus-msg.el (gnus-inews-do-gcc): Unquote gcc tokens. - - * nnimap.el (nnimap-request-post): Ditto. - -2000-06-21 Simon Josefsson - - * gnus.el (gnus-asynchronous): Removed (defined in gnus-async.el). - - * nnimap.el (nnimap-callback): Update for IMAP4rev1 servers (see - patch commited 2000-04-02). - -2000-06-20 Simon Josefsson - - * imap.el (imap-mailbox-examine-1): New function. - (imap-message-copyuid-1): - (imap-message-appenduid-1): Use it, instead of - `imap-mailbox-examine' which would utf-7 encode mailbox name - twice. - -2000-06-19 Dave Love - - * mm-uu.el Don't require message. Require cl when compiling. - -2000-06-17 18:58:46 Shenghuo ZHU - - * gnus-sum.el (gnus-summary-local-variables): gnus-orphan-score is - a local variable. - * gnus-sum.el (gnus-orphan-score): Move here. - -2000-06-10 09:33:36 Shenghuo ZHU - - * message.el (message-forward): Remove show-mml condition. - (message-forward-ignored-headers): Remove X-Gnus headers. - -2000-06-08 Simon Josefsson - - * gnus-cus.el (gnus-extra-group-parameters): Add uidvalidity. - -2000-06-08 12:34:26 Urban Engberg - - * gnus-demon.el (gnus-demon-scan-mail): Bind nnmail-fetched-sources. - -2000-06-08 12:27:55 Shenghuo ZHU - - * message.el (message-syntax-checks): Add type. - -2000-06-07 Dave Love - - * mm-view.el (mm-inline-image-emacs): Don't specify string for - put-image. - (mm-inline-image): Defalias, not fset. - - * gnus.el (gnus-group-startup-message): Don't specify string for - insert-image. - - * gnus-ems.el (gnus-add-minor-mode): Make it an alias if - add-minor-mode is available. - (gnus-article-display-xface): Don't specify string for - insert-image. - -2000-06-06 13:28:53 Shenghuo ZHU - - * gnus-topic.el (gnus-topic-remove-topic): Set hidden. - (gnus-topic-insert-topic-line): Use shownp. - (gnus-topic-hide-topic): Don't use hidden. - (gnus-topic-show-topic): Don't use hidden. - -2000-06-05 22:25:12 Shenghuo ZHU - - * gnus-cache.el (gnus-cache-possibly-enter-article): Bind coding - system. - * gnus-soup.el (gnus-soup-write-prefixes): Ditto. - * gnus-start.el (gnus-slave-save-newsrc): Ditto. - * gnus-util.el (gnus-output-to-rmail): Ditto. - (gnus-output-to-mail): Ditto. - (gnus-write-buffer): Ditto. - * gnus-uu.el (gnus-uu-save-article): Ditto. - -2000-06-04 15:05:16 Shenghuo ZHU - - * message.el (message-read-from-minibuffer): Typo. - -2000-06-03 13:36:46 Shenghuo ZHU - - * gnus-art.el (article-decode-charset): Override non-MIME forward - charset. - -2000-06-02 12:04:26 Shenghuo ZHU - - * mml.el (mml-quote-region): Correct the regexp. - * gnus-msg.el (gnus-summary-reply): mml-quote it. - -2000-06-02 11:57:15 Shenghuo ZHU - - * message.el (message-forward): Insert raw text. - * mml.el (mml-parse-1): Get raw text in unibyte mode. - (mml-generate-mime-1): Insert raw text in unibyte mode. - -2000-06-01 Florian Weimer - - * mm-bodies.el (mm-body-encoding): Always encoded if - `mm-use-ultra-safe-encoding' is set. - -2000-05-31 14:50:52 Shenghuo ZHU - - * mml.el (ange-ftp-name-format): Typo. - -2000-05-30 Simon Josefsson - - * gnus-start.el (gnus-get-unread-articles): If - `gnus-activate-group' and/or `gnus-check-server' return nil, don't - try to do anything on that server. - -2000-05-25 Simon Josefsson - - * gnus-group.el (gnus-group-nnimap-edit-acl): Help text updated - from latest draft. - -2000-05-08 Simon Josefsson - - * gnus-group.el (gnus-group-expire-articles-1): Make sure server - is open. - -2000-05-24 Dave Love - - * mml.el (mml-parse-file-name): Fix ange-ftp part. - -2000-05-22 Didier Verna - - * gnus.el (gnus-redefine-select-method-widget): new function, call - it once. Add an "other" entry for unknown but editable backend - name symbols. - * gnus-start.el (gnus-declare-backend): use it. - -2000-05-19 Dave Love - - * gnus-art.el (gnus-article-next-page): Revert last change. - -2000-05-19 09:56:07 Shenghuo ZHU - - * gnus-agent.el (gnus-agent-open-history): Open history in binary mode. - -2000-05-19 Dave Love - - * gnus-art.el (gnus-mime-externalize-part): Bind mm-inlined-types, - not mm-inline-large-images. - -2000-05-19 01:45:40 Shenghuo ZHU - - * mml.el (mml-parse-1): Don't test multiple-charsets within mml tag. - -2000-05-18 Dave Love - - * gnus-art.el: Use defalias, not fset. - (gnus-article-x-face-command): Don't test for xbm. - (gnus-article-next-page): Redisplay before testing point in window. - -2000-05-17 21:16:54 Shenghuo ZHU - - * gnus-group.el (gnus-group-mode-map): Add M-SPACE. - * mml.el (mml-mode-map): Comment out mml-narrow-to-part. - -2000-05-17 21:13:38 Jim Davidson - - * gnus-sum.el (gnus-summary-save-article-rmail): Use - gnus-summary-save-in-rmail. - * message.el (message-output): Ditto. - -2000-05-17 22:37:25 Katsumi Yamaoka - - * gnus-art.el (gnus-emphasize-whitespace-regexp): Doc fix. - -2000-05-17 14:03:49 Shenghuo ZHU - - * rfc2047.el (rfc2047-encode-message-header): Encode if the method - is a charset. - * message.el (message-send-news): Check group name charset. - * gnus-msg.el (gnus-post-news): Decode group name. - (gnus-inews-do-gcc): Encode group name. - -2000-05-17 10:16:32 Karl Kleinpaste - - * gnus-art.el (gnus-emphasize-whitespace-regexp): New variable. - * gnus-util.el (gnus-put-text-property-excluding-newlines): Use it. - -2000-05-17 02:25:11 Shenghuo ZHU - - * gnus-group.el (gnus-group-mark-line-p): New function. - (gnus-group-goto-group): New parameter. - (gnus-group-remove-mark): Use it. - * gnus-topic.el (gnus-topic-move-group): Ditto. - (gnus-topic-remove-group): Ditto. - -2000-05-17 00:49:09 Shenghuo ZHU - - * gnus-group.el (gnus-group-list-dormant): New function. - -2000-05-16 23:20:42 Shenghuo ZHU - - * gnus-agent.el (gnus-agent-synchronize): Use - nnheader-insert-file-contents. - (gnus-agent-save-active-1): Ditto. - (gnus-agent-write-active): Ditto. - (gnus-agent-expire): Ditto. - * gnus-cache.el (gnus-cache-read-active): Ditto. - * gnus-start.el (gnus-master-read-slave-newsrc): Ditto. - * gnus-sum.el (gnus-summary-import-article): Ditto. - - * gnus-agent.el (gnus-agent-write-servers): Bind coding-system. - (gnus-agent-save-group-info): Ditto. - (gnus-agent-save-alist): Ditto. - * gnus-util.el (gnus-make-directory): Ditto. - - * gnus-agent.el (gnus-agent-save-group-info): Disable multibyte. - -2000-05-16 21:13:24 Shenghuo ZHU - - * mml.el (mml-generate-mime-preprocess-function): New variable. - (mml-generate-mime-postprocess-function): New variable. - (mml-generate-mime-1): Use them. - -2000-05-16 18:15:24 Shenghuo ZHU - - * gnus-group.el (gnus-group-apropos): Group name charset. - * gnus-sum.el (gnus-set-mode-line): Ditto. - * gnus-group.el (gnus-group-decoded-name): New function. - (gnus-group-edit-group): Use it. - * gnus-cus.el (gnus-group-customize): Use it. - -2000-05-16 17:55:57 Karl Kleinpaste - - * gnus-util.el (gnus-put-text-property-excluding-newlines): Improve. - -2000-05-16 16:22:17 Shenghuo ZHU - - * gnus-group.el (gnus-group-name-charset-method-alist): New variable. - (gnus-group-name-charset-group-alist): Ditto. - (gnus-group-name-charset): New function. - (gnus-group-name-decode): New function. - (gnus-group-insert-group-line): Use them. - (gnus-group-prepare-flat-list-dead): Ditto. - (gnus-group-list-active): Ditto. - (gnus-group-describe-all-groups): Ditto. - (gnus-group-prepare-flat-list-dead-predicate): Ditto. - * gnus-srvr.el: (gnus-browse-foreign-server): Decode group name and - add gnus-group property. - (gnus-browse-group-name): Read gnus-group property. - -2000-05-16 15:27:08 Shenghuo ZHU - - * nnfolder.el (nnfolder-possibly-change-group): Use - file-name-coding-system instead of pathname-coding-system. - * nnmail.el (nnmail-find-file): Ditto. - (nnmail-write-region): Ditto. - * nnmh.el (nnmh-retrieve-headers): Ditto. - (nnmh-request-article): Ditto. - (nnmh-request-group): Ditto. - (nnmh-request-list): Ditto. - (nnmh-possibly-change-directory): Ditto. - (nnmh-active-number): Ditto. - * nnml.el (nnml-possibly-change-directory): Ditto. - (nnml-request-list): Ditto. - (nnml-request-article): Ditto. - (nnml-retrieve-headers): Ditto. - -2000-05-16 Simon Josefsson - - * nnimap.el (nnimap-request-accept-article): Don't unselect - mailbox if no mailbox is selected. - -2000-05-15 Per Abrahamsen - - * gnus-art.el (gnus-button-url-regexp): Revert earlier change. - Recognize domain names starting with `www.' as starting an URL. - -2000-05-15 09:46:47 Shenghuo ZHU - - * mail-source.el (mail-source-fetch-maildir): Insert "From ". - (mail-source-keyword-map): Add "subdirs" for maildir. - -2000-05-14 16:19:28 Shenghuo ZHU - - * nnmail.el (nnmail-scan-directory-mail-source-once): New variable. - (nnmail-get-new-mail): Use it. - * gnus-start.el (gnus-get-unread-articles): Ditto. - -2000-05-14 14:02:12 Shenghuo ZHU - - * gnus-sum.el (gnus-summary-edit-article): Better support for - nndraft:drafts. - * nndraft.el (nndraft-request-replace-article): New function, - bind nnmail-file-coding-system. - -2000-05-14 Dave Love - - * nnheader.el: Replace uses of `fset' with `defalias'. - (jka-compr-compression-info-list): Only defvar when compiling. - -2000-05-14 12:30:28 Shenghuo ZHU - - * webmail.el (webmail-netaddress-article): Refresh redirect. - -2000-05-13 20:41:10 Shenghuo ZHU - - * mm-view.el (mm-inline-text): w3 might not recognize utf-8. - -2000-05-13 16:49:41 Shenghuo ZHU - - * webmail.el: Translate   to SP. - -2000-05-13 13:00:17 Robin S. Socha - - * message.el (message-bounce): Doc typo. - -2000-05-13 12:25:21 Shenghuo ZHU - - * gnus-soup.el (gnus-soup-encoding-type): u is USENET news format. - (gnus-soup-store): Ditto. - (gnus-soup-send-packet): Ditto. - * nnsoup.el (nnsoup-replies-format-type): Ditto. - (nnsoup-dissect-buffer): Ditto. - (nnsoup-narrow-to-article): Ditto. - (nnsoup-make-active): Ditto - -2000-05-13 12:03:29 Shenghuo ZHU - - * message.el (message-mode): Two parameters for local-variable-p. - -2000-05-13 00:54:46 Shenghuo ZHU - - * message.el (message-strip-list-identifiers): New function. - (message-reply): Use it and use message-strip-subject-re. - (message-followup): Ditto. - * gnus-art.el (article-hide-list-identifiers): Remove more. - * gnus-sum.el (gnus-summary-remove-list-identifiers): Ditto. - -2000-05-12 22:28:54 Shenghuo ZHU - - * gnus-uu.el (gnus-uu-digest-mail-forward): Bind - mail-parset-charset and use non-numeric argument. - -2000-05-12 20:54:11 Shenghuo ZHU - - * mml.el (mml-buffer-list): New variable. - (mml-generate-new-buffer): New function. - (mml-destroy-buffers): Ditto. - (mml-insert-mime): Use them. - * gnus-msg.el (gnus-setup-message): mml-buffer leaks. - * gnus-sum.el (gnus-summary-edit-article): Ditto. - * message.el (message-mode): Ditto. - * gnus-uu.el (gnus-uu-digest-headers): Keep MIME headers. - (gnus-uu-save-article): Support show-as-mml. - * message.el (message-forward): Ditto. - -2000-05-12 15:15:55 Shenghuo ZHU - - * nndoc.el (nndoc-type-alist): mime-digest head-begin. - (nndoc-mime-digest-type-p): Locate article head precisely. - * mml.el (mml-generate-default-type): New variable. - (mml-generate-mime-1): Use it. - (mml-insert-mime-headers): Use it. - * gnus-uu.el (gnus-uu-digest-buffer): New variable. - (gnus-uu-digest-mail-forward): Use it and call message-forward - with argument digest. - (gnus-uu-save-article): Support message-forward-as-mime. - * message.el (message-forward): Add parameter digest. - * mm-decode.el (mm-dissect-default-type): New variable. - (mm-dissect-buffer): Use it. - -2000-05-11 11:08:03 Shenghuo ZHU - - * mml.el (mml-parse-singlepart-with-multiple-charsets): Set space, - newline and paragraph to nil when got a non-ascii character. Test - paragraph before newline. - -2000-05-10 12:17:58 Shenghuo ZHU - - * qp.el (quoted-printable-encode-region): Bind tab-width to 1. Set - limit to 76. - -2000-05-10 09:11:48 Lars Magne Ingebrigtsen - - * nnslashdot.el (nnslashdot-sid-strip): New function. - (nnslashdot-threaded-retrieve-headers): New format. - (nnslashdot-sane-retrieve-headers): Ditto. - (nnslashdot-request-article): Ditto. - (nnslashdot-threaded-retrieve-headers): Thread properly. - (nnslashdot-request-article): Be more lenient. - (nnslashdot-threaded-retrieve-headers): Regexp search. - -2000-05-09 13:23:50 Shenghuo ZHU - - * gnus-sum.el (gnus-with-article): Define it before use it. - -2000-05-08 22:34:19 Shenghuo ZHU - - * message.el (message-supersede): Use mime-to-mml. - * mm-decode.el (mm-insert-part): Test the buffer if no encoding. - -2000-05-08 22:34:24 Katsumi Yamaoka - - * gnus-group.el (gnus-group-list-cached): Don't use - `subst-char-in-string'. - -2000-05-08 Dave Love - - * pop3.el (pop3-open-server): Fix creating name of trace buffer. - -2000-05-08 01:07:47 Shenghuo ZHU - - * mm-decode.el (mm-interactively-view-part): Append %s if the - method is a single word. - * nnwarchive.el (nnwarchive-type-definition): Typo. - -2000-05-07 17:24:01 Shenghuo ZHU - - * gnus-group.el (gnus-group-prepare-flat-list-dead-predicate): New - function. - (gnus-group-prepare-flat-predicate): Use it. - (gnus-group-list-cached): List dead groups. - -2000-05-07 10:50:02 Shenghuo ZHU - - * gnus-art.el (article-decode-charset): Don't decode message with - format. - -2000-05-07 Florian Weimer - - * mailcap.el (mailcap-maybe-eval): Honor user request not to - evaluate the Lisp code. - -2000-05-06 17:40:20 Shenghuo ZHU - - * gnus-art.el (article-wash-html): New function. - (gnus-article-wash-html): Bind. - (gnus-article-make-menu-bar): Menu item. - * gnus-sum.el (gnus-summary-wash-map): Bind 'h'. - (gnus-summary-make-menu-bar): Menu item. - * gnus.el: Autoload. - -2000-05-06 Florian Weimer - - * gnus-uu.el (gnus-uu-unshar-warning): New variable. - (gnus-uu-unshar-article): Use it. - - * mailcap.el (mailcap-maybe-eval-warning): New variable. - (mailcap-maybe-eval): Use it. - - * gnus-msg.el (gnus-group-posting-charset-alist): Speling mistake - in docstring. - - * mml.el (mml-generate-mime-1): Small comment. - -2000-05-05 12:27:53 Shenghuo ZHU - - * gnus-art.el (article-de-base64-unreadable): New function. - (gnus-article-de-base64-unreadable): Bind. - (gnus-article-make-menu-bar): Menu item. - * gnus-sum.el (gnus-summary-wash-map): Bind '6' and 'Z'. - (gnus-summary-make-menu-bar): Menu item. - * gnus.el: Autoload. - -2000-05-05 10:32:27 Shenghuo ZHU - - * gnus-sum.el (gnus-summary-show-article): Remove en/disable multibyte. - (gnus-summary-select-article): Add en/disable multibyte. - -2000-05-05 02:47:23 Shenghuo ZHU - - * gnus-sum.el (gnus-summary-edit-article): Enable multibyte. - (gnus-summary-edit-article): New feature: editing raw articles. - -2000-05-05 00:30:12 Shenghuo ZHU - - * rfc2047.el (rfc2047-encode-region): Insert a space before encoding. - Emacs MULE can not encode adjacent iso-2022-jp and cn-gb-2312. - * gnus-msg.el (gnus-summary-mail-forward): Use unibyte buffer. - Emacs MULE can not copy some 8bit characters in multibyte buffers. - * mm-decode.el (mm-insert-part): Ditto. - -2000-05-04 17:49:04 Shenghuo ZHU - - * nndoc.el (nndoc-type-alist): Extend forward regexp. - (nndoc-forward-type-p): Ditto. - -2000-05-04 17:13:04 Shenghuo ZHU - - * mm-util.el (mm-with-unibyte-current-buffer): Set the default - value of enable-multibyte-characters. - -2000-05-04 10:31:24 Shenghuo ZHU - - * gnus-sum.el (gnus-summary-show-article): En/disable multibyte. - -2000-05-03 Dave Love - - * gnus-ems.el (gnus-article-xface-ring-internal) - (gnus-article-xface-ring-size): New variable. - (gnus-article-display-xface): Use them to cache data. Don't try - to use XPM. Set up binary coding for PBM's sake. - -2000-05-03 14:23:38 Shenghuo ZHU - - * gnus-msg.el (gnus-inews-do-gcc): Set mail-parse-charset. - * gnus-int.el (gnus-request-accept-article): Ditto. - (gnus-request-replace-article): Ditto. - * mm-util.el (mm-mime-mule-charset-alist): Add a fake mule-charset. - -2000-05-03 14:11:23 Shenghuo ZHU - - * rfc2047.el (rfc2047-encode): Test the validity of coding-system. - -2000-05-03 11:35:15 Shenghuo ZHU - - * rfc2047.el (rfc2047-encode-message-header): Encode field by - field. - * mml.el (mml-to-mime): Use message-default-charset. - (mml-preview): Narrow to headers. - * message.el (message-send-mail): Use message-default-charset. - (message-send-news): Narrow to headers; - use message-default-charset. - -2000-05-03 08:09:14 Shenghuo ZHU - - * mm-bodies.el (mm-decode-content-transfer-encoding): A better junk - detect. - * mml.el (mml-parse-singlepart-with-multiple-charsets): Save - restriction. - (mml-parse-1): Warning message. - (mml-preview): Disable multibyte. - -2000-05-03 Dave Love - - * gnus.el (gnus-group-startup-message): Add newline before image. - -2000-05-02 21:34:10 Shenghuo ZHU - - * rfc2047.el (rfc2047-encode-message-header): Check the coding-system. - * message.el (message-send-mail): Use unibyte-buffer. - (message-send-mail): Ditto. - -Mon May 1 15:09:46 2000 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.8.6 is released. - -2000-05-01 07:45:43 Shenghuo ZHU - - * mml.el (mml-parse-1): Set no-markup-p and warn to nil. - -2000-04-28 21:14:21 Shenghuo ZHU - - * rfc2047.el (rfc2047-q-encoding-alist): Encode HTAB. - -2000-04-28 16:37:09 Shenghuo ZHU - - * message.el (message-send-mail-partially): Use forward-line. - -2000-04-28 16:01:09 Shenghuo ZHU - - * gnus-art.el (gnus-mime-button-menu): Use call-interactively. - -2000-04-28 15:30:17 Shenghuo ZHU - - * mml.el (mml-generate-mime-1): Ignore 0x1b. - (mml-insert-mime): No markup only for text/plain. - (mime-to-mml): Remove MIME headers. - -2000-04-28 14:23:14 Shenghuo ZHU - - * mml.el (mml-preview): Set gnus-newsgroup-charset. - * rfc2047.el (rfc2047-encode-message-header): Encode non-ascii - as 8-bit. - * lpath.el: Fbind image functions. - -2000-04-28 Dave Love - - * gnus.el (gnus-group-startup-message): Maybe use image in Emacs - 21. - - * mailcap.el (mailcap-parse-mailcaps): Revert last change to - search order. Use parse-colon-path and remove some redundancy. - Doc fix. - (mailcap-parse-mimetypes): Code consistently with - mailcap-parse-mailcaps. Doc fix. - - * gnus-start.el (gnus-unload): Iterate over `features', not - `load-history'. - -2000-04-28 09:52:21 Shenghuo ZHU - - * mml.el (mml-parse-1): Don't create blank parts. - (mml-read-part): Fix mml tag. - (mml-insert-mime): Convert message/rfc822. - (mml-insert-mml-markup): Add mmlp parameter. - -2000-04-28 01:16:10 Shenghuo ZHU - - * message.el (message-send-mail-partially): Remove CTE. - -2000-04-28 00:31:53 Shenghuo ZHU - - * lpath.el: Fbind put-image for XEmacs. - * mm-view.el (mm-inline-image): Fset it. - -2000-04-27 23:23:37 Shenghuo ZHU - - * nndoc.el (nndoc-type-alist): Change forward regexp. - -2000-04-27 21:57:10 Shenghuo ZHU - - * message.el (message-send-mail-partially-limit): Change the - default value. - -2000-04-27 21:53:32 Erik Toubro Nielsen - - * gnus-util.el (gnus-extract-address-components): Name might be - "". - -2000-04-27 20:32:06 Shenghuo ZHU - - * gnus-msg.el (gnus-summary-mail-forward): Use ARG. - (gnus-summary-post-forward): Ditto. - * message.el (message-forward-show-mml): New variable. - (message-forward): Use it. - * mml.el (mml-parse-1): Add tag mml. - (mml-read-part): Ditto. - (mml-generate-mime): Support reentance. - (mml-generate-mime-1): Support mml tag. - -2000-04-27 Dave Love - - * gnus-art.el: Don't bother to require custom, browse-url. - (gnus-article-x-face-command): Include gnus-article-display-xface. - - * gnus-ems.el: Assume only (X)Emacs 20+. Simplify XEmacs checks. - Use defalias, not fset. - (gnus-article-display-xface): New function. - - * mm-view.el (mm-inline-image-emacs): Use put-image, remove-images. - - * mm-decode.el: Small doc fixes. Require cl when compiling. - (mm-xemacs-p): Deleted. - (mm-get-image-emacs, mm-get-image-xemacs): Deleted. - (mm-get-image): Amalgamate Emacs and XEmacs code here; for Emacs, - use create-image and don't special-case xbm. - (mm-valid-image-format-p): Use display-graphic-p. - -2000-04-27 15:27:54 Shenghuo ZHU - - * message.el (message-send-mail-partially-limit): New variable. - (message-send-mail-partially): New function. - (message-send-mail): Use it. - * mm-bodies.el (mm-decode-content-transfer-encoding): Remove - all blank lines inside of base64. - * mm-partial.el (mm-inline-partial): Add an option. Remove tail - blank lines. - -2000-04-27 10:03:36 Shenghuo ZHU - - * mml.el (mml-insert-tag): Match more special characters. - -2000-04-27 09:06:29 Shenghuo ZHU - - * gnus-msg.el (gnus-bug): Avoid attaching the external buffer. - -2000-04-27 00:58:43 Shenghuo ZHU - - * mm-decode.el (mm-inline-media-tests): Add message/partial. - (mm-inlined-types): Ditto. - * mm-partial.el: New file. - -2000-04-27 Dave Love - - * mailcap.el (mailcap-mime-data): Fix octet-stream syntax -- might - matter in Emacs 21. - -2000-04-26 Florian Weimer - - * mm-bodies.el (mm-encode-body): Remove reference to - mm-default-charset in comment. - -2000-04-24 00:56:00 Bj,Av(Brn Torkelsson - - * rfc2047.el (rfc2047-encode-message-header): Fixing typo. - -2000-04-26 12:27:41 Shenghuo ZHU - - * gnus-draft.el (gnus-draft-send): Move gnus-draft-setup inside of - let. - -2000-04-26 12:26:10 Pavel Janik ml. - - * gnus-draft.el (gnus-draft-setup): Fix comments. - -2000-04-26 10:06:12 Shenghuo ZHU - - * nnmbox.el (nnmbox-create-mbox): Use nnmbox-file-coding-system, - if nnmbox-file-coding-system-for-write is nil. - -2000-04-26 02:17:44 Shenghuo ZHU - - * gnus-msg.el (gnus-configure-posting-styles): Just remove the - header if nil. - -2000-04-26 00:23:46 Shenghuo ZHU - - * mm-view.el (mm-inline-text): Insert directly if decoded. - * mml.el (autoload): Typo. - -2000-04-25 22:46:36 Shenghuo ZHU - - * mml.el (mml-preview): Set up posting-charset. - * gnus-msg.el (gnus-group-posting-charset-alist): Add koi8-r. - -2000-04-25 21:23:54 Shenghuo ZHU - - * webmail.el: Fix yahoo mail. - -2000-04-25 20:12:17 Shenghuo ZHU - - * rfc2047.el (rfc2047-dissect-region): Don't include LWS ahead of - word if not necessary. - (rfc2047-encode-region): Put space between encoded words. - -2000-04-24 21:11:48 Shenghuo ZHU - - * gnus-util.el (gnus-netrc-machine): Another default to nntp. - -2000-04-24 18:14:12 Shenghuo ZHU - - * gnus-draft.el (gnus-draft-setup): Restore mml only when - required. - (gnus-draft-edit-message): Require restoration. - -2000-04-24 16:51:04 Shenghuo ZHU - - * gnus-score.el (gnus-score-headers): Copy gnus-newsgrou-scored - back. - -2000-04-24 16:01:15 Shenghuo ZHU - - * gnus-art.el (gnus-treat-article): Make sure that the summary - buffer is live. - -2000-04-24 15:42:53 Shenghuo ZHU - - * mailcap.el (mailcap-parse-mailcaps): Reorder. - (mailcap-parse-mailcap): Backwards parsing. - (mailcap-possible-viewers): Remove nreverse. - (mailcap-mime-info): Ditto. - (mailcap-add-mailcap-entry): Keep alternative viewer. - -Mon Apr 24 21:12:06 2000 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.8.5 is released. - -2000-04-24 16:29:07 Lars Magne Ingebrigtsen - - * rfc2047.el (rfc2047-header-encoding-alist): Doc fix. - - * gnus-util.el (gnus-netrc-machine): Default to nntp. - - * mml.el (mml-generate-mime-1): Force 8bit on message/rfc822. - -2000-04-23 23:27:25 Shenghuo ZHU - - * mm-view.el (mm-inline-message): Disable prepare-hook. - -2000-04-23 00:32:32 Lars Magne Ingebrigtsen - - * gnus.el: Fix copyright statements. - - * gnus-sum.el (gnus-alter-articles-to-read-function): New - variable. - (gnus-articles-to-read): Use it. - - * message.el (message-get-reply-headers): Bind free variable. - -2000-04-23 01:14:28 Shenghuo ZHU - - * message.el (message-get-reply-headers): Fix to-address. - -2000-04-22 22:51:46 Shenghuo ZHU - - * webmail.el: Hotmail fix. Add a debug function. - -2000-04-23 00:32:32 Lars Magne Ingebrigtsen - - * gnus-sum.el (t): M-down and M-up. - -2000-04-22 20:22:03 Kai Gro,A_(Bjohann - - * gnus-sum.el: Doc fix. - -2000-04-22 10:25:56 Shenghuo ZHU - - * nnwarchive.el (nnwarchive-egroups-article): Remove < and >. - -2000-04-22 14:25:05 Lars Magne Ingebrigtsen - - * nnweb.el (nnweb-dejanews-create-mapping): Remove the context - string. - (nnweb-request-group): Don't scan twice. - (nnweb-request-scan): Don't nix out the hashtb. - - * message.el (message-get-reply-headers): Return a value. - -2000-04-22 14:12:41 David Aspinwall - - * gnus-art.el (gnus-button-url-regexp): New value to match naked - urls. - -2000-04-22 01:23:59 Lars Magne Ingebrigtsen - - * gnus-cache.el (gnus-summary-insert-cached-articles): Reverse the - order messages are inserted. - - * mml.el (mml-generate-mime-1): rfc2047-encode the heads of - message/rfc822 parts. - - * gnus-art.el (gnus-article-read-summary-keys): Check for - numerical values. - - * message.el (message-get-headers): Made into own function. - (message-reply): Use it. - (message-get-reply-headers): Renamed. - (message-widen-reply): New command. - -2000-04-21 20:52:09 Shenghuo ZHU - - * nntp.el (nntp-retrieve-data): Report the error and return nil. - -2000-04-21 19:38:43 Shenghuo ZHU - - * mm-bodies.el (mm-decode-content-transfer-encoding): Don't remove - non-base64 text at the end if not found. - -2000-03-01 Simon Josefsson - - * gnus-sum.el (gnus-read-move-group-name): - (gnus-summary-move-article): Use `gnus-group-method' to find out - what method the manually entered group belong to. - `gnus-group-name-to-method' doesn't return any method parameters - and `gnus-find-method-for-group' uses `gnus-group-name-to-method' - for new groups so they wouldn't work. - -2000-04-21 22:27:15 Lars Magne Ingebrigtsen - - * gnus-msg.el (gnus-configure-posting-styles): Allow nil values to - override. - -2000-04-21 21:58:20 Kai Gro,A_(Bjohann - - * nnmail.el (nnmail-cache-insert): Does some stuff that is - probably good to do, or something. I dunno. I just write these - ChangeLog entries, and my name is Lars. - -1999-12-06 Hrvoje Niksic - - * message.el (message-caesar-region): Use translate-region. - -2000-04-21 21:20:32 Mike Fabian - - * gnus-group.el (gnus-group-catchup-current): Doc fix. - -2000-04-21 20:36:21 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-setup-buffer): Don't kill local - variables, because that makes Emacs flash. - - * gnus-group.el (gnus-group-insert-group-line): Don't call - gnus-group-add-icon unconditionally. - - * gnus-xmas.el (gnus-group-add-icon): Moved here. - - * gnus-group.el (gnus-group-glyph-directory): Don't depend on - xmas. - (gnus-group-glyph-directory): Removed. - -2000-04-21 20:26:23 Jaap-Henk Hoepman - - * gnus-msg.el (gnus-inews-insert-archive-gcc): Don't do stuff if - gnus-newsgroup-name is "". - -2000-04-21 Florian Weimer - - * mm-util.el (mm-mime-mule-charset-alist): Add support for UTF-8 - in conjunction with MULE-UCS. - -1999-12-13 Per Abrahamsen - - * rfc2047.el (rfc2047-fold-region): Don't use the same break twice. - -1999-12-14 04:14:44 Katsumi Yamaoka - - * dgnushack.el (last, mapcon, member-if, union): New compiler - macros for emulating cl functions. - -1999-12-21 Jan Vroonhof - - * message.el (message-shorten-references): Only cater to broken - INN for news. This caters for broken smtpd. - -2000-04-21 18:20:10 Lars Magne Ingebrigtsen - - * mailcap.el (mailcap-mime-info): Use the first match; not the - last. - - * gnus-agent.el (gnus-category-kill): Save the category list. - -2000-04-21 16:41:50 Chris Brierley - - * gnus-sum.el (gnus-summary-move-article): Do something or other. - -2000-04-21 16:07:07 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-add-icon): Fixed indentation. - -2000-04-21 16:07:07 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-add-icon): Fixed indentation. - -2000-04-21 10:43:16 Shenghuo ZHU - - * gnus-group.el (gnus-group-prepare-flat-predicate): New function. - (gnus-group-list-cached): Use it. - -2000-04-21 16:07:07 Lars Magne Ingebrigtsen - - * gnus.el: Update all the copyright notices. - -2000-04-21 15:38:06 Vladimir Volovich - - * mm-bodies.el (mm-decode-content-transfer-encoding): Remove - non-base64 text at the end. - -2000-04-21 15:21:30 Katsumi Yamaoka - - * mm-bodies.el (mm-body-charset-encoding-alist): defcustomized. - -2000-04-21 15:15:41 Lars Magne Ingebrigtsen - - * nnheader.el: Don't autoload cancel-function-timers. - - * message.el (message-fetch-field): Fold case. - -2000-04-21 15:11:09 - - * message.el (message-forward-before-signature): New variable. - -2000-04-21 15:10:31 Alexandre Oliva - - * gnus-mlspl.el: Fix stuff. - -2000-04-21 14:41:09 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-update-article-line): Don't hide - subjects when unthreaded. - -2000-04-21 14:11:39 David S. Goldberg - - * gnus-art.el (gnus-boring-article-headers): Work on long CCs as - well. - -2000-04-21 14:06:43 Rui Zhu - - * gnus-art.el (gnus-article-mode): Fix variable name. - -2000-04-21 13:54:51 Lars Magne Ingebrigtsen - - * mm-view.el: Fix autoload. - - * flow-fill.el (flow-fill): Fix provide. - - * gnus-draft.el (gnus-draft-send): Bind message-setup-hook to - nil. - -2000-04-20 22:24:04 Shenghuo ZHU - - * gnus-win.el (gnus-configure-windows): Revert to switch-to-buffer. - -2000-04-21 05:22:18 Katsumi Yamaoka - - * gnus-util.el (gnus-netrc-machine): Didn't work. - -2000-04-20 21:22:10 Shenghuo ZHU - - * gnus-draft.el (gnus-draft-setup): Restore to mml. - -2000-04-21 01:24:41 Lars Magne Ingebrigtsen - - * flow-fill.el: Renamed from fill-flowed. - - * message.el (message-forward-ignored-headers): Default to - removing CTE. - -2000-04-21 00:48:48 - - * message.el (message-mode): Don't fill headers. - -2000-04-20 23:12:43 Lars Magne Ingebrigtsen - - * message.el (message-pipe-buffer-body): Use shell - -2000-02-21 Yoshiki Hayashi - - * nnvirtual.el (nnvirtual-request-article): - Bind gnus-override-method to nil. - (nnvirtual-request-update-mark): Don't update mark when - article is not there. - -2000-04-20 16:35:41 Shenghuo ZHU - - * mm-uu.el (mm-uu-dissect): Check forwarded message. - -2000-04-20 21:17:48 Lars Magne Ingebrigtsen - - * gnus-util.el (gnus-parse-netrc): Allow "port". - (gnus-netrc-machine): Take a port param. - (gnus-netrc-machine): - - * gnus-art.el (gnus-request-article-this-buffer): Allow - re-selecting referenced articles. - - * message.el (message-cancel-news): Allow editing. - (message-cancel-message): Add newline. - -2000-04-20 21:03:54 William M. Perry - - * mm-view.el (mm-inline-image-emacs): New function. - -2000-04-20 20:44:55 Lars Magne Ingebrigtsen - - * mail-source.el (mail-source-delete-incoming): Change default in - cvs. - -2000-04-20 20:43:34 Kim-Minh Kaplan - - * gnus-art.el (gnus-mime-view-part-as-type-internal): New - function. - -2000-04-20 14:45:20 Lars Magne Ingebrigtsen - - * nnml.el (nnml-request-expire-articles): Use it. - - * nnmail.el (nnmail-expiry-target): New variable. - (nnmail-expiry-target-group): New function. - -2000-04-20 02:36:31 Emerick Rogul - - * message.el (message-forward): Add non-MIME separators. - -2000-04-20 02:25:39 Lars Magne Ingebrigtsen - - * message.el (message-generate-headers): Respect the syntax check - spec. - - * gnus-sum.el (gnus-remove-thread-1): Show thread. - (gnus-remove-thread): Don't show all threads. - -Thu Apr 20 01:39:25 2000 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v5.8.4 is released. - -2000-04-19 Dave Love - - * mailcap.el (mailcap-parse-mimetypes): Add ...mime.types. - -2000-04-18 12:28:24 Shenghuo ZHU - - * nnwarchive.el (nnwarchive-type-definition): New egroups html. - (nnwarchive-egroups-*): Ditto. - (nnwarchive-url): Unibyte buffer and single line cookie. - -2000-04-14 18:50:04 Shenghuo ZHU - - * mm-util.el (mm-char-or-char-int-p): New alias. - * nnweb.el (nnweb-decode-entities): Check the validity of numeric - entities. - -2000-04-10 Daiki Ueno - - * lisp/imap.el (imap-body-lines): Check Content-Type: of the - article case insensitively. - -2000-04-10 20:35:46 Shenghuo ZHU - - * mail-source.el (mail-source-fetch-webmail): Use the default - password provided in mail-sources; use webmail:subtype:user as - the key. - -2000-04-10 20:35:46 John Wiegley - - * mail-source.el (mail-source-fetch-webmail): Use - mail-source-password-cache. - -2000-04-09 18:13:47 Shenghuo ZHU - - * webmail.el: Add netscape mail and fix HotMail mail. - -2000-04-08 Simon Josefsson - - * imap.el (imap-kerberos4-open): Work with recent `imtest's. - -2000-04-02 Simon Josefsson - - * nnimap.el (nnimap-request-article): Use BODY.PEEK[] instead of - RFC822.PEEK if server support IMAP4rev1. - (nnimap-request-body): Use BODY.PEEK[TEXT] instead of - RFC822.TEXT.PEEK if server support IMAP4rev1. - (nnimap-request-head): Use BODY.PEEK[HEADER] instead of - RFC822.HEADER if server support IMAP4rev1. - (nnimap-request-article-part): Support bodydetail in response - data. - -2000-03-11 Simon Josefsson - - * fill-flowed.el: New file. - - * mm-decode.el (mm-dissect-singlepart): Create a MIME handle for - text/plain parts with `format' parameters. - - * mm-view.el (autoload): Autoload fill-flowed. - (mm-inline-text): For "plain" parts with a format=flowed - parameter, call `fill-flowed'. - -2000-03-21 10:32:44 Lars Magne Ingebrigtsen - - * nnslashdot.el (nnslashdot-request-list): Fudge new-style - slashdot ids. - -2000-03-20 00:12:42 Lars Magne Ingebrigtsen - - * nnslashdot.el (nnslashdot-request-list): Use the new slashdot - format. - -2000-03-16 Simon Josefsson - - * imap.el: GSSAPI support, support kerberos 4 with Cyrus v1.6.x - `imtest' too. - (imap-kerberos4-program): Renamed from `imap-imtest-program'. - (imap-gssapi-program): New variable. - (imap-streams): Add gssapi. - (imap-stream-alist): Ditto. - (imap-authenticators): Ditto. - (imap-authenticator-alist): Ditto. - (imap-kerberos4-stream-p): Rename from `imap-kerberos4s-p'. - (imap-kerberos4-open): Loop over imtest programs, support Cyrus - 1.6.x `imtest' syntax. - (imap-gssapi-stream-p): New function. - (imap-gssapi-open): Ditto. - (imap-gssapi-auth-p): Ditto. - (imap-gssapi-auth): Ditto. - (imap-kerberos4-auth-p): Renamed from `imap-kerberos4a-p'. - (imap-send-command): Use buffer-local `imap-client-eol' value. - - * nnimap.el (nnimap-retrieve-headers-progress): Fold continuation - lines and turn TAB into SPC before parsing. - -2000-03-15 Simon Josefsson - - * nnheader.el (nnheader-group-pathname): Make sure to return a - directory. - * nnmail.el (nnmail-group-pathname): Ditto. - -2000-02-08 Per Abrahamsen - - * nnmail.el (nnmail-fix-eudora-headers): Fix `In-Reply-To' too, it - might split in the middle of a message-id. - -2000-03-13 13:51:38 Lars Magne Ingebrigtsen - - * gnus-srvr.el (gnus-server-kill-server): Offer to kill all the - groups from the server. - - * gnus-sum.el (gnus-summary-save-parts): Fix interactive spec. - (gnus-summary-toggle-header): Update the wash status. - - * gnus-uu.el ((gnus-uu-extract-map "X" gnus-summary-mode-map)): - Moved here. - - * gnus-agent.el (gnus-agent-save-group-info): Respect old - setting. - - * nnmail.el (nnmail-get-active): Use it. - (nnmail-parse-active): New function. - - * mm-view.el (mm-inline-text): Support the new version of - vcard.el. - - * gnus-sum.el (gnus-summary-move-article): Only delete article - when moving junk. - (gnus-deaden-summary): Bury the buffer. - - * nnmail.el (nnmail-group-pathname): Ditto. - - * nnheader.el (nnheader-group-pathname): Use expand-file-name. - -2000-03-13 20:23:06 Christoph Rohland - - * rfc2047.el (rfc2047-encode-message-header): Encode no matter - whether Mule. - -2000-03-10 14:57:58 Lars Magne Ingebrigtsen - - * message.el (message-send-mail): Protect against unloaded Gnus. - - * gnus-topic.el (gnus-topic-update-topic-line): Don't update the - parent. - (gnus-topic-update-topic-line): Yes, do. - (gnus-topic-goto-missing-group): Tally the correct number of - unread articles before inserting the topic line. - -2000-03-01 09:55:26 Lars Magne Ingebrigtsen - - * nnultimate.el (nnultimate-retrieve-headers): Ignore errors. - -2000-02-13 13:53:08 Lars Magne Ingebrigtsen - - * mm-decode.el (mm-dissect-buffer): Ditto. - - * gnus-art.el (article-decode-charset): Strip CTE. - - * ietf-drums.el (ietf-drums-strip): New function. - - * gnus-sum.el (gnus-summary-move-article): Don't use the prefix - when prompting in read-only groups. - -2000-02-23 Simon Josefsson - - * imap.el (imap-send-command): Change EOL-chars when - `imap-client-eol' differs from default, not only for kerberos4. - (imap-mailbox-status): Get encoded mailbox's status. - -2000-02-19 Simon Josefsson - - * mail-source.el (mail-source-fetch-imap): Copy `imap-password' - into `mail-source-password-cache'. - -2000-02-17 Florian Weimer - - * mm-util.el (mm-mime-charset): Check for presence of - `coding-system-get' and `get-charset-property' (recent XEmacs has - the former, but not the latter). - -2000-01-28 Dave Love - - * message.el (message-check-news-header-syntax): Fix typo - `newsgroyps'. - (message-talkative-question): Put temp buffer in fundamental-mode. - (message-recover): Use fundamental-mode in the right buffer. - - * nnmail.el (nnmail-split-history): Use fundamental-mode in the - right buffer. - -2000-01-26 12:01:18 Shenghuo ZHU - - * qp.el (quoted-printable-decode-region): Add charset parameter. - (quoted-printable-decode-string): Ditto. - - * gnus-art.el (article-de-quoted-unreadable): Use it. - -2000-01-21 Simon Josefsson - - * nnimap.el (nnimap-split-predicate): New variable. - (nnimap-split-articles): Use it. - -2000-01-20 Simon Josefsson - - * utf7.el: Change email address. - -2000-01-18 22:03:51 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-catchup): Purge split history. - -2000-01-14 02:43:55 Shenghuo ZHU - - * nnmail.el (nnmail-generate-active): Support extended group name. - (nnmail-get-active): Ditto. - -2000-01-13 15:16:10 Shenghuo ZHU - - * gnus-agent.el (gnus-agent-write-active): Since no prefix in - group names, don't remove anything. - -2000-01-13 15:10:53 Shenghuo ZHU - - * webmail.el (webmail-my-deja-open): My-deja changes. - -2000-01-13 Simon Josefsson - - * nnimap.el (nnimap-retrieve-headers-progress): Create xref field. - -2000-01-10 23:35:33 Shenghuo ZHU - - * gnus-agent.el (gnus-agent-fetch-headers): Translate full path. - -2000-01-09 22:52:35 Shenghuo ZHU - - * gnus.el (gnus-other-frame): Fix typo. - -1999-06-25 Andreas Jaeger - - * gnus-cus.el (gnus-group-customize): Fix typo. - -2000-01-08 08:36:13 Lars Magne Ingebrigtsen - - * nnweb.el (nnweb-insert): Simplified. - -2000-01-06 18:32:53 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-mode-map): "e" is - gnus-summary-edit-article. - -2000-01-06 18:25:37 Jari Aalto - - * mailcap.el (mailcap-mime-extensions): Add .diff. - -2000-01-06 00:06:40 Kim-Minh Kaplan - - * mm-decode.el (mm-mailcap-command): handle "%%" and the case where - there is no "%s" in the method. - -2000-01-08 21:01:04 Kim-Minh Kaplan - - * gnus-sum.el (gnus-summary-select-article): Return 'old. - -2000-01-06 13:41:11 Lars Magne Ingebrigtsen - - * nnfolder.el (nnfolder-read-folder): Use nnfolder-save-buffer. - - * gnus.el: Really always pop up a new frame. - - * parse-time.el (parse-time-rules): Allow 100-110 to be - 2000-2010. - - * time-date.el (date-to-time): Don't use timezone. - -2000-01-06 Dave Love - - * time-date.el: Add keywords. - (date-to-time): Add autoload cookie. Canonicalize with - timezone-make-date-arpa-standard. - (time-to-seconds): Avoid caddr. - (safe-date-to-time): Add autoload cookie. - - * base64.el: Require cl when compiling. - -2000-01-05 BrYan P. Johnson - - * gnus-group.el (gnus-group-line-format-alist): Added %E for - eyecandy. - (gnus-group-insert-group-line): Now groks %E and inserts icon in - group line using gnus-group-add-icon. - (gnus-group-icons): Added customize group. - (gnus-group-icon-list): Added variable. - (gnus-group-glyph-directory): Added variable. - (gnus-group-icon-cache): Added variable. - (gnus-group-running-xemacs): Added variable. - (gnus-group-add-icon): Added function. Add an icon to the current - line according to gnus-group-icon-list. - (gnus-group-icon-create-glyph): Added function. - -2000-01-05 17:31:52 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-select-article): Return whether we - selected something new. - (gnus-summary-search-article): Start searching at the window - point. - - * gnus-group.el (gnus-fetch-group): Complete over - gnus-active-hashtb. - -Wed Jan 5 17:06:41 2000 Lars Magne Ingebrigtsen - - * gnus.el: Pterodactyl Gnus v5.8.3 is released. - -2000-01-05 15:56:02 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-preserve-marks): New variable. - (gnus-summary-move-article): Use it. - (gnus-group-charset-alist): Added more entries. - -2000-01-03 01:18:36 Lars Magne Ingebrigtsen - - * mm-decode.el (mm-inline-override-types): Removed duplicate. - - * gnus-uu.el (gnus-uu-mark-over): Use gnus-summary-default-score - as the default score. - - * gnus-score.el (gnus-score-delta-default): Changed name. - -2000-01-04 Simon Josefsson - - * imap.el (imap-parse-literal): - (imap-parse-flag-list): Don't care about props. - (imap-parse-string): Handle quoted characters. - -2000-01-02 08:37:03 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-goto-unread): Doc fix. - (gnus-summary-mark-article): Doc fix. - (gnus-summary-mark-forward): Doc fix. - (t): Changed keystroke for gnus-summary-customize-parameters. - - * gnus-art.el (gnus-article-mode-map): Use gnus-article-edit for - "e". - (gnus-article-mode-map): No, don't. - - * gnus-sum.el (gnus-summary-next-subject): Don't show the thread - of the final article. - - * mm-decode.el (mm-interactively-view-part): Error on no method. - -2000-01-02 06:10:32 Stefan Monnier - - * gnus-score.el (gnus-score-insert-help): Something. - - * gnus-art.el (gnus-button-alist): Exclude < from - - * nnwarchive.el: Changed file perms. - -1999-12-19 21:42:15 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-delete-groups): New command. - (gnus-group-delete-group): Extra no-prompt parameters. - -1999-12-14 10:18:30 Lars Magne Ingebrigtsen - - * nnslashdot.el (nnslashdot-request-article): Translate
    into -